unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Windows;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

const
IOCTL_PAR_SET_WRITE_ADDRESS = $16001C;
IOCTL_IEEE1284_NEGOTIATE = $160018;
IOCTL_IEEE1284_GET_MODE = $160014;

type
PARCLASS_NEGOTIATION_MASK = record
  usReadMask: word;
  usWriteMask: word;
end;
PPARCLASS_NEGOTIATION_MASK = ^PARCLASS_NEGOTIATION_MASK;

var
  hLpt: THandle;
  ret: DWORD;
  Address: byte;
  Data: byte;     // данные для чтения
ReqMode, LptMode: PARCLASS_NEGOTIATION_MASK;
lpOverlapped: POverlapped;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Открыть порт для синхронного доступа
  hLpt := CreateFile('LPT1', GENERIC_READ or GENERIC_WRITE, 0, nil,
          OPEN_EXISTING, 0, 0);
  ReqMode. usReadMask:= $0010;   // Режим BYTE_BIDIR (только для чтения)
  ReqMode. usWriteMask:= $0000;   // Режим NONE (только для записи), т.е. не пишем вообще
  // Задаем режим
  DeviceIoControl(hLpt, IOCTL_IEEE1284_NEGOTIATE,
             @ReqMode, sizeof(PARCLASS_NEGOTIATION_MASK),
             @LptMode, sizeof(PARCLASS_NEGOTIATION_MASK),
             ret, lpOverlapped);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ReadFile(hLPT, Data, 1, ret, nil);
  Edit1.Caption:=IntToStr(Data);
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  // Закрыть устройство
  CloseHandle(hLpt);
end;

end.

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  direction: boolean; // переменная задающая направление движения бегущего огня
                      // true - влево, false - вправо
  Data: byte;
  hLpt: THandle;
  ret: DWORD;

const
IOCTL_PAR_SET_WRITE_ADDRESS = $16001C;
IOCTL_IEEE1284_NEGOTIATE = $160018;

const
IOCTL_IEEE1284_GET_MODE = $160014;

type
PARCLASS_NEGOTIATION_MASK = record
  usReadMask: word;
  usWriteMask: word;
end;
PPARCLASS_NEGOTIATION_MASK = ^PARCLASS_NEGOTIATION_MASK;

var
  ReqMode, LptMode: PARCLASS_NEGOTIATION_MASK;
  lpOverlapped: POverlapped;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject); // кнопка "налево"
begin
  Timer1.Enabled:=true; // запускаем таймер
  direction:=true;      // задаем направление
end;

procedure TForm1.Button2Click(Sender: TObject); // кнопка "направо"
begin
  Timer1.Enabled:=true; // запускаем таймер
  direction:=false;     // задаем направление
end;

procedure TForm1.Button3Click(Sender: TObject); // кнопка "СТОП"
begin
  Timer1.Enabled:=false; // останавливаем таймер
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  Data:=0; // в конце потушим диод
  WriteFile(hLpt, Data, 1, ret, nil);
  // Закрыть устройство
  CloseHandle(hLpt);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Открыть порт для синхронного доступа
  hLpt := CreateFile('LPT1', GENERIC_READ or GENERIC_WRITE, 0, nil,
          OPEN_EXISTING, 0, 0);
  ReqMode. usReadMask:= $0010;   // Режим BYTE_BIDIR (только для чтения)
  ReqMode. usWriteMask:= $0002;   // Режим IEEE_COMPATIBILITY (только для записи)
  // Задаем режим
  DeviceIoControl(hLpt, IOCTL_IEEE1284_NEGOTIATE,
             @ReqMode, sizeof(PARCLASS_NEGOTIATION_MASK),
             @LptMode, sizeof(PARCLASS_NEGOTIATION_MASK),
             ret, lpOverlapped);
  Data:=$80; // в начале будет гореть крайний левый диод
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if direction = true then
    Begin
      Data:=Data shl 1;
      If Data = 0 then Data:=1; // если дошли до конца, то начнем с другого конца
    end
  else
    Begin
      Data:=Data shr 1;
      If Data = 0 then Data:=$80; // если дошли до конца, то начнем с другого конца
    end;
  WriteFile(hLpt, Data, 1, ret, nil);
end;

end.

         ' Запись данных в порт LPT1.
         ' Примечание. Данные из параллельного порта нельзя прочитать с помощью функции ReadFile.
         Console.WriteLine("Запись следующих данных в порт LPT1: тест")
         Success = WriteFile(hParallelPort, Buffer, Buffer.Length, BytesWritten, IntPtr.Zero)
         If Success = False Then
            Throw New CommException("Не удается записать данные в порт LPT1")
         End If

const char lpt[] = "LPT1";
    HANDLE hLpt = 0;
    UCHAR ParInfo; // сюда примем состояние статусных входов LPT
    DWORD ret;

    hLpt = CreateFile( lpt, GENERIC_READ | GENERIC_WRITE, 0, NULL, OPEN_EXISTING, 0, NULL );
    // ну, само собой проверки
    DeviceIoControl(hLpt, IOCTL_PAR_QUERY_INFORMATION, NULL, 0, &ParInfo, sizeof(ParInfo), &ret, NULL);

   // Назначение бит в байте ret (как это определено в <ntddpar.h>)

#define PARALLEL_INIT 0x01
#define PARALLEL_AUTOFEED 0x02
#define PARALLEL_PAPER_EMPTY 0x04
#define PARALLEL_OFF_LINE 0x08
#define PARALLEL_POWER_OFF 0x10
#define PARALLEL_NOT_CONNECTED 0x20
#define PARALLEL_BUSY 0x40
#define PARALLEL_SELECTED 0x80