
{*******************************************************************************

           ШАБЛОН ДЛЯ БЫСТРОГО ИЗГОТОВЛЕНИЯ ПРОГРАММ
     УПРАВЛЕНИЯ ВНЕШНИМИ УСТРОЙСТВАМИ ПОСРЕДСТВОМ LPT ПОРТОВ
       ВАШЕГО КОМПЬЮТЕРА В СРЕДЕ ОС WINDOWS 9x/NT/2000/XP


                  ОБНОВЛЕНО  23.08.04 !

Добавлен переключатель ВХОД / ВЫХОД регистра данных в режиме ЕРР .

Без труда Вы можете установить/снять напряжение 5вольт
на соответствующей ножке (Pin) LPT разъёма очень простой командой!

 Валерий Ковтун US4LEH    http://valery-us4leh.narod.ru

*******************************************************************************}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, LPTIO,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ComboBox1: TComboBox;
    Label1: TLabel;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);

  private
    { Private declarations }
    Lpt : TLptPortConnection;
  public
    { Public declarations }
    function GetCurrentPort : byte;     // Читает список ComboBox1 и возвращает соответствующий номер порта
 // function GetCurrentRegister : byte; // Читает список ComboBox2 и возвращает соответствующий номер регистра



//*********************PIN******************************************************

     function Pin2 : boolean;
     function Pin3 : boolean ;
     function Pin4 : boolean ;
     function Pin5 : boolean ;
     function Pin6 : boolean ;
     function Pin7 : boolean ;
     function Pin8 : boolean ;
     function Pin9 : boolean ;

     function Pin1 : boolean ;
     function Pin14 : boolean ;
     function Pin16 : boolean ;
     function Pin17 : boolean ;

     function InMode : boolean ;

     function Pin11 : boolean ;
     function Pin10 : boolean ;
     function Pin12 : boolean ;
     function Pin13 : boolean ;
     function Pin15 : boolean ;

//******************************************************************************

{----------------Встроены команды Pin клавиатуры-------------------------------}

     procedure ButtonPin2;
     procedure ButtonPin3;
     procedure ButtonPin4;
     procedure ButtonPin5;
     procedure ButtonPin6;
     procedure ButtonPin7;
     procedure ButtonPin8;
     procedure ButtonPin9;

     procedure ButtonPin1;
     procedure ButtonPin14;
     procedure ButtonPin16;
     procedure ButtonPin17;

     procedure InOut;  //-- EPP: вход / выход переключатель

//******************************************************************************

  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var msg : AnsiString;
begin
 Lpt := TLptPortConnection.Create;
 if not Lpt.Ready then
  begin { объект не готов -- покажем код ошибки }
  msg := 'Ошибка при создании объекта Lpt,  драйвер ERROR,  код = ' + IntToStr(GetLastError());
  Application.MessageBox(PChar(msg),'ERROR',MB_OK);
  Application.Terminate; // выход
  end;
 // Проверим наличие портов и заполним их список в ComboBox-e
 ComboBox1.Items.Clear;
 ComboBox1.Text := '';
 if Lpt.IsPortPresent(LPT1) then ComboBox1.Items.Add('$3BC');
 if Lpt.IsPortPresent(LPT2) then ComboBox1.Items.Add('$378'); //-ВНИМАНИЕ: $378 здесь назван LPT2! 
 if Lpt.IsPortPresent(LPT3) then ComboBox1.Items.Add('$278');

 if 0<>ComboBox1.Items.Count then ComboBox1.ItemIndex := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject); // Обработчик разрушения
begin
 Lpt.Destroy;
{  Здесь разместите все таймеры, которые должны быть отключены   }
end;




function TForm1.GetCurrentPort : byte;     // Читает список ComboBox1 и возвращает соответствующий номер порта
begin
 if '$3BC' = ComboBox1.Text then
  GetCurrentPort:=LPT1
                            else
  if '$378' = ComboBox1.Text then
   GetCurrentPort:=LPT2      else
   GetCurrentPort:=LPT3;
end;


//-------Используйте при желании-----------------------------------------------
{
function TForm1.GetCurrentRegister : byte; // Читает список ComboBox2 и возвращает соответствующий номер регистра
begin
 if 'ДАННЫХ' = ComboBox2.Text then
  GetCurrentRegister:=LPT_DATA_REG
                              else
  if 'СОСТОЯНИЯ' = ComboBox2.Text       then
   GetCurrentRegister:=LPT_STATE_REG    else
   GetCurrentRegister:=LPT_CONTROL_REG;
end;
      }

