unit1.pas

Delphi下串口通讯源代码(本人用的测试程序)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, MSCommLib_TLB, StdCtrls, Menus, ExtCtrls, Mask,
  ComCtrls,StrUtils;

type
  TForm1 = class(TForm)
    MSComm1: TMSComm;
    Button1: TButton;
    Memo1: TMemo;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    ComboBox1: TComboBox;
    Button3: TButton;
    ComboBox2: TComboBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    Edit11: TEdit;
    Edit12: TEdit;
    Edit13: TEdit;
    Button2: TButton;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Edit14: TEdit;
    Label18: TLabel;
    Button5: TButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    ComboBox3: TComboBox;
    Timer1: TTimer;
    CheckBox3: TCheckBox;
    Label20: TLabel;
    Edit15: TEdit;
    Label19: TLabel;
    Button4: TButton;
    Label21: TLabel;
    Label22: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    Edit16: TEdit;
    Label23: TLabel;
    Memo2: TMemo;
    SaveDialog1: TSaveDialog;
    Button6: TButton;
    Memo3: TMemo;
    Button7: TButton;
    Memo4: TMemo;
    Button8: TButton;
    procedure N2Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Memo1Click(Sender: TObject);
    procedure Memo1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Memo1KeyPress(Sender: TObject; var Key: Char);
    procedure N3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FF1Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit9Change(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Edit16Change(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Edit16Click(Sender: TObject);
  private
    { Private declarations }
    procedure BufferToMemo();
    procedure SetBuffer(val:byte);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  memoxp:integer;
  memoyp:integer;
  breceived:BOOLEAN;
  oldtmp,chlcount:byte;
  bcheckstart:boolean;
  TmpFreq,differ:string;
  TmpVIFL:byte;
  strMidHighFreq:string;
//    vTmp:Variant;
//    ovTmp:oleVariant;
  BUF_REC:ARRAY[0..31] OF ARRAY[0..7] OF BYTE;

    SendBuffer:array[0..13] of byte;
implementation

{$R *.dfm}
uses unit2,unit3;

procedure TForm1.BufferToMemo();
var
  i,j:integer;
  strmemo,strmemo2:string;
begin
     form1.Memo1 .Clear ;
     form1.memo1.Lines.Add('Address 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F');

     for i:=0 to 15 do
     begin
       strmemo:='  '+format('%2.2x',[i*16])+'H'+'  ';
       strmemo2:='';
       for j:=0 to 7 do
       begin
          strmemo:=strmemo+' '+format('%2.2x',[buf_rec[2*i][j]]);
          if(buf_rec[2*i][j]>=$20)and (buf_rec[2*i][j]<128)then
            strmemo2:=strmemo2+chr(buf_rec[2*i][j])
          else strmemo2:=strmemo2+'.';
       end;
       for j:=0 to 7 do
       begin
          strmemo:=strmemo+' '+format('%2.2x',[buf_rec[2*i+1][j]]);
          if(buf_rec[2*i+1][j]>=$20)and(buf_rec[2*i+1][j]<128)then
            strmemo2:=strmemo2+chr(buf_rec[2*i+1][j])
          else strmemo2:=strmemo2+'.';
       end;
       form1.memo1.lines.Add(strmemo);
     end;
end;


procedure TForm1.SetBuffer(val:byte);
var
  i,j:integer;
begin
   for i:=0 to 31 do
   begin
      for j:=0 to 7 do
        BUF_REC[i][j]:=val;
   end;
end;



procedure TForm1.N2Click(Sender: TObject);
begin
  form2.ShowModal ;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
var
  btmp:boolean;
begin
  btmp:=mscomm1.PortOpen;
  if(mscomm1.PortOpen)then mscomm1.PortOpen :=false;
  mscomm1.CommPort :=combobox1.ItemIndex+1 ;
  if(btmp)then mscomm1.PortOpen :=btmp;
  if mscomm1.PortOpen then
  begin
     label3.Color :=clred;
     label4.Caption :='端口已打开';
  end
  else
  begin
    label3.Color :=clbtnface;
    label4.Caption :='端口未打开';
  end;
  BUTTON1.Enabled :=mscomm1.PortOpen;
  BUTTON5.Enabled :=mscomm1.PortOpen;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BUTTON1.Enabled :=FALSE;
  BUTTON5.Enabled :=FALSE;
  mscomm1.CommPort :=combobox1.ItemIndex+1 ;
  mscomm1.Settings :=string(combobox2.Text) ;
  button3.Caption :='打开串口';
  memo1.Clear ;
  memo3.Clear ;
  memo4.Clear ;
  TmpFreq:='0';

    SendBuffer[0]:=$53;
    SendBuffer[1]:=strtoint('$'+edit2.Text);
    SendBuffer[2]:=strtoint('$'+edit3.Text);
    SendBuffer[3]:=strtoint('$'+edit4.Text);
    SendBuffer[4]:=strtoint('$'+edit5.Text);
    SendBuffer[5]:=strtoint('$'+edit6.Text);
    SendBuffer[6]:=strtoint('$'+edit7.Text);
    SendBuffer[7]:=strtoint('$'+edit8.Text);
    SendBuffer[8]:=strtoint('$'+edit9.Text);
    SendBuffer[9]:=strtoint('$'+edit10.Text);
    SendBuffer[10]:=strtoint('$'+edit11.Text);
    SendBuffer[11]:=strtoint('$'+edit12.Text);
    SendBuffer[12]:=SendBuffer[1];
    SendBuffer[12]:=SendBuffer[12]+SendBuffer[2];
    SendBuffer[12]:=SendBuffer[12]+SendBuffer[3];
    SendBuffer[12]:=SendBuffer[12]+SendBuffer[4];
    SendBuffer[12]:=SendBuffer[12]+SendBuffer[5];
    SendBuffer[12]:=SendBuffer[12]+SendBuffer[6];
    SendBuffer[12]:=SendBuffer[12]+SendBuffer[7];
    SendBuffer[12]:=SendBuffer[12]+SendBuffer[8];
    SendBuffer[12]:=SendBuffer[12]+SendBuffer[9];
    SendBuffer[12]:=SendBuffer[12]+SendBuffer[10];
    SendBuffer[12]:=SendBuffer[12]+SendBuffer[11];
    SendBuffer[12]:=$ff-SendBuffer[12];
    SendBuffer[12]:=SendBuffer[12]+1;
    SendBuffer[13]:=$45;
    memo2.Clear ;
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
begin
  if mscomm1.PortOpen then mscomm1.PortOpen :=false;
  mscomm1.Settings :=string(combobox2.Text);
  mscomm1.PortOpen :=true;

  if mscomm1.PortOpen then
  begin
     label3.Color :=clred;
     label4.Caption :='端口已打开';
      button3.Caption :='关闭串口';
  end
  else
  begin
    label3.Color :=clbtnface;
    label4.Caption :='端口未打开';
     button3.Caption :='打开串口';
  end;
  BUTTON1.Enabled :=mscomm1.PortOpen;
  BUTTON5.Enabled :=mscomm1.PortOpen;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if mscomm1.PortOpen  then
  begin
    if button3.Caption ='关闭串口'then
    begin
      button3.Caption :='打开串口';
      mscomm1.PortOpen :=false;
    end
    else
      mscomm1.PortOpen :=true;
  end
  else
  begin
    if(button3.Caption ='打开串口')then
    begin
      button3.Caption :='关闭串口';
      mscomm1.PortOpen :=True;
    end
    else
      mscomm1.PortOpen :=True;
  end;
  if mscomm1.PortOpen then
  begin
     label3.Color :=clred;
     label4.Caption :='端口已打开';
  end
  else
  begin
    label3.Color :=clbtnface;
    label4.Caption :='端口未打开';
  end;
  BUTTON1.Enabled :=mscomm1.PortOpen;
  BUTTON5.Enabled :=mscomm1.PortOpen;
  BUTTON4.Enabled :=mscomm1.PortOpen;


end;

procedure TForm1.Memo1Click(Sender: TObject);
begin
  memoxp:= memo1.CaretPos.X;
  memoyp:= memo1.CaretPos.Y;
end;

procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  memoxp:= memo1.CaretPos.X;
  memoyp:= memo1.CaretPos.Y;

end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
var
  modx:integer;
  mody:integer;
begin
  modx:=  (memoxp-8) mod 3;
  if(Key>='0')and (key<='f')then
  begin
    if(key>='a')then key:=upcase(key);
    if(key>'F')then key:=chr(0);
  end
  else Key:=chr(0);
  if( memoxp>7)and (memoyp>0)and (memo1.SelStart>10 )and (memoyp<17) then
  begin
    if(memo1.SelText='')then
    begin
      if(modx=0)or (modx=1)then
      begin
        memo1.SelLength:=1 ;
        memoxp:= memo1.CaretPos.X;
        memoyp:= memo1.CaretPos.Y;
      end
      else if(modx=2)then
      begin
        Key:=chr(0);
      end
      else
        Key:=chr(0);
    end
    else if (memo1.SelLength=1) then
    begin
      modx:=  (memoxp -8) mod 3;
      if(modx<>0) and (modx<>1)then
          Key:=chr(0);
    end
    else
     Key:=chr(0);
  end
  else
    Key:=chr(0);
end;

procedure TForm1.N3Click(Sender: TObject);
begin
  SetBuffer($00);
  BufferToMemo();
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ByteArray:array[0..13] of byte;
  i,j,iReceived:integer;
    ovTmp:OleVariant;
    vTmp:Variant;
    ADDR:BYTE;
    bTmp:byte;
    bflagsuccess:boolean;