mian.pas

很好的串口调试程序

unit mian;

interface

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

type
  TForm1 = class(TForm)
    Comm1: TComm;
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    GroupBox2: TGroupBox;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    GroupBox3: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    Memo1: TMemo;
    GroupBox4: TGroupBox;
    RadioButton5: TRadioButton;
    RadioButton6: TRadioButton;
    RadioButton7: TRadioButton;
    RadioButton8: TRadioButton;
    RadioButton9: TRadioButton;
    RadioButton10: TRadioButton;
    RadioButton11: TRadioButton;
    RadioButton12: TRadioButton;
    Label1: TLabel;
    Button1: TButton;
    XPMenu1: TXPMenu;
    GroupBox5: TGroupBox;
    Image1: TImage;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    Image6: TImage;
    Image7: TImage;
    Image8: TImage;
    RadioGroup1: TRadioGroup;
    Panel2: TPanel;
    LCD991: TLCD99;
    procedure FormCreate(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton5Click(Sender: TObject);
    procedure RadioButton6Click(Sender: TObject);
    procedure RadioButton7Click(Sender: TObject);
    procedure RadioButton8Click(Sender: TObject);
    procedure RadioButton9Click(Sender: TObject);
    procedure RadioButton10Click(Sender: TObject);
    procedure RadioButton11Click(Sender: TObject);
    procedure RadioButton12Click(Sender: TObject);
    procedure GroupBox3Click(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
              BufferLength: Word);
    procedure Button1Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
    procedure GroupBox5Click(Sender: TObject);
  private
    { Private declarations }
    procedure msg_port(var msg:tmessage);message $2000;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  port:byte=0;
  rbuf:array[1..8] of byte;
  portout:byte;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  try
     comm1.commname:='COM1';
     comm1.BaudRate:=9600;
     comm1.StartComm;
     label1.Font.Color:=clgreen;
     label1.Caption:='run';
  except
     label1.Font.Color:=clred;
     label1.Caption:='stop';
     showmessage('串口打开错误,请检查连接是否正确或串口是否已被占用!');
  end;
end;

procedure TForm1.RadioButton3Click(Sender: TObject);
begin
  comm1.BaudRate:=19200;
end;

procedure TForm1.RadioButton4Click(Sender: TObject);
begin
  comm1.BaudRate:=9600;
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  comm1.StopComm;
  comm1.commname:='COM1';
  try
     comm1.StartComm;
     label1.Font.Color:=clgreen;
     label1.Caption:='run';
  except
     label1.Font.Color:=clred;
     label1.Caption:='stop';
     showmessage('串口打开错误,请检查连接是否正确或串口是否已被占用!');
  end;
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
begin
  comm1.StopComm;
  comm1.commname:='COM2';
  try
     comm1.StartComm;
     label1.Font.Color:=clgreen;
     label1.Caption:='run';
  except
     label1.Font.Color:=clred;
     label1.Caption:='stop';
     showmessage('串口打开错误,请检查连接是否正确或串口是否已被占用!');
  end;
end;

procedure sendstr(data:byte);
var
  str:string;
begin
   str:=chr(data);
   form1.comm1.WriteCommData(pchar(str),length(str));
end;

procedure TForm1.RadioButton5Click(Sender: TObject);
begin
  sendstr(ord('a'));
  RadioButton5.enabled:=False;
  RadioButton5.Checked:=False;
  Memo1.Lines.Append('发送:a');
  RadioButton5.enabled:=true;
end;

procedure TForm1.RadioButton6Click(Sender: TObject);
begin
  sendstr(ord('b'));
  RadioButton6.enabled:=False;
  RadioButton6.Checked:=False;
  Memo1.Lines.Append('发送:b');
  RadioButton6.enabled:=true;
end;

procedure TForm1.RadioButton7Click(Sender: TObject);
begin
  sendstr(ord('c'));
  RadioButton7.enabled:=False;
  RadioButton7.Checked:=False;
  Memo1.Lines.Append('发送:c');
  RadioButton7.enabled:=true;
end;

procedure TForm1.RadioButton8Click(Sender: TObject);
begin
  sendstr(ord('d'));
  RadioButton8.enabled:=False;
  RadioButton8.Checked:=False;
  Memo1.Lines.Append('发送:d');
  RadioButton8.enabled:=true;
end;

procedure TForm1.RadioButton9Click(Sender: TObject);
begin
  sendstr(ord('e'));
  RadioButton9.enabled:=False;
  RadioButton9.Checked:=False;
  Memo1.Lines.Append('发送:e');
  RadioButton9.enabled:=true;
end;

procedure TForm1.RadioButton10Click(Sender: TObject);
begin
  sendstr(ord('f'));
  RadioButton10.enabled:=False;
  RadioButton10.Checked:=False;
  Memo1.Lines.Append('发送:f');
  RadioButton10.enabled:=true;
end;

procedure TForm1.RadioButton11Click(Sender: TObject);
begin
  sendstr(ord('g'));
  RadioButton11.enabled:=False;
  RadioButton11.Checked:=False;
  Memo1.Lines.Append('发送:g');
  RadioButton11.enabled:=true;
end;

procedure TForm1.RadioButton12Click(Sender: TObject);
begin
  sendstr(ord('h'));
  RadioButton12.enabled:=False;
  RadioButton12.Checked:=False;
  Memo1.Lines.Append('发送:h');
  RadioButton12.enabled:=true;
end;

procedure TForm1.GroupBox3Click(Sender: TObject);
begin
  if checkbox8.Checked=False
     then  port:=port and (not(1 shl 0))
  else  port:=port or (1 shl 0);
  if checkbox7.Checked=False
     then  port:=port and (not(1 shl 1))
  else  port:=port or (1 shl 1);
  if checkbox6.Checked=False
     then  port:=port and (not(1 shl 2))
  else  port:=port or (1 shl 2);
  if checkbox5.Checked=False
     then  port:=port and (not(1 shl 3))
  else  port:=port or (1 shl 3);
  if checkbox4.Checked=False
     then  port:=port and (not(1 shl 4))
  else  port:=port or (1 shl 4);
  if checkbox3.Checked=False
     then  port:=port and (not(1 shl 5))
  else  port:=port or (1 shl 5);
  if checkbox2.Checked=False
     then  port:=port and (not(1 shl 6))
  else  port:=port or (1 shl 6);
  if checkbox1.Checked=False
     then  port:=port and (not(1 shl 7))
  else  port:=port or (1 shl 7);
  sendstr(port);
  Memo1.Lines.Append('发送:'+inttohex(port,2));
  lcd991.Value:=inttohex(port,2);
  //lcd991.Update;
end;

procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  str:string;
  i:integer;
begin
    move(buffer^,pchar(@rbuf)^,bufferlength);
    for i:=1 to bufferlength do
        str:=str+inttohex(rbuf[i],2)+' ';
    if(rbuf[1]=0) then str:='00';
    Memo1.Lines.Append('接收:'+str);
    portout:=ord(rbuf[1]);
    postmessage(form1.Handle,$2000,0,0);
end;

procedure tform1.msg_port(var msg:tmessage);
var
   i:byte;
begin
   for i:=0 to 7 do
   begin
     if (portout and (1 shl i))=(1 shl i) then
        timage(findcomponent('image'+inttostr(i+1))).Picture.LoadFromFile('ledon.bmp')
     else
        timage(findcomponent('image'+inttostr(i+1))).Picture.LoadFromFile('ledoff.bmp');
   end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.clear;
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
  if RadioGroup1.ItemIndex=0 then
    begin
      groupbox1.Enabled:=true;
      groupbox2.Enabled:=true;
      groupbox3.Enabled:=true;
      groupbox4.Enabled:=true;
    end
  else
    begin
      groupbox1.Enabled:=false;
      groupbox2.Enabled:=false;
      groupbox3.Enabled:=false;
      groupbox4.Enabled:=false;
    end;

end;

procedure TForm1.Panel2Click(Sender: TObject);
var
   i:byte;
begin
  for i:=1 to 8 do
    begin
      tcheckbox(findcomponent('checkbox'+inttostr(i))).OnClick:=GroupBox5Click;
      tcheckbox(findcomponent('checkbox'+inttostr(i))).checked:=false;
      tcheckbox(findcomponent('checkbox'+inttostr(i))).OnClick:=GroupBox3Click;
    end;
  sendstr(0);
  Memo1.Lines.Append('发送:'+inttohex(0,2));
  lcd991.Value:=inttohex(0,2);
end;

procedure TForm1.GroupBox5Click(Sender: TObject);
begin
  GroupBox5.Enabled:=true;
end;

end.