//***********Добавлены функции - PIN - *****************************************

        {--------------- Регистр данных -------------------}
 function TForm1.Pin2 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d and (1 = (1 and Lpt.ReadPort( (GetCurrentPort) ,0))) ;
     Pin2 := d;
 end;

 function TForm1.Pin3 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d and (2 = (2 and Lpt.ReadPort(GetCurrentPort,0))) ;
     Pin3 := d;
 end;

 function TForm1.Pin4 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d and (4 = (4 and Lpt.ReadPort(GetCurrentPort,0))) ;
     Pin4 := d;
 end;

 function TForm1.Pin5 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d and (8 = (8 and Lpt.ReadPort(GetCurrentPort,0))) ;
     Pin5 := d;
 end;

 function TForm1.Pin6 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d and (16 = (16 and Lpt.ReadPort(GetCurrentPort,0))) ;
     Pin6 := d;
 end;

 function TForm1.Pin7 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d and (32 = (32 and Lpt.ReadPort(GetCurrentPort,0))) ;
     Pin7 := d;
 end;

 function TForm1.Pin8 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d and (64 = (64 and Lpt.ReadPort(GetCurrentPort,0))) ;
     Pin8 := d;
 end;

 function TForm1.Pin9 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d and (128 = (128 and Lpt.ReadPort(GetCurrentPort,0))) ;
     Pin9 := d;
 end;


        {--------------- Регистр управления -------------------}
 
 function TForm1.Pin1 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d xor (STROBE  = (STROBE  and Lpt.ReadPort(GetCurrentPort,2))) ;
     Pin1 := d;
 end;
 
 function TForm1.Pin14 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d xor (AUTOFEED  = (AUTOFEED  and Lpt.ReadPort(GetCurrentPort,2))) ;
     Pin14 := d;
 end;
 
 function TForm1.Pin16 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d and (INIT  = (INIT  and Lpt.ReadPort(GetCurrentPort,2))) ;
     Pin16 := d;
 end;
 
 function TForm1.Pin17 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d xor (SELECTIN  = (SELECTIN  and Lpt.ReadPort(GetCurrentPort,2))) ;
     Pin17 := d;
 end;

   {--------------- (EPP): На вход = true, выход = false -----------}

 function TForm1.InMode : boolean ; //-- вход = true, выход = false 
 Var
 d : boolean;
 begin
     d := true;
     d := d and (DIRECTION  = (DIRECTION  and Lpt.ReadPort(GetCurrentPort,2))) ; //-- 32 (бит 5) он же  DIRECTION
     if Lpt.IsPortBidirectional(GetCurrentPort)= true then InMode := d else InMode := false;
 end;


   {--------------- Регистр состояния (входы) ----------------------}

 function TForm1.Pin11 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d xor(BUSY = (BUSY and Lpt.ReadPort(GetCurrentPort,1))) ;
     Pin11 := d;
 end;

  function TForm1.Pin10 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d and(ACK  = (ACK  and Lpt.ReadPort(GetCurrentPort,1))) ;
     Pin10 := d;
 end;

 function TForm1.Pin12 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d and(PAPEREND  = (PAPEREND  and Lpt.ReadPort(GetCurrentPort,1))) ;
     Pin12 := d;
 end;

 function TForm1.Pin13 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d and(SELECT = (SELECT  and Lpt.ReadPort(GetCurrentPort,1))) ;
     Pin13 := d;
 end;

 function TForm1.Pin15 : boolean ;
 Var
 d : boolean;
 begin
     d := true;
     d := d and(ERROR  = (ERROR  and Lpt.ReadPort(GetCurrentPort,1))) ;
     Pin15 := d;
 end;     


//______________________________________________________________________________



//-----------------------Команды Pin клавиатуры---------------------------------

           { ----------- регистр данных  ----------------- }
 procedure TForm1.ButtonPin2;
 begin
 Lpt.WritePort (GetCurrentPort,0,(1 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
 end;

 procedure TForm1.ButtonPin3;
 begin
 Lpt.WritePort (GetCurrentPort,0,(2 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
 end;

 procedure TForm1.ButtonPin4;
 begin
 Lpt.WritePort (GetCurrentPort,0,(4 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
 end;

 procedure TForm1.ButtonPin5;
 begin
 Lpt.WritePort (GetCurrentPort,0,(8 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
 end;
 
 procedure TForm1.ButtonPin6;
 begin
 Lpt.WritePort (GetCurrentPort,0,(16 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
 end;
 
 procedure TForm1.ButtonPin7;
 begin
 Lpt.WritePort (GetCurrentPort,0,(32 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
 end;
 
 procedure TForm1.ButtonPin8;
 begin
 Lpt.WritePort (GetCurrentPort,0,(64 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
 end;
 
 procedure TForm1.ButtonPin9;
 begin
 Lpt.WritePort (GetCurrentPort,0,(128 xor Lpt.ReadPort( (GetCurrentPort) ,0) ));
 end;


         { -------------- регистр контроля  ----------------- }

 procedure TForm1.ButtonPin1;
 begin
 Lpt.WritePort (GetCurrentPort,2,(1 xor Lpt.ReadPort( (GetCurrentPort) ,2) ));
 end;
 
 procedure TForm1.ButtonPin14;
 begin
 Lpt.WritePort (GetCurrentPort,2,(2 xor Lpt.ReadPort( (GetCurrentPort) ,2) ));
 end;

 procedure TForm1.ButtonPin16;
 begin
 Lpt.WritePort (GetCurrentPort,2,(4 xor Lpt.ReadPort( (GetCurrentPort) ,2) ));
 end;

 procedure TForm1.ButtonPin17;
 begin
 Lpt.WritePort (GetCurrentPort,2,(8 xor Lpt.ReadPort( (GetCurrentPort) ,2) ));
 end;


 procedure TForm1.InOut; //--- переключ. направления в реж. EPP вход / выход
 begin
 if Lpt.IsPortBidirectional(GetCurrentPort)= true then
 begin
 Lpt.WritePort(GetCurrentPort,2, (DIRECTION  xor Lpt.ReadPort(GetCurrentPort,2))) ;  //-- 32 (бит 5  )
 end else
 MessageBox(Handle,PChar('Данный порт не является активным в EPP режиме. Для активации войдите в Bios, раздел INTEGRATED PERIPHERALS или др., найдите строку PARALLEL PORT MODE: измените режим работы порта на EPP или SPP/EPP.'),
 PChar('Не доступен EPP режим '),MB_ICONINFORMATION + MB_OK +MB_DEFBUTTON2);
 end;

//______________________________________________________________________________

{------- драйвер XP: lptwdmio.sys должен быть в текущем каталоге ------------- }
{----------------------------Ваш код ниже:-------------------------------------}


end.
