Odpaliłem to na 98 i coś mi zaczyna chodzić. Mam taka procedurę:
unit WinLpt;
interface
procedure LptWrite(nr:byte; d:boolean);
function LptRead(nr:byte):boolean;
function WhatLptWrite(nr:byte):boolean;
var
AddrLPT: Word;
const
yes=true;
no=false;
implementation
var
v : array[1..12] of boolean;
i : integer;
function PortReadByte(Addr:Word) : Byte; assembler; register;
asm
MOV DX,AX
IN AL,DX
end;
procedure PortWriteByte(Addr:Word; Value:Byte); assembler; register;
asm
XCHG AX,DX
OUT DX,AL
end;
procedure LptWrite(nr:byte; d:boolean);
var
a,b : byte;
begin
v[nr]:=d;
if v[1] then a:=1 else a:=0;
if v[2] then a:=a+2;
if v[3] then a:=a+4;
if v[4] then a:=a+8;
if v[5] then a:=a+16;
if v[6] then a:=a+32;
if v[7] then a:=a+64;
if v[8] then a:=a+128;
PortWriteByte(AddrLPT, a);
{----------------}
if v[9] then a:=1 else a:=0;
if v[10] then a:=a+4;
if v[11] then a:=a+8;
PortWriteByte(AddrLPT+2, a);
end;
function WhatLptWrite(nr:byte):boolean;
begin
WhatLptWrite:=v[nr];
end;
function LptRead(nr:byte):boolean;
var
a: byte;
begin
a:=PortReadByte(AddrLPT+1);
a:=a div 2;
a:=a div 2;
a:=a div 2;
if nr=5 then begin LptRead:=not ((a mod 2)=1); exit end;
a:=a div 2;
if nr=4 then begin LptRead:=not ((a mod 2)=1); exit end;
a:=a div 2;
if nr=3 then begin LptRead:=not ((a mod 2)=1); exit end;
a:=a div 2;
if nr=1 then begin LptRead:=not ((a mod 2)=1); exit end;
a:=a div 2;
if nr=2 then begin LptRead:=(a mod 2)=1; exit end;
LptRead:=false;
end;
initialization
AddrLPT:=$378;
for i:=1 to 11 do
v[i]:=false;
LptWrite(12,false);
end.
----------------------------------------------------------------------
i w drugim formularzu odpalam program:
---------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, WinLpt, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Text1: TEdit;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Text1Change(Sender: TObject);
procedure Label2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
a,b:integer;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
WinLpt.LptRead(b)
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
WinLpt.LptWrite(a,yes);
end;
procedure TForm1.Text1Change(Sender: TObject);
begin
a:=StrToInt(Text1.Text);
end;
procedure TForm1.Label2Click(Sender: TObject);
begin
Label2.Caption:=IntToStr(b)
end;
end.
Wysyła mi to dane, ale nie chce czytać