Форум "Delphi"

Паскаль, Делфи

#0 Vitar © 28.09.06 08:28:45 - 20.10.06 16:49:52

LPT - порт

Как к ниму правильно добраться ???

#1 Deep © 28.09.06 10:37:09

зависит от виндовса

#2 Vitar © 29.09.06 09:26:17

NT -интерисует!!! чтоб быть точнее 2000, ХР...

#3 kostjan 11.10.06 09:07:41

v spravke,cherez poisk- modul',funkcii...

отправлено с мобилки

#4 Inventor 20.10.06 16:49:52

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
   Timer1: TTimer;
   GroupBox1: TGroupBox;
   StaticText1: TStaticText;
   ComboBox1: TComboBox;
   StaticText2: TStaticText;
   StaticText3: TStaticText;
   StaticText4: TStaticText;
   StaticText5: TStaticText;
   StaticText6: TStaticText;
   StaticText7: TStaticText;
   GroupBox2: TGroupBox;
   StaticText8: TStaticText;
   ComboBox2: TComboBox;
   StaticText9: TStaticText;
   Edit1: TEdit;
   Button1: TButton;
   Button2: TButton;
   CheckBox1: TCheckBox;
   Panel1: TPanel;
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure Button2Click(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
   procedure Button1Click(Sender: TObject);
   procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
   { Private declarations }
   Lpt : TLptPortConnection;
  public
   { Public declarations }
   function GetCurrentPort : byte; // ×èòàåò ñïèñîê ComboBox1 è âîçâðàùàåò ñîîòâåòñòâóþùèé íîìåð ïîðòà
   function GetCurrentRegister : byte; // ×èòàåò ñïèñîê ComboBox2 è âîçâðàùàåò ñîîòâåòñòâóþùèé íîìåð ðåãèñòðà

  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var msg : AnsiString;
begin
Lpt := TLptPortConnection.Create;
if not Lpt.Ready then
  begin { îáúåêò íå ãîòîâ -- ïîêàæåì êîä îøèáêè }
  msg := 'Îøèáêà ïðè ñîçäàíèè îáúåêòà Lpt, êîä = ' + IntToStr(GetLastError());
  Application.MessageBox(PChar(msg),'ERROR',MB_OK);
  Application.Terminate; // âûõîä
  end;
// Ïðîâåðèì íàëè÷èå ïîðòîâ è çàïîëíèì èõ ñïèñîê â ComboBox-e
ComboBox1.Items.Clear;
ComboBox1.Text := '';
if Lpt.IsPortPresent(LPT1) then ComboBox1.Items.Add('LPT1');
if Lpt.IsPortPresent(LPT2) then ComboBox1.Items.Add('LPT2');
if Lpt.IsPortPresent(LPT3) then ComboBox1.Items.Add('LPT3');
if 0<>ComboBox1.Items.Count then ComboBox1.ItemIndex := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Timer1.Enabled := false;
Lpt.Destroy;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Close();
end;

function TForm1.GetCurrentPort : byte; // ×èòàåò ñïèñîê ComboBox1 è âîçâðàùàåò ñîîòâåòñòâóþùèé íîìåð ïîðòà
begin
if 'LPT1' = ComboBox1.Text then
  GetCurrentPort:=LPT1
   else
  if 'LPT2' = ComboBox1.Text then
   GetCurrentPort:=LPT2 else
   GetCurrentPort:=LPT3;
end;

function TForm1.GetCurrentRegister : byte; // ×èòàåò ñïèñîê ComboBox2 è âîçâðàùàåò ñîîòâåòñòâóþùèé íîìåð ðåãèñòðà
begin
if 'ÄÀÍÍÛÕ' = ComboBox2.Text then
  GetCurrentRegister:=LPT_DATA_REG
   else
  if 'ÑÎÑÒÎßÍÈß' = ComboBox2.Text then
   GetCurrentRegister:=LPT_STATE_REG else
   GetCurrentRegister:=LPT_CONTROL_REG;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var PairArray : packed array [0..2] of ADRDATASTRUCT;
   port : byte;
begin
if CheckBox1.Checked then
  begin
   port:=GetCurrentPort(); // Ïîëó÷èòü íîìåð âûáðàííîãî ïîðòà
   // Èíèöèàëèçèðóåì ìàññèâ
   PairArray[0].Adr := port or LPT_DATA_REG;
   PairArray[1].Adr := port or LPT_STATE_REG;
   PairArray[2].Adr := port or LPT_CONTROL_REG;
   // ×èòàåì ïîðòû
   if not Lpt.ReadPorts((собачка)PairArray,3) then
   Panel1.Color := clRed else
   begin
   Panel1.Color := clLime;
   // Âûâåäåì ðåçóëüòàòû ÷òåíèÿ ïîðòîâ
   StaticText5.Caption := IntToHex(integer(PairArray[0].Data),2);
   StaticText6.Caption := IntToHex(integer(PairArray[1].Data),2);
   StaticText7.Caption := IntToHex(integer(PairArray[2].Data),2);
   end;

  end; // if Checked...
end;

procedure TForm1.Button1Click(Sender: TObject); {âûâîä çíà÷åíèÿ â ðó÷íîì ðåæèìå}
var Value : byte;
begin
Value := StrToInt('$0'+Edit1.Text);
Lpt.WritePort(GetCurrentPort(),GetCurrentRegister(),Value);
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin

if not ((Key<' ') or ((Key>='0')and(Key<='9')) or ((Key>='A')and(Key<='F')) or ((Key>='a')and(Key<='f'))) then
  Key := chr(0);
end;

end.

Написать ответ