[sflash]

Вот то что ты искал.

unit LptCtrl;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs;

type
TLpt = (None, Lpt1, Lpt2, Lpt3);
TLptAvail = array [1..3] of boolean; { is port available? }
TPortAddrArr = array [1..3] of word;

TlptCtrl = class(TComponent)
private
{ Private declarations }
FLpt: TLpt;
FPortAddrArr: TPortAddrArr; { LPT port addresses }
FPortAddr: word; { selected LPT port address }
FLptAvail: TLptAvail;
FData: byte; { LPT data out }
FDummy: byte; { will only be used to make 'Status' published }

procedure SetLptPort(Value: Tlpt);
{ SetPortAddress will usually be automatically handled
through SetLptPort. }
procedure SetPortAddress(Value: word);
procedure SetData(Value: byte);
function GetStatus: byte;
function GetCtrl: byte;
procedure SetCtrl(Value: byte);
procedure FindLptAddr;


protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property LptAvail: TLptAvail read FLptAvail; { what ports are available? }

published
{ Published declarations }
property LptPort: TLpt read FLpt write SetLptPort default None;
property PortAdress: word read FPortAddr write SetPortAddress;
property Data: byte read Fdata write SetData default 0;
property Status: byte read GetStatus write FDummy;
property Ctrl: byte read GetCtrl write SetCtrl;
end;

procedure Register;

implementation

{ FindLptAddr - Will find the addresses of LPT port (1-3).
Non valid ports will result in address 0.
Note FLptPortAddr[] and FLptAvail will be affected. }
procedure TlptCtrl.FindLptAddr;
begin
{ Yes, I know, this could have been coded as a loop... }
FPortAddrArr[1] := mem[$0040:$08] + mem[$0040:$09]*256;
if FPortAddrArr[1] > 0 then FLptAvail[1] := true;

FPortAddrArr[2] := mem[$0040:$0A] + mem[$0040:$0B]*256;
if FPortAddrArr[2] > 0 then FLptAvail[2] := true;

FPortAddrArr[3] := mem[$0040:$0C] + mem[$0040:$0D]*256;
if FPortAddrArr[3] > 0 then FLptAvail[3] := true;
end;

procedure TLptCtrl.SetLptPort(Value: Tlpt); { To set up the choosen port }
begin
case Value of
Lpt1: if FLptAvail[1] then
begin
FPortAddr := FPortAddrArr[1];
FLpt := Lpt1;
end;
Lpt2: if FLptAvail[2] then
begin
FPortAddr := FPortAddrArr[2];
FLpt := Lpt2;
end;
Lpt3: if FLptAvail[3] then
begin
FPortAddr := FPortAddrArr[3];
FLpt := Lpt3;
end;
else
begin
FPortAddr := 0;
FLpt := None;
end;
end;
end;

procedure TlptCtrl.SetPortAddress(Value: word); { for those who hate automation : ) }
begin
FPortAddr := Value;
end;

procedure TlptCtrl.SetData(Value: byte); { put data on LPT data lines }
begin
if FLpt <> None then
begin
Port[FPortAddr] := Value;
FData := Value;
end;
end;

function TlptCtrl.GetStatus: byte; { read data from LPT status lines }
begin
if FLpt <> None then
begin
Result := Port[FPortAddr + 1];
end
else
Result := 0;
end;

function TlptCtrl.GetCtrl: byte;{ to read what was put on the Ctrl lines }
begin
if FLpt <> None then
begin
Result := Port[FPortAddr + 2];
end
else
Result := 0;
end;

procedure TlptCtrl.SetCtrl(Value: byte); { put data on Ctrl lines }
begin
if FLpt <> None then
begin
Port[FPortAddr + 2] := Value;
end;
end;

procedure Register;
begin
RegisterComponents('I/O', [TlptCtrl]);
end;

{ constructor }
constructor TLptCtrl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FindLptAddr; (* find available LPT ports *)
end;

{ destructor - just as a placeholder if cleanup will be necessary }
destructor TLptCtrl.Destroy;
begin
inherited Destroy;
end;

end.