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, ImgList, ToolWin;

type
  TForm1 = class(TForm)
    MSComm1: TMSComm;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Button3: TButton;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    ComboBox2: TComboBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Buffer1: TMenuItem;
    editenable1: TMenuItem;
    N3: TMenuItem;
    FF1: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    Label7: TLabel;
    Edit1: TEdit;
    Timer1: TTimer;
    ProgressBar1: TProgressBar;
    Memo2: TMemo;
    F1: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ImageList1: TImageList;
    ToolButton2: TToolButton;
    procedure N2Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure editenable1Click(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 N9Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
  private
    { Private declarations }
    procedure BufferToMemo();
    procedure SetBuffer(val:byte);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  memoxp:integer;
  memoyp:integer;
  breceived:BOOLEAN;
//    vTmp:Variant;
//    ovTmp:oleVariant;
  BUF_REC:ARRAY[0..31] OF ARRAY[0..7] OF BYTE;
implementation

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

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

     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);
       form1.memo2.lines.Add(strmemo2);
     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;
  BUTTON2.Enabled :=mscomm1.PortOpen;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BUTTON1.Enabled :=FALSE;
  BUTTON2.Enabled :=FALSE;
  mscomm1.CommPort :=combobox1.ItemIndex+1 ;
  mscomm1.Settings :=string(combobox2.Text) ;
  button3.Caption :='打开串口';
  SetBuffer($FF);
  BufferToMemo();
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;
  BUTTON2.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;
  BUTTON2.Enabled :=mscomm1.PortOpen;


end;

procedure TForm1.editenable1Click(Sender: TObject);
begin
  editenable1.Checked :=not editenable1.Checked ;
  memo1.ReadOnly :=not editenable1.Checked;
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;
    strmemo:string;
begin