unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  IOCTL_PAR_QUERY_INFORMATION = $160004;

  PARALLEL_INIT = $01;
  PARALLEL_AUTOFEED = $02;
  PARALLEL_PAPER_EMPTY = $04;
  PARALLEL_OFF_LINE = $08;
  PARALLEL_POWER_OFF = $10;
  PARALLEL_NOT_CONNECTED = $20;
  PARALLEL_BUSY = $40;
  PARALLEL_SELECTED = $80;

type
  PAR_QUERY_INFORMATION = record
    Status: byte;
end;
PPAR_QUERY_INFORMATION = ^PAR_QUERY_INFORMATION;

var
  hLpt: THandle;
  ret: DWORD;
  ParInfo: PAR_QUERY_INFORMATION;
  lpOverlapped: POverlapped;

procedure TForm1.Button1Click(Sender: TObject);
begin
  DeviceIoControl(hLpt, IOCTL_PAR_QUERY_INFORMATION, nil, 0,
                   @ParInfo, sizeof(PAR_QUERY_INFORMATION),
                  ret, lpOverlapped);
  if (PARALLEL_INIT and ParInfo.Status) = PARALLEL_INIT then
    Label1.Color:=clRed
  else
    Label1.Color:=clBtnFace;
  if (PARALLEL_AUTOFEED and ParInfo.Status) = PARALLEL_AUTOFEED then
    Label2.Color:=clRed
  else
    Label2.Color:=clBtnFace;
  if (PARALLEL_PAPER_EMPTY and ParInfo.Status) = PARALLEL_PAPER_EMPTY then
    Label3.Color:=clRed
  else
    Label3.Color:=clBtnFace;
  if (PARALLEL_OFF_LINE and ParInfo.Status) = PARALLEL_OFF_LINE then
    Label4.Color:=clRed
  else
    Label4.Color:=clBtnFace;
  if (PARALLEL_POWER_OFF and ParInfo.Status) = PARALLEL_POWER_OFF then
    Label5.Color:=clRed
  else
    Label5.Color:=clBtnFace;
  if (PARALLEL_NOT_CONNECTED and ParInfo.Status) = PARALLEL_NOT_CONNECTED then
    Label6.Color:=clRed
  else
    Label6.Color:=clBtnFace;
  if (PARALLEL_BUSY and ParInfo.Status) = PARALLEL_BUSY then
    Label7.Color:=clRed
  else
    Label7.Color:=clBtnFace;
  if (PARALLEL_SELECTED and ParInfo.Status) = PARALLEL_SELECTED then
    Label8.Color:=clRed
  else
    Label8.Color:=clBtnFace;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  hLpt := CreateFile('LPT1', GENERIC_READ or GENERIC_WRITE, 0, nil,
                     OPEN_EXISTING, 0, 0);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  CloseHandle(hLpt);
end;

end.

Out($378, 120)
Byte = Inp($378)

MessageRequester("", Str(Byte))

XIncludeFile "pbdriverio_Framework.pbi"


Procedure SendLPT1(hDriver)  ; Процедура передачи данных в LPT1
  Out.c=0
  For i=8 To 1 Step -1    ; В цикле сканируются "флажки" (CheckBoxGadget) отвечающие за пины порта
    If GetGadgetState(i)=1  ; Определяем состояние "флажка"
      Out | 1                   ; Операция "Логическое ИЛИ"
    Else
      Out & %11111110       ; Операция "Логическое И"
    EndIf
    If i>1
      Out << 1                 ; Сдвиг переменной на 1 бит влево
    EndIf
  Next i         
  PortOut(hDriver, $378, Out)         ; Данные в LPT1
EndProcedure


hDriver = OpenDriver_PB_IO(@ErrCode)
If hDriver = 0
  MessageRequester("Ошибка доступа к драйверу", "Код ошибки:  "+Str(ErrCode))
EndIf


; Открываем окно
OpenWindow(0,0,0,120,240,"lpt Pin", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible) 
Frame3DGadget(#PB_Any,20,10,80,180,"Pins")
y=28
For i=1 To 8
  CheckBoxGadget(i,36,y,50,16,"Pin "+Str(i)) ; "флажки"
  y+20
Next i
ButtonGadget(9,6,210,110,24,"Отправить в LPT 1") ; Экранная кнопка
HideWindow(0,0)   ; Отображение окна на экране

Repeat         ; Главный (оконный) цикл программы "Repeat - Until"
  Event=WaitWindowEvent()  ; Идентификатор события
  If Event=#PB_Event_Gadget ; Произошло событие в гаджете
    Gadget=EventGadget()    ; ID гаджета, в котором произошло событие
    If Gadget=9             ; Обнаруден клик по экранной кнопке
      SendLPT1(hDriver)            ; Процедура передачи информации по порт LPT1
    EndIf
  EndIf
Until Event=#PB_Event_CloseWindow ; Когда закрывают окно, цикл будет прерван и прога завершит работу.

CloseDriver(hDriver)

hDriver = OpenDriver_PB_IO(@ErrCode)
If hDriver = 0
  MessageRequester("Ошибка доступа к драйверу", "Код ошибки:  "+Str(ErrCode))
EndIf