并口编程

开发平台：
Delphi

Unit1.pas：源码内容
							unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, XPMan;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    GroupBox2: TGroupBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    CheckBox9: TCheckBox;
    GroupBox3: TGroupBox;
    CheckBox10: TCheckBox;
    CheckBox11: TCheckBox;
    CheckBox12: TCheckBox;
    CheckBox13: TCheckBox;
    CheckBox14: TCheckBox;
    CheckBox15: TCheckBox;
    CheckBox16: TCheckBox;
    CheckBox17: TCheckBox;
    XPManifest1: TXPManifest;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    ComboBox1: TComboBox;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Memo1DblClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  d,s,c:short;
  j,k,l:integer;
  lptaddr:integer;
  s1,s2:string;
  data1:array[1..8] of TCheckBox;
  status1:array[1..5] of TCheckBox;
  control1:array[1..4] of TCheckBox;
  data:short;
  status:short;
  control:short;
  function Inp32(lptaddr:short):short;stdcall external 'INPOUT32.DLL';
  procedure Out32(portaddr:short;datum:short);stdcall external 'INPOUT32.DLL';
  procedure writecheckbox(d:integer;s:integer;c:integer);
implementation
{$R *.dfm}
procedure writecheckbox(d:integer;s:integer;c:integer);
begin
for j:=1 to 8 do
           begin
                 k:=d mod 2;
                 d:=d div 2;
                 if k=1 then data1[j].Checked:=true
                 else data1[j].checked:=false;
           end;
s:=s div 8;
for j:=4 to 8 do
           begin
                 k:=s mod 2;
                 s:=s div 2;
                 if k=1 then status1[j-3].Checked:=true
                 else status1[j-3].checked:=false;
           end;
for j:=1 to 4 do
           begin
                 k:=c mod 2;
                 c:=c div 2;
                 if k=1 then control1[j].Checked:=true
                 else control1[j].checked:=false;
           end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
s:=Inp32(status);
c:=Inp32(control);
d:=Inp32(data);
memo1.Lines.Add(format('%s           %s       %s',
                         [inttohex(c,2),inttohex(s,2),inttohex(d,2)]));
writecheckbox(d,s,c);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  data:=$378;
  status:=$379;
  control:=$37a;
  control1[1]:=CheckBox1;
  control1[2]:=CheckBox2;
  control1[3]:=CheckBox3;
  control1[4]:=CheckBox4;
  status1[1]:=CheckBox9;
  status1[2]:=CheckBox8;
  status1[3]:=CheckBox7;
  status1[4]:=CheckBox5;
  status1[5]:=CheckBox6;
  data1[1]:=CheckBox10;
  data1[2]:=CheckBox11;
  data1[3]:=CheckBox12;
  data1[4]:=CheckBox13;
  data1[5]:=CheckBox14;
  data1[6]:=CheckBox15;
  data1[7]:=CheckBox16;
  data1[8]:=CheckBox17;
  memo1.Clear;
  memo1.ReadOnly:=true;
  lptaddr:=$378;
  memo1.Lines.Add('LPT address 0x'+inttohex(lptaddr,2));
end;
procedure TForm1.Memo1DblClick(Sender: TObject);
begin
 s1:=memo1.SelText;
 l:=length(s1);
 s2:='$00';
 s2[2]:=s1[1];
 s2[3]:=s1[2];
 d:=0;
 s:=0;
 c:=0;
 if l=2 then d:=strtoint(s2)
 else if l=9 then s:=strtoint(s2)
 else if l=13 then c:=strtoint(s2);
 writecheckbox(d,s,c);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
k:=1;
d:=0;
for j:=1 to 8 do
                begin
                      if data1[j].Checked=true then d:=d+k;
                      k:=k*2;
                end;
Out32(data,d);
k:=1;
c:=0;
for j:=1 to 4 do
                begin
                      if control1[j].Checked=true then c:=c+k;
                      k:=k*2;
                end;
Out32(control,c);
end;
procedure TForm1.ComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
if not(key in ['0'..'9','a'..'f','x',#8]) then
key:=#0;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
s1:=combobox1.Text;
j:=length(s1);
if j=0 then
          begin
             showmessage('请输入一个并口地址');
             combobox1.Text:=('0x'+inttohex(data,2));
          end
else
   begin
      s2:='$000';
      if s1[1]='0' then
                     begin
                        if s1[2]='x' then
                         for k:=3 to j do
                            if not(s1[k]='x') then s2[4+k-j]:=s1[k]
                            else
                                begin
                                   s2:='$000';
                                   break;
                                end;
                     end;
      lptaddr:=strtoint(s2);
      if lptaddr=0 then
                     begin
                        showmessage('错误的并口基址');
                        combobox1.Text:=('0x'+inttohex(data,2));
                     end
      else
        begin
           data:=lptaddr;
           status:=lptaddr+1;
           control:=lptaddr+2;
           showmessage('并口基址改为 0x'+inttohex(lptaddr,2));
           memo1.Lines.Add('LPT address 0x'+inttohex(lptaddr,2));
        end;
   end;
end;
end.

						