Delphi - 采用第三方控件TMS、SPComm开发串口调试助手

第三方控件TMS、SPComm的下载与安装

盒子上可搜索关键字进行下载，TMS是.dpk文件，SPComm.pas文件；

安装方法自行百度，不做赘述。

通过TMS控件进行界面布局

界面预览：

Delphi通过SPComm连接串口、发送和接收指令

连接串口

拖一个TComm控件到主窗体上，选中控件，单击F11，完成如下配置。

这里主要是将一些布尔类型的属性设置成False，其他属性在前台连接按钮事件下动态设置。

连接代码如下，这里需要特别主意一下：

当串口参数超过COM9（即COM10、COM11、COM12...）的时候，SPComm单元中有此BUG，ComName这里不可以直接赋值，需要做如下处理。

CommName := '//./' + cbbCOM.Text;

 1 procedure TMainFrm.advBtnConnectClick(Sender: TObject);
 2 var
 3   serialPortNO: string;
 4 begin
 5   try
 6     with comMain do
 7     begin
 8       StopComm;
 9       serialPortNO := Copy(cbbCOM.Text, 4, Length(cbbCOM.Text) - 3);
10       BaudRate := StrToInt(cbbBaudRate.Text);
11 //      ByteSize := TByteSize(cbbByteSize.ItemIndex);
12 //      StopBits := TStopBits(cbbStopBit.ItemIndex);
13 //      Parity := TParity(cbbCheckBit.ItemIndex);
14       if StrToInt(serialPortNO) > 9 then
15       begin
16         CommName := '//./' + cbbCOM.Text;
17       end
18       else
19       begin
20         CommName := cbbCOM.Text;
21       end;
22       comMain.StartComm;
23       connectStatus.Caption := 'Connected';
24       connectStatus.FillColor := clLime;
25       advBtnConnect.Enabled := False;
26       gbSendMsg.Enabled := True;
27     end;
28   except
29     connectStatus.Caption := 'Not Connected';
30     connectStatus.FillColor := clRed;
31     gbSendMsg.Enabled := False;
32   end;
33
34 end;

发送指令

WriteCommData();

 procedure TMainFrm.advBtnConfirmClick(Sender: TObject);
 begin
   if mmSendMsg.Lines.Count <=  then
   begin
     Application.MessageBox('There is no key word, please check the MsgSendList,thanks.', 'Error Information', MB_OK + MB_ICONSTOP);
     mmSendMsg.SetFocus;
     Exit;
   end;
   if cbByte.Checked then
   begin
     SendHex(mmSendMsg.Text);
   end
   else
   begin
     comMain.WriteCommData(PChar(mmSendMsg.Text), Length(mmSendMsg.Text));
   end;
   if (cbAutoSend.Checked) and (edtTime.Text <> '') and (cbByte.Checked) then
   begin
     timerMain.Interval := StrToInt(edtTime.Text);
     timerMain.Enabled := True;
   end;
 end;

SendHex函数

 procedure TMainFrm.SendHex(S: string);
 var
   s2: string;
   buf1: array[..] of char;
   i: integer;
 begin
   s2 := '';
   for i :=  to length(s) do
   begin
     if ((copy(s, i, ) >= '') and (copy(s, i, ) <= '')) or ((copy(s, i, ) >= 'a') and (copy(s, i, ) <= 'f'))
       or ((copy(s, i, ) >= 'A') and (copy(s, i, ) <= 'F')) then
     begin
       s2 := s2 + copy(s, i, );
     end;
   end;
   for i :=  to (length(s2) div  - ) do
     buf1[i] := char(strtoint('$' + copy(s2, i *  + , )));
   comMain.WriteCommData(buf1, (length(s2) div ));
   mmMsg.Lines.Add('MsgSend[' + S + ']');
 end;

接收指令

选中控件，添加OnReceiveError事件，代码如下。

 procedure TMainFrm.comMainReceiveData(Sender: TObject; Buffer: Pointer;
   BufferLength: Word);
 var
   S: string;
   I, L: INTEGER;
   RBUF: array[..] of BYTE;
 begin
   Move(Buffer^, pchar(@rbuf)^, BufferLength);
   L := BufferLength;
   for I :=  to L -  do
   begin
     S := S + INTTOHEX(RBUF[I], );
   end;
   mmMsg.Lines.Add('MsgReceived[' + S + ']');
 end;

断开串口连接

comMain.StopComm；

附录

 unit uMain;

 interface

 uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, ExtCtrls, SPComm, RzPanel, AdvSmoothButton,
   AdvSmoothStatusIndicator, AdvGlassButton, RzButton, RzRadChk, RzStatus,
   RzPrgres;

 type
   TMainFrm = class(TForm)
     gbSerialParams: TRzGroupBox;
     gbMsg: TRzGroupBox;
     mmMsg: TMemo;
     gbPortSet: TRzGroupBox;
     gbSendMsg: TRzGroupBox;
     lbCom: TLabel;
     lbStopBit: TLabel;
     lbByteSize: TLabel;
     lbCheckBit: TLabel;
     lbBaudRate: TLabel;
     comMain: TComm;
     cbbCOM: TComboBox;
     cbbStopBit: TComboBox;
     cbbByteSize: TComboBox;
     cbbBaudRate: TComboBox;
     cbbCheckBit: TComboBox;
     gbMsgSendParams: TRzGroupBox;
     gbMsgSendList: TRzGroupBox;
     cbByte: TRzCheckBox;
     cbAutoSend: TRzCheckBox;
     lbCT: TLabel;
     edtTime: TEdit;
     advBtnConfirm: TAdvGlassButton;
     advBtnConnect: TAdvGlassButton;
     AdvGlassButton1: TAdvGlassButton;
     lbMs: TLabel;
     mmSendMsg: TMemo;
     statusBar: TRzStatusBar;
     clock: TRzClockStatus;
     versionStatus: TRzVersionInfoStatus;
     mqStatus: TRzMarqueeStatus;
     progressBar: TRzProgressBar;
     connectStatus: TRzStatusPane;
     timerMain: TTimer;
     procedure advBtnConnectClick(Sender: TObject);
     procedure comMainReceiveData(Sender: TObject; Buffer: Pointer;
       BufferLength: Word);
     procedure advBtnConfirmClick(Sender: TObject);
     procedure SendHex(S: string);
     procedure AdvGlassButton1Click(Sender: TObject);
     procedure timerMainTimer(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

 var
   MainFrm: TMainFrm;

 implementation

 {$R *.dfm}

 procedure TMainFrm.SendHex(S: string);
 var
   s2: string;
   buf1: array[..] of char;
   i: integer;
 begin
   s2 := '';
   for i :=  to length(s) do
   begin
     if ((copy(s, i, ) >= '') and (copy(s, i, ) <= '')) or ((copy(s, i, ) >= 'a') and (copy(s, i, ) <= 'f'))
       or ((copy(s, i, ) >= 'A') and (copy(s, i, ) <= 'F')) then
     begin
       s2 := s2 + copy(s, i, );
     end;
   end;
   for i :=  to (length(s2) div  - ) do
     buf1[i] := char(strtoint('$' + copy(s2, i *  + , )));
   comMain.WriteCommData(buf1, (length(s2) div ));
   mmMsg.Lines.Add('MsgSend[' + S + ']');
 end;

 procedure TMainFrm.advBtnConnectClick(Sender: TObject);
 var
   serialPortNO: string;
 begin
   try
     with comMain do
     begin
       StopComm;
       serialPortNO := Copy(cbbCOM.Text, , Length(cbbCOM.Text) - );
       BaudRate := StrToInt(cbbBaudRate.Text);
 //      ByteSize := TByteSize(cbbByteSize.ItemIndex);
 //      StopBits := TStopBits(cbbStopBit.ItemIndex);
 //      Parity := TParity(cbbCheckBit.ItemIndex);
       if StrToInt(serialPortNO) >  then
       begin
         CommName := '//./' + cbbCOM.Text;
       end
       else
       begin
         CommName := cbbCOM.Text;
       end;
       comMain.StartComm;
       connectStatus.Caption := 'Connected';
       connectStatus.FillColor := clLime;
       advBtnConnect.Enabled := False;
       gbSendMsg.Enabled := True;
     end;
   except
     connectStatus.Caption := 'Not Connected';
     connectStatus.FillColor := clRed;
     gbSendMsg.Enabled := False;
   end;

 end;

 procedure TMainFrm.comMainReceiveData(Sender: TObject; Buffer: Pointer;
   BufferLength: Word);
 var
   S: string;
   I, L: INTEGER;
   RBUF: array[..] of BYTE;
 begin
   Move(Buffer^, pchar(@rbuf)^, BufferLength);
   L := BufferLength;
   for I :=  to L -  do
   begin
     S := S + INTTOHEX(RBUF[I], );
   end;
   mmMsg.Lines.Add('MsgReceived[' + S + ']');
 end;
 //var
 //    tmpArray: array[0..4096] of Byte;
 //    i: DWORD;
 //    tmpStr: string;
 //    pStr: PChar;
 //begin
 //    pStr := Buffer;
 //    tmpStr := string(pStr);
 //    mmMsg.Lines.Add(tmpStr);
 //    Dec(PStr);
 //    for i := 0 to Length(tmpStr) - 1 do
 //    begin
 //        inc(PStr);
 //        tmpArray[i] := Byte(PSTR^);
 //        mmMsg.Lines.Add(IntToHEX(Ord(tmpArray[i]), 2));
 //    end;
 //    exit;
 //    pStr := Buffer;
 //    mmMsg.Lines.Add(pStr);
 //end;

 procedure TMainFrm.advBtnConfirmClick(Sender: TObject);
 begin
   if mmSendMsg.Lines.Count <=  then
   begin
     Application.MessageBox('There is no key word, please check the MsgSendList,thanks.', 'Error Information', MB_OK + MB_ICONSTOP);
     mmSendMsg.SetFocus;
     Exit;
   end;
   if cbByte.Checked then
   begin
     SendHex(mmSendMsg.Text);
   end
   else
   begin
     comMain.WriteCommData(PChar(mmSendMsg.Text), Length(mmSendMsg.Text));
   end;
   if (cbAutoSend.Checked) and (edtTime.Text <> '') and (cbByte.Checked) then
   begin
     timerMain.Interval := StrToInt(edtTime.Text);
     timerMain.Enabled := True;
   end;
 end;

 procedure TMainFrm.AdvGlassButton1Click(Sender: TObject);
 begin
   timerMain.Enabled := False;
   gbSendMsg.Enabled := False;
   cbByte.Checked := False;
   cbAutoSend.Checked := False;
   edtTime.Text := '';
   mmMsg.Text := '';
   mmSendMsg.Text := '';
   comMain.StopComm;
   connectStatus.Caption := 'Not Connected';
   connectStatus.FillColor := clRed;
   advBtnConnect.Enabled := True;
 end;

 procedure TMainFrm.timerMainTimer(Sender: TObject);
 begin
   SendHex(mmSendMsg.Text);
 end;

 end.

作者：Jeremy.Wu
  出处：https://www.cnblogs.com/jeremywucnblog/

  本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。