unit1.pas

使用spcomm控件进行串口通信的程序

//*********************************************************
//                 Kaersoft    卡尔软件
//         *************************************
//          http://www.kaer.cn/default.aspx
//          Email:[e-mail]
//          QQ:54076683
//          Delphi 7.0   PASS
//          调测人：JPYC
//**********************************************************
//                      程序功能
//            演示SPCOMM收发数据的例子
//**********************************************************
//实现思路：打开窗体时自动打开串口1，关闭是自动关闭串口
//**********************************************************
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SPComm;

type
  TForm1 = class(TForm)
    Comm1: TComm;
    Memo1: TMemo;
    Memo2: TMemo;
    Button3: TButton;
    Button4: TButton;
    Check1: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Label3: TLabel;
    Button1: TButton;
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure senddata(length:integer;buffer:array  of byte;gap: integer);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    timegap :integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

procedure TForm1.senddata(length:integer;buffer:array  of byte;gap: integer);
var
  i:integer;
  commflg:boolean;
  viewstring :string;
begin
   viewstring:='' ;
  commflg:=true;
  for i:=0 to length - 1  do
    begin
      if not form1.comm1.writecommdata(@buffer[i],1) then
        begin
          messagebox(handle,'发送失败！','Series Communications',mb_OK);
          commflg:=false;
          break;
        end;
      viewstring:=viewstring+inttohex(buffer[i],2)+'' ;
    end;
      sleep(gap);
      viewstring:='SEND='+ viewstring;
      form1.memo1.lines.add(viewstring);

  if not commflg then
    messagedlg('send error !',mterror,[mbyes],0);

end;

procedure TForm1.Button3Click(Sender: TObject);
var
  i,j,k:integer;
  sbuf : array [0..4] of byte;
begin
  timegap := strtoint(self.Edit1.text);
for i:=0 to 1 do
for j:= 0 to 4 do
for k:=0 to 7 do
begin
  sbuf[0] := byte($F0);
  sbuf[1] := byte(i+1);
  sbuf[2] := byte($C0+j);
  sbuf[3] := byte(k+1);
  sbuf[4] := byte($F1);
  self.senddata(5,sbuf,timegap);
  end;

end;

procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  i:integer;
  viewstring :string;
  sbuf,rbuf : array [0..4] of byte;
begin
  viewstring :='' ;
  move(buffer^,pchar(@rbuf)^,bufferlength);

  for i:=0 to bufferlength-1   do
    viewstring:=viewstring+inttohex(rbuf[i],2)+'' ;
    viewstring:='GET='+viewstring;
    memo2.lines.add(viewstring);   //串口接收回来的数据

{  if ((rbuf[0] = byte($F0)) and (rbuf[4] = byte($F1))) then
  begin
  sleep(20);
    sbuf[0] := byte($F0);
    sbuf[1] := byte($01);
    sbuf[2] := byte($C1);
    sbuf[3] := byte($10);
    sbuf[4] := byte($F1);
    senddata(5,sbuf,20);
  end;  }

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Comm1.StartComm;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  Comm1.StopComm;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i,j,k:integer;
  sbuf : array [0..4] of byte;
begin
  timegap := strtoint(self.Edit1.text);
for i:=0 to 1 do
for j:= 0 to 4 do
for k:=0 to 7 do
begin
  sbuf[0] := byte($F0);
  sbuf[1] := byte(i+1);
  sbuf[2] := byte($C0+j);
  sbuf[3] := byte($11+k);
  sbuf[4] := byte($F1);
  self.senddata(5,sbuf,timegap);
  end;
end;

end.