commtest.~pas

自己写的串口收发程序

unit commtest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, OleCtrls, ComCtrls;
const
  Wm_commNotify=wm_user + 1;
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    ComboBox5: TComboBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    Button2: TButton;
    Button3: TButton;
    CheckBox1: TCheckBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    Button5: TButton;
    Memo2: TMemo;
    Label8: TLabel;
    Edit2: TEdit;
    Label9: TLabel;
    Button6: TButton;
    Label10: TLabel;
    Label11: TLabel;
    Button7: TButton;
    Edit3: TEdit;
    Edit4: TEdit;
    Label12: TLabel;
    Label13: TLabel;
    BitBtn1: TBitBtn;
    ComboBox1: TComboBox;
    Label6: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label7: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    GroupBox4: TGroupBox;
    Timer1: TTimer;
    CheckBox4: TCheckBox;
    Memo1: TMemo;
    Label18: TLabel;
    Edit1: TEdit;
    procedure BitBtn1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure msgcommprocess(var message : Tmessage);
    message Wm_commNotify;
    procedure Button5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
  comm = class(TThread)
 private
    { Private declarations }
 protected
    procedure Execute; override;
 end;

var
  Form1 : TForm1;
  ShowText : boolean;
  tempstr : string;
  receivenum,sendnum : integer;
  hcom:Thandle;//用于串行通讯，得到有关串口的信息
  lpol,read_os:Poverlapped;

implementation

{$R *.dfm}

Procedure Comm.Execute; //线程执行过程
var
dwEvtMask:Dword;
Begin
While True do Begin
dwEvtMask:=0;
WaitCommEvent(hcom,dwevtmask,lpol);   //等待串行口事件；
if   ((dwEvtMask   and   EV_RXCHAR)=EV_RXCHAR)  then
PostMessage(Form1.Handle,WM_COMMNOTIFY,hcom,0);  //发送消息；
end;
end;


function StrToHexStr(const S:string):string;
//字符串转换成16进制字符串
var
  I:Integer;
begin
  for I:=1 to Length(S) do
  begin
    if I=1 then
      Result:=IntToHex(Ord(S[1]),2)+ ' '
    else Result:=Result+' '+IntToHex(Ord(S[I]),2) + ' ' ;
  end;
end;

function HexStrToStr(const S:string):string;
//16进制字符串转换成字符串
var
  t:Integer;
  ts:string;
  M,Code:Integer;
begin
  t:=1;
  Result:='';
  while t<=Length(S) do
  begin
    while not (S[t] in ['0'..'9','A'..'F','a'..'f']) do
      inc(t);
    if (t+1>Length(S))or(not (S[t+1] in ['0'..'9','A'..'F','a'..'f'])) then
      ts:='$'+S[t]
    else
      ts:='$'+S[t]+S[t+1];
    Val(ts,M,Code);
    if Code=0 then
      Result:=Result+Chr(M);
    inc(t,2);
  end;
end;


procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  close;
end;

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

procedure TForm1.Button6Click(Sender: TObject);
begin
  memo2.Clear;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  combobox1.Items.Add('com1');
  combobox1.Items.Add('com2');
  combobox1.Items.Add('com3');
  combobox2.Items.Add('110');
  combobox2.Items.Add('300');
  combobox2.Items.Add('600');
  combobox2.Items.Add('1200');
  combobox2.Items.Add('2400');
  combobox2.Items.Add('4800');
  combobox2.Items.Add('9600');
  combobox2.Items.Add('19200');
  combobox2.Items.Add('38400');
  combobox2.Items.Add('56000');
  combobox3.Items.Add('N');
  combobox3.Items.Add('O');
  combobox3.Items.Add('E');
  combobox3.Items.Add('M');
  combobox4.Items.Add('5');
  combobox4.Items.Add('6');
  combobox4.Items.Add('7');
  combobox4.Items.Add('8');
  combobox5.Items.Add('1');
  combobox5.Items.Add('1.5');
  combobox5.Items.Add('2');
  ShowText := true;
  receivenum := 0;
  sendnum := 0;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  dcb : Tdcb;
  port : pansichar;

