serial.~pas

串口开发

unit Serial;

interface

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

type
  TFrmMain = class(TForm)
    iThreadTimers1: TiThreadTimers;
    Button1: TButton;
    RadioGroup1: TRadioGroup;
    Button2: TButton;
    Button3: TButton;
    Memo1: TMemo;
    Button4: TButton;
    Memo2: TMemo;
    StatusBar1: TStatusBar;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure iThreadTimers1Timer1(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure OpenSerialPort;
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;
  hSerialPort:Cardinal;
  count:Integer;
implementation

{$R *.dfm}

procedure TFrmMain.OpenSerialPort;
var
cc:TCommConfig;
Temp:string;
begin
Temp:='Com'+inttostr(RadioGroup1.ItemIndex+1);
hSerialPort:=CreateFile(PChar(Temp),GENERIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,0,0);
if (hSerialPort=invalid_handle_value) then
begin
    MessageBox(0,'打开串口失败','',MB_OK);
    Exit;
end;
GetCommState(hSerialPort,cc.dcb);
cc.dcb.BaudRate:=CBR_9600;
cc.dcb.ByteSize:=8;
cc.dcb.Parity:=NOPARITY;
cc.dcb.StopBits:=ONESTOPBIT;
if not SetCommState(hSerialPort,cc.dcb) then
begin
    ShowMessage('不能设置串口');
    CloseHandle(hSerialPort);
    Exit;
end
else
     ShowMessage('打开，并设置成功！');
end;

procedure TFrmMain.Button1Click(Sender: TObject);
begin
  OpenSerialPort;
end;

procedure TFrmMain.Button2Click(Sender: TObject);
begin
if hSerialPort<>0 then CloseHandle(hSerialPort);
Exit;
end;

procedure TFrmMain.Button3Click(Sender: TObject);
var
temp:string;
lw:LongWord;
begin
if hSerialPort=0 then Exit;
temp:=Memo1.Text;
WriteFile(hSerialPort,PChar(temp)^,Length(temp),lw,nil);
end;

procedure TFrmMain.Button4Click(Sender: TObject);
var
tempString:string;
inBuff:array[0..2047]of Char;
bytesRead,dwError:LongWord;
cs:TComStat;
begin
ClearCommError(hSerialPort,dwError,@cs);
if cs.cbInQue>SizeOf(inBuff)then
begin
    PurgeComm(hSerialPort,PURGE_RXCLEAR);
    Exit;
end;
ReadFile(hSerialPort,inBuff,cs.cbInQue,bytesRead,nil);
tempString:=Copy(inBuff,1,cs.cbInQue);
Memo2.Text:=tempString; 
end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if hSerialPort<>0 then CloseHandle(hSerialPort);
Exit;
end;

procedure TFrmMain.iThreadTimers1Timer1(Sender: TObject);
var
temp:string;
lw:LongWord;
begin
if hSerialPort=0 then Exit;
temp:=Memo1.Text;
WriteFile(hSerialPort,PChar(temp)^,Length(temp),lw,nil);
count:=count+1;
StatusBar1.Panels.Items[0].Text:=IntToStr(count);
//StatusBar1.Canvas.TextOut(1,4,IntToStr(count));
end;

procedure TFrmMain.Button5Click(Sender: TObject);
begin
  if iThreadTimers1.Enabled1 then iThreadTimers1.Enabled1:=False
  else iThreadTimers1.Enabled1:=true;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
RadioGroup1.ItemIndex:=0;
end;

end.