mainfrm.pas

Delphi采用MSComm控件开发串口测试工具,在Windows+Delphi7编译通过

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, OleCtrls, MSCommLib_TLB;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    SetCom1: TBitBtn;
    SetCom2: TBitBtn;
    SetCom3: TBitBtn;
    SetCom4: TBitBtn;
    Panel2: TPanel;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Shape4: TShape;
    Command: TEdit;
    MSComm1: TMSComm;
    MSComm2: TMSComm;
    MSComm3: TMSComm;
    MSComm4: TMSComm;
    Memo1: TMemo;
    Label3: TLabel;
    Send: TBitBtn;
    Label4: TLabel;
    Clear: TBitBtn;
    GroupBox2: TGroupBox;
    Label5: TLabel;
    Label6: TLabel;
    SendCount: TEdit;
    ReceiveCount: TEdit;
    ClearCount: TBitBtn;
    Panel3: TPanel;
    SelectCom1: TRadioButton;
    SelectCom2: TRadioButton;
    SelectCom3: TRadioButton;
    SelectCom4: TRadioButton;
    Update: TBitBtn;
    procedure SetCom1Click(Sender: TObject);
    procedure SetCom2Click(Sender: TObject);
    procedure SetCom3Click(Sender: TObject);
    procedure SetCom4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ClearClick(Sender: TObject);
    procedure ClearCountClick(Sender: TObject);
    procedure UpdateClick(Sender: TObject);
    procedure MSComm1Comm(Sender: TObject);
    procedure MSComm2Comm(Sender: TObject);
    procedure MSComm3Comm(Sender: TObject);
    procedure MSComm4Comm(Sender: TObject);
    procedure SendClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure ShowInf(Infor : String);
  end;

var
  Form1: TForm1;
  Com1On,Com2On,Com3On,Com4On : Boolean;
  Count1 : Integer;
  Count2 : Integer;

implementation
uses Comport1,Comport2,Comport3,Comport4,ReadWriteCom;

{$R *.dfm}
//------------------------------------------------------------------------------
procedure TForm1.SetCom1Click(Sender: TObject);
begin
     if not Com1On then
     begin
        COM1Dlg.Show;
     end
     else
     begin
        MSComm1.PortOpen := false;
        Com1On := false;
        SetCom1.Caption := 'Com1';
        Shape1.Brush.Color := clRed;
     end;
end;
//------------------------------------------------------------------------------
procedure TForm1.SetCom2Click(Sender: TObject);
begin
   if not Com2On then
   begin
      COM2Dlg.Show;
   end
   else
   begin
      MSComm2.PortOpen := false;
      Com2On := false;
      SetCom2.Caption := 'Com2';
      Shape2.Brush.Color := clRed;
   end;
end;
//------------------------------------------------------------------------------
procedure TForm1.SetCom3Click(Sender: TObject);
begin
   if not Com3On then
   begin
      COM3Dlg.Show;
   end
   else
   begin
      MSComm3.PortOpen := false;
      Com3On := false;
      SetCom3.Caption := 'Com3';
      Shape3.Brush.Color := clRed;
   end;
end;
//------------------------------------------------------------------------------
procedure TForm1.SetCom4Click(Sender: TObject);
begin
   if not Com4On then
   begin
      COM4Dlg.Show;
   end
   else
   begin
      MSComm4.PortOpen := false;
      Com4On := false;
      SetCom4.Caption := 'Com4';
      Shape4.Brush.Color := clRed;
   end;
end;
//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
    Shape1.Brush.Color := clRed;
    Shape2.Brush.Color := clRed;
    Shape3.Brush.Color := clRed;
    Shape4.Brush.Color := clRed;
end;
//------------------------------------------------------------------------------
procedure TForm1.ClearClick(Sender: TObject);
begin
     Memo1.Clear;
end;
//------------------------------------------------------------------------------
procedure TForm1.ClearCountClick(Sender: TObject);
begin
     SendCount.Text := '0';
     ReceiveCount.Text := '0';
end;
//------------------------------------------------------------------------------

procedure TForm1.UpdateClick(Sender: TObject);
begin
    SelectCom1.Checked := false;
    SelectCom2.Checked := false;
    SelectCom3.Checked := false;
    SelectCom4.Checked := false;
end;
//------------------------------------------------------------------------------

procedure TForm1.MSComm1Comm(Sender: TObject);
var
   RcvString : OleVariant;
begin
   if MSComm1.CommEvent = comEvReceive then
   begin
      if MSComm1.InBufferCount<>0 then
      begin
         RcvString := MSComm1.Input;
         ShowInf(RcvString);
         Count2 := StrToInt(ReceiveCount.Text);
         Inc(Count2);
      end;
   end;
end;
//------------------------------------------------------------------------------

procedure TForm1.MSComm2Comm(Sender: TObject);
var
   RcvString : OleVariant;
begin
   if MSComm2.CommEvent = comEvReceive then
   begin
      if MSComm2.InBufferCount<>0 then
      begin
         RcvString := MSComm2.Input;
         ShowInf(RcvString);
         Count2 := StrToInt(ReceiveCount.Text);
         Inc(Count2);
      end;
   end;
end;
//------------------------------------------------------------------------------

procedure TForm1.MSComm3Comm(Sender: TObject);
var
   RcvString : OleVariant;
begin
   if MSComm3.CommEvent = comEvReceive then
   begin
      if MSComm3.InBufferCount<>0 then
      begin
         RcvString := MSComm3.Input;
         ShowInf(RcvString);
         Count2 := StrToInt(ReceiveCount.Text);
         Inc(Count2);
      end;
   end;
end;
//------------------------------------------------------------------------------

procedure TForm1.MSComm4Comm(Sender: TObject);
var
   RcvString : OleVariant;
begin
   if MSComm4.CommEvent = comEvReceive then
   begin
      if MSComm4.InBufferCount<>0 then
      begin
         RcvString := MSComm4.Input;
         ShowInf(RcvString);
         Count2 := StrToInt(ReceiveCount.Text);
         Inc(Count2);
      end;
   end;
end;
//------------------------------------------------------------------------------
procedure TForm1.ShowInf(Infor : String);
begin
     Memo1.Lines.Add(Infor);
     Memo1.Lines.Add('---------------------------------------------------------------');
end;
//------------------------------------------------------------------------------


procedure TForm1.SendClick(Sender: TObject);
begin
     if not (SelectCom1.Checked or SelectCom2.Checked or SelectCom3.Checked or SelectCom4.Checked) then
     begin
        ShowMessage('Please Select Coms To Send Command');
        exit;
     end;
     if command.Text = '' then
     begin
        ShowMessage('The Command Table is NULL');
        exit;
     end;
     if SelectCom1.Checked then
     begin
        if Com1On then
        begin
        ReadWriteCom.SendToCom1(command.Text);
        Inc(Count1);
        SendCount.Text := IntToStr(Count1);
        end
        else
        ShowMessage('Com1 is not Open');
     end
     else
     if SelectCom2.Checked then
     begin
        if Com2On then
        begin
        ReadWriteCom.SendToCom2(command.Text);
        Inc(Count1);
        SendCount.Text := IntToStr(Count1);
        end
        else
        ShowMessage('Com2 is not Open');
     end
     else if SelectCom3.Checked then
     begin
        if Com3On then
        begin
        ReadWriteCom.SendToCom3(command.Text);
        Inc(Count1);
        SendCount.Text := IntToStr(Count1);
        end
        else
        ShowMessage('Com3 is not Open');
     end
     else if SelectCom4.Checked then
     begin
        if Com4On then
        begin
        ReadWriteCom.SendToCom4(command.Text);
        Inc(Count1);
        SendCount.Text := IntToStr(Count1);
        end
        else
        ShowMessage('Com4 is not Open');
     end;
end;
//------------------------------------------------------------------------------

end.