begin
  if button1.Caption = '打开串口' then
  begin
  port := pansichar(ComboBox1.Text);
  hcom := createfile(port,generic_read or
      generic_write,0,nil,open_existing,
     file_flag_overlapped,0);//打开串行口
  if hcom = invalid_handle_value then
       showmessage('不能打开串口')
      else
         begin
         setupcomm(hcom,1024,1024);//设置输入，输出缓冲区皆为1024字节
         getcommstate(hcom,dcb); //获取串行口当前默认设置
         dcb.BaudRate := strtoint(ComboBox2.Text);
         if ComboBox5.Text = '1' then
               dcb.StopBits := onestopbit
         else if ComboBox5.Text = '2' then
               dcb.StopBits := twostopbits
         else
               dcb.StopBits := one5stopbits;
         dcb.ByteSize := strtoint(ComboBox4.Text);
         if ComboBox3.Text = 'N' then
               dcb.Parity := noparity
         else if ComboBox3.Text = 'O' then
               dcb.Parity := oddparity
         else if ComboBox3.Text = 'E' then
               dcb.Parity := evenparity
         else
               dcb.Parity := markparity;
         if not SetCommState(hCom,dcb) then
          showmessage('通信端口设置错误!');
         setcommMask(hcom,ev_rxchar);
         comm.Create(false);
         button1.Caption := '关闭串口';
         ComboBox1.Enabled := false;
         ComboBox2.Enabled := false;
         ComboBox3.Enabled := false;
         ComboBox4.Enabled := false;
         ComboBox5.Enabled := false;
         button5.Enabled   := true;
         CheckBox3.Enabled := true;
         Image1.Visible  := false;
         Image2.Visible   := true;
         label12.Caption := 'Opened';
         label12.Font.Color := clblue;
         end;
  end
  else //if Button1.Caption = '关闭串口' then
  begin
  timer1.enabled := false;
  CloseHandle(hcom);
  button1.Caption := '打开串口';
  ComboBox1.Enabled := true;
  ComboBox2.Enabled := true;
  ComboBox3.Enabled := true;
  ComboBox4.Enabled := true;
  ComboBox5.Enabled := true;
  button5.Enabled   := false;
  CheckBox3.Enabled := false;
  Image2.Visible   := false;
  Image1.Visible  := true;
  label12.Caption := 'Closed';
  label12.Font.Color := clred;
  end;
end;



Procedure TForm1.MsgcommProcess(Var Message:Tmessage);
var
Coms : Tcomstat;
lpErrors,ReadNumber : dWORD;
Read_Buffer : array[0..15]of char;
temp : string;
Begin
fillchar(Read_Buffer,16,#0);
if Clearcommerror(hcom,lpErrors,@Coms) Then
  if(Coms.cbInQue>0) then
  begin
    ReadFile(hCom,Read_Buffer,Coms.cbInQue,ReadNumber,@read_os);
       //处理接收数据
    temp := Read_Buffer;
    if checkbox1.Checked then
      temp := StrToHexStr(Read_Buffer);
    if showtext then
      memo1.text := memo1.text +temp;
    receivenum := receivenum + integer(readnumber);
    edit4.Text := inttostr(receivenum);
  end;
if form1.Memo1.lines.Count>30 then
  form1.memo1.Clear;
purgecomm(hcom,PURGE_RXCLEAR); //清串口读缓冲区
end;

procedure TForm1.Button5Click(Sender: TObject);
var
temp1 : string;
lw : LongWord;
begin
if checkbox2.Checked then
   temp1 := HexStrToStr(Memo2.Text)
  else
   temp1 := Memo2.Text;
WriteFile(hcom,PChar(temp1)^,Length(temp1),lw,@lpol);
sendnum := sendnum + Length(temp1);
edit3.Text := inttostr(sendnum);
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
begin
  if CheckBox3.Checked = true then
  begin
    button5.Enabled := false;
    timer1.Interval := strtoint(edit2.text);
    edit2.Enabled := false;
  end
  else  begin
          edit2.Enabled := true;
          button5.Enabled := true;
        end;
  Timer1.Enabled := CheckBox3.Checked;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if Memo2.Text<>'' then
    Button5.Click;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
ShowText:=not ShowText;
  if ShowText then
    button3.Caption:='停止显示'
  else button3.Caption:='恢复显示';
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
 receivenum := 0;
 sendnum := 0;
 edit3.Text := inttostr(sendnum);
 edit4.Text := inttostr(receivenum);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  panel1.width := form1.ClientWidth;
  memo1.Width := form1.ClientWidth - 187;
  memo2.Width := form1.ClientWidth - 187;
end;

end.