main.~pas

Delphi编写的串口测试程序

unit main;

interface

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

type
  TForm1 = class(TForm)
    Comm1: TComm;
    GroupBox1: TGroupBox;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    ComboBox2: TComboBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    ComboBox5: TComboBox;
    ComboBox6: TComboBox;
    BitBtn1: TBitBtn;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Memo1: TMemo;
    BitBtn2: TBitBtn;
    Label7: TLabel;
    Memo2: TMemo;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    XPMenu1: TXPMenu;
    Timer1: TTimer;
    GroupBox4: TGroupBox;
    RadioButton2: TRadioButton;
    Label15: TLabel;
    RadioButton1: TRadioButton;
    Label13: TLabel;
    Edit1: TEdit;
    Label14: TLabel;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Image1: TImage;
    Image2: TImage;
    Label16: TLabel;
    Label17: TLabel;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  numsend,numrec:integer;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  Try
  Comm1.StopComm;
  Comm1.CommName:=Trim(Combobox1.Text);
  Comm1.BaudRate:=strtoint(Trim(Combobox2.Text));
  Comm1.ByteSize:=TByteSize(strtoint(Trim(Combobox3.Text)));
  if Combobox4.ItemIndex<>1 then
     Comm1.StopBits:=TStopBits(strtoint(Trim(Combobox4.Text)))
  else
     Comm1.StopBits:=TStopBits(_1_5);
  case Combobox5.ItemIndex of
  0: Comm1.Parity:=Odd;
  1: Comm1.Parity:=Even;
  2: Comm1.Parity:=None;
  3: Comm1.Parity:=Mark;
  4: Comm1.Parity:=Space;
  end;
   case Combobox6.ItemIndex of
  0: Comm1.RtsControl:=RtsTransmissionAvailable;
  1: Comm1.RtsControl:=RtsHandshake;
  2: Comm1.RtsControl:=RtsDisable;
  end;
  Comm1.StartComm;
  Except
  messagedlg('无效的串口设置！请重新设置！',mtinformation,[mbok],0);
  End;
  GroupBox4.Enabled:=true;
  RadioButton2.Checked:=true;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);

begin
  if Comm1.WriteCommData(pchar(Memo1.Lines[Memo1.Lines.Count-1]),length(pchar(Memo1.Lines[Memo1.Lines.Count-1]))) then
  begin
    numsend:=numsend+length(pchar(Memo1.Lines[Memo1.Lines.Count-1]));
    Label9.Caption:=inttostr(numsend);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Label9.Caption:='0';
  Label10.Caption:='0';
  Label12.Caption:='0%';
  numsend:=0;
  numrec:=0;
end;

procedure TForm1.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var str: string;
begin
  setlength(str,BufferLength);
  Move(Buffer^,pchar(str)^,bufferlength);
  numrec:=numrec+bufferlength;
  Memo2.Lines.Append(pchar(str));
  Label10.Caption:=inttostr(numrec);
  Label12.Caption:=floattostr(numrec div numsend *100)+'%';
  if (numrec div numsend *100)>80 then
    begin
      Label12.Font.Color:=clGreen;
      Image1.Visible:=true;
      Image2.Visible:=false;
    end
  else
    begin
      Label12.Font.Color:=clRed;
      Image1.Visible:=false;
      Image2.Visible:=true;
    end;
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
begin
  BitBtn2.Enabled:=RadioButton2.Checked;
  Memo1.ReadOnly:=not RadioButton2.Checked;
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  Edit1.Enabled:=RadioButton1.Checked;
  BitBtn3.Enabled:=RadioButton1.Checked;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  Try
  Strtoint(Trim(Edit1.Text));
  Except
  messagedlg('输入的时间间隔不是一个有效的整数！',mtError,[mbOk],0);
  Edit1.SetFocus;
  End;
  Timer1.Enabled:=False;
  Timer1.Interval:=Strtoint(Trim(Edit1.Text));
  Timer1.Enabled:=True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i:integer;
    str:String;
begin
  str:='';
  for i:=1 to 10 do
  begin
    str:=str+inttostr(Random(1000))+' ';
  end;
  Memo1.Lines.Append(str);
  if Comm1.WriteCommData(pchar(Memo1.Lines[Memo1.Lines.Count-1]),length(pchar(Memo1.Lines[Memo1.Lines.Count-1]))) then
  begin
    numsend:=numsend+length(pchar(Memo1.Lines[Memo1.Lines.Count-1]));
    Label9.Caption:=inttostr(numsend);
  end;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
  Timer1.Enabled:=false;
  Label12.Caption:=floattostr(numrec div numsend *100)+'%';
  if (numrec div numsend *100)>80 then
    begin
      Label12.Font.Color:=clGreen;
      Image1.Visible:=true;
      Image2.Visible:=false;
    end
  else
    begin
      Label12.Font.Color:=clRed;
      Image1.Visible:=false;
      Image2.Visible:=true;
    end;
end;

end.