testserial.pas

PC_COM串口通信

unit TestSerial;

interface

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

function OpenCOM (port :integer) : integer;stdcall; external 'Serial.DLL';
procedure CloseCOM; stdcall; external 'Serial.DLL';
function ReadCharCOM (var kar:char):Boolean;stdcall; external 'Serial.DLL';
function BaudRateSet (baud:cardinal):Boolean;stdcall; external 'Serial.DLL';
function ParitySet (par:byte):Boolean;stdcall; external 'Serial.DLL';
function BitsPerByteSet (bpb:byte):Boolean;stdcall; external 'Serial.DLL';
function StopBitsSet (stop:byte):Boolean;stdcall; external 'Serial.DLL';
procedure SendCharCOM (ch : char); stdcall; external 'Serial.DLL';
procedure SetTxD;stdcall; external 'Serial.DLL';
procedure ResetTxD;stdcall; external 'Serial.DLL';
procedure SetRTS;stdcall; external 'Serial.DLL';
procedure ResetRTS;stdcall; external 'Serial.DLL';
procedure SetDTR;stdcall; external 'Serial.DLL';
procedure ResetDTR;stdcall; external 'Serial.DLL';
function  GetCTS : integer;stdcall; external 'Serial.DLL';
function  GetDCD : integer;stdcall; external 'Serial.DLL';
function  GetDSR : integer;stdcall; external 'Serial.DLL';
function  GetRI : integer;stdcall; external 'Serial.DLL';
function  ComExists (port: integer): integer;stdcall; external 'Serial.DLL';
function GetPortNr : Integer;stdcall; external 'Serial.DLL';
function COMPortExists (port : integer):integer;stdcall; external 'Serial.DLL';
procedure WaitStatus;stdcall;external 'Serial.DLL';
function GetHandle : integer;stdcall;external 'Serial.DLL';
procedure CheckInputs (UserMessage:integer;ApHndl:HWND);stdcall; external 'Serial.DLL';


type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button5: TButton;
    Button7: TButton;
    ComboBox1: TComboBox;
    StatusBar1: TStatusBar;
    DCDLabel: TLabel;
    DSRLabel: TLabel;
    RxDLABEL: TLabel;
    RTSLabel: TLabel;
    TxDLabel: TLabel;
    Image1: TImage;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    CTSLabel: TLabel;
    DTRLabel: TLabel;
    RILabel: TLabel;
    GNDLabel: TLabel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox3: TCheckBox;
    ComboBox2: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    ComboBox4: TComboBox;
    Label9: TLabel;
    ComboBox5: TComboBox;
    Label10: TLabel;
    Memo1: TMemo;
    Memo2: TMemo;
    Label11: TLabel;
    Label12: TLabel;
    Button4: TButton;
    ComboBox6: TComboBox;
    Label13: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Memo1KeyPress(Sender: TObject; var Key: Char);
    procedure ComboBox6KeyPress(Sender: TObject; var Key: Char);
    procedure ComboBox2Change(Sender: TObject);
  private
    procedure UpdateInput;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation
type TBaudArray = array [0..14] of integer;

const MessageID =5100 ;
const BaudRates : TBaudArray=(CBR_110,CBR_300,CBR_600,CBR_1200,
                  CBR_2400,CBR_4800,CBR_9600,CBR_14400,CBR_19200,
                  CBR_38400,CBR_56000,CBR_57600,CBR_115200,
                  CBR_128000,CBR_256000);
const Parity : array [0..3] of integer = (NOPARITY,EVENPARITY,
                  ODDPARITY,MARKPARITY);
const Bits   : array [0..4] of byte =(8,7,6,5,4);
const StopBits : array [0..2] of byte = (ONESTOPBIT,
                  ONE5STOPBITS,TWOSTOPBITS);

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  t : integer;
begin
  t:=OpenCOM (ComboBox1.ItemIndex+1);
  if (t<>0) then
  begin
    if (BaudRateSet (BaudRates[ComboBox2.ItemIndex])=true) and
    (ParitySet (Parity[ComboBox4.ItemIndex])=true) and
    (BitsPerByteSet (Bits[ComboBox6.ItemIndex])=true) and
    (StopbitsSet (StopBits[ComboBox5.ItemIndex])=true)
    then
    begin
      ComboBox1.Enabled:=False;
      StatusBar1.Panels.Items[0].Text:='Connected';
      Caption:='Test Serial ELEKTOR connected';
      ResetTXD;
      ResetDTR;
      ResetRTS;
      Button5.Enabled:=True; Button7.Enabled:=True;
      Button3.Enabled:=True;
      UpdateInput;
      CheckInputs (MessageID,Application.Handle);
      Button1.Enabled:=False; Button2.Enabled:=True;
      Memo1.Clear;Memo2.Clear;
      Memo1.Enabled:=True;
      ComboBox2.Enabled:=false;
      ComboBox4.Enabled:=false;
      ComboBox5.Enabled:=false;
      ComboBox6.Enabled:=false;
    end
    else
      CloseCOM;
  end;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
  ComboBox1.Enabled:=True;
  CloseCOM;
  Caption:='Test Serial ELEKTOR';
  StatusBar1.Panels.Items[0].Text:='Not connected';
  Button5.Enabled:=False;
  Button7.Enabled:=False;
  Button3.Enabled:=false;
  UpdateInput;
  Button2.Enabled:=False;
  Button1.Enabled:=True;
  Memo1.Enabled:=False;
  ComboBox2.Enabled:=true;
  ComboBox4.Enabled:=true;
  ComboBox5.Enabled:=true;
  ComboBox6.Enabled:=true;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if (Button3.Caption='SetTxD') then
  begin
    SetTxD;
    Button3.Caption:='ResetTxD';
{ Sending a character while TxD is set causes the program  }
{ to crash. Prevent sending a character by disabling Memo1 }
    Memo1.Enabled:=False;
  end
  else
  begin
    ResetTxD;
    Button3.Caption:='SetTxD';
    Memo1.Enabled:=True;
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Memo1.Clear;
  Memo2.Clear;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  if (Button5.Caption='SetRTS') then
  begin
    SetRTS();
    Button5.Caption:='ResetRTS';
  end
  else
  begin
    ResetRTS();
    Button5.Caption:='SetRTS';
  end;
end;


procedure TForm1.Button7Click(Sender: TObject);
begin
  if (Button7.Caption='SetDTR') then
  begin
    SetDTR;
    Button7.Caption:='ResetDTR';
  end
  else
  begin
    ResetDTR;
    Button7.Caption:='SetDTR';
  end;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  ResetDTR;
end;



procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
  k : char;
begin
  if Msg.message = MessageID then
  begin
    UpdateInput;
    Handled:=True;
    UpdateInput;
    if ((Msg.wParam and  EV_RXCHAR)<>0) then
    begin
      ReadCharCOM (k);
      if (k<>chr(13)) then
      begin
        Memo2.Lines.Strings[Memo2.Lines.Count-1]:=Memo2.Lines.Strings[Memo2.Lines.Count-1]+k;
      end
      else
        Memo2.Lines.Add ('');

    end;
    if (ComboBox1.Enabled=false) then  CheckInputs (MessageID,Application.Handle);
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  x : integer;
begin
  Application.OnMessage:=AppMessage;
  ComboBox1.Clear;
  for x:=1 to 10 do
    if (COMPortExists(x)=1) then ComboBox1.Items.Add ('COM'+IntToStr(x));
  if (ComboBox1.Items.Count>0) then
  begin
    ComboBox1.ItemIndex:=0;
    Caption:='Test Serial ELEKTOR';
    Statusbar1.Panels.Items[0].Text:='Not connected';
    Statusbar1.Panels.Items[1].Text:=ComboBox1.Text;
    ComboBox2.ItemIndex:=0;
    ComboBox4.ItemIndex:=0;
    ComboBox5.ItemIndex:=0;
    ComboBox6.ItemIndex:=0;
  end
  else
  begin
    Application.Messagebox ('No Serial port found. Closing Program!','ERROR',MB_OK);
    Application.Terminate;
  end;
end;

procedure TForm1.UpdateInput;
var
  k : char;
begin
  if (GetDCD=1) then CheckBox1.Checked:=true else CheckBox1.Checked:=False;
  if (GetCTS=1) then CheckBox4.Checked:=true else CheckBox4.Checked:=False;
  if (GetDSR=1) then CheckBox2.Checked:=true else CheckBox2.Checked:=False;
  if (GetRI=1) then CheckBox3.Checked:=true else CheckBox3.Checked:=False;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  StatusBar1.Panels.Items[1].Text:=ComboBox1.Text;
end;



procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  CloseCOM;
end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
{ Check if TxD-pin is not set. Sending while TxD is set causes  }
{ the program to crash!                                         }
  If (Button3.Caption='SetTxD') then
  begin
     SendCharCOM (Key);
  end;
end;

procedure TForm1.ComboBox6KeyPress(Sender: TObject; var Key: Char);
begin
  Key:=Chr(0);
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
begin
  if (BaudRateSet(BaudRates[ComboBox2.ItemIndex])=false) then
    MessageBox (0,'Failed setting Baudrate','ERROR',MB_OK);
end;


end.