ucomm.pas

Delphi源程序

unit ucomm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SPComm, StdCtrls, Menus, DdeMan, ActnList, ExtCtrls, Buttons;

type
  TFComm = class(TForm)
    Comm1: TComm;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    ComboBox1: TComboBox;
    Label2: TLabel;
    ComboBox2: TComboBox;
    Label3: TLabel;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    ComboBox5: TComboBox;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender:TObject;var Action:TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;BufferLength: Word);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FComm: TFComm;
  viewstring:string;
  i:integer;
  rbuf,sbuf:array[1..16]of byte;
implementation

{$R *.dfm}
//自定义发送数据过程
procedure senddata;
var
   i:integer;
   commflg:boolean;
   begin
   viewstring:='';
   commflg:=True;
   for i:=1 to 6 do
   begin
      if not fcomm.Comm1.WriteCommData(@sbuf[i],1)then
      begin
         commflg:=false;
         break;
      end;
      //发送时字节间的延时
      sleep(2);
      viewstring:=viewstring+IntToHex(sbuf[i],2)+'';
   end;
   viewstring:='发送'+viewstring;
   fcomm.Memo1.Lines.Add(viewstring);
   //fcomm.Memo1.Lines.Add('');
   if not commflg then
        MessageDlg('发送成功！',mtInformation,[mbyes],0);
   end;
//打开串口
procedure TFComm.FormShow(Sender:TObject);
begin
     comm1.StartComm;  //创建窗体时，将comm1控件打开
end;
//关闭串口
procedure TFComm.FormClose(Sender:TObject;var Action:TCloseAction);
begin
    comm1.StopComm;//关闭窗体时，将comm1控件关闭
end;

//发送按钮的单击事件
procedure TFComm.Button1Click(Sender: TObject);
begin
   sbuf[1]:=1;//帧头
   sbuf[2]:=2;//命令号
   sbuf[3]:=3;
   sbuf[4]:=4;
   sbuf[5]:=5;
   sbuf[6]:=6;  //帧
   senddata;   //调用发送函数
end;
//接收过程
procedure TFComm.Button2Click(Sender: TObject);
var
    StrReceive:string;
    Buffer:Pointer;
    BufferLength:Word;
begin
    SetLength(StrReceive,BufferLength);
    Move(Buffer^,PChar(StrReceive)^,BufferLength);
    //
    Memo1.Lines.Add(StrReceive);
    Memo1.Invalidate;
end;

procedure TFComm.Comm1ReceiveData(Sender:TObject;Buffer:Pointer;BufferLength:Word);
var
i:integer;
begin
viewstring:='';
Move(Buffer^,PChar(@rbuf)^,BufferLength);
for i:=1 to bufferlength do
viewstring:=viewstring+inttohex(rbuf[i],2)+'';
viewstring:='接收'+viewstring;
memo1.lines.add(viewstring);
memo1.lines.add('');

end;

end.