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

杨潇潇 發表於 2019-9-3 13:14:00

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

第三方控件TMS、SPComm的下载与安装
盒子上可搜索关键字进行下载，TMS是.dpk文件，SPComm.pas文件；
安装方法自行百度，不做赘述。
 
通过TMS控件进行界面布局
界面预览：
<img src="https://img2018.cnblogs.com/blog/1335881/201909/1335881-20190903123852323-273980033.png" alt="">
 
Delphi通过SPComm连接串口、发送和接收指令
连接串口
拖一个TComm控件到主窗体上，选中控件，单击F11，完成如下配置。
这里主要是将一些布尔类型的属性设置成False，其他属性在前台连接按钮事件下动态设置。 
<img src="https://img2018.cnblogs.com/blog/1335881/201909/1335881-20190903124830443-1170630039.png" alt="">
<img src="https://img2018.cnblogs.com/blog/1335881/201909/1335881-20190903124750664-1338228738.png" alt="">
连接代码如下，这里需要特别主意一下：
当串口参数超过COM9（即COM10、COM11、COM12...）的时候，SPComm单元中有此BUG，ComName这里不可以直接赋值，需要做如下处理。
CommName := '//./' + cbbCOM.Text;  
<div class="cnblogs_code">
<pre> 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;</pre>
</div>
 
发送指令
WriteCommData(); 
<div class="cnblogs_code">
<pre> 1 procedure TMainFrm.advBtnConfirmClick(Sender: TObject);
 2 begin
 3 if mmSendMsg.Lines.Count <= 0 then
 4 begin
 5 Application.MessageBox('There is no key word, please check the MsgSendList,thanks.', 'Error Information', MB_OK + MB_ICONSTOP);
 6 mmSendMsg.SetFocus;
 7 Exit;
 8 end;
 9 if cbByte.Checked then
10 begin
11 SendHex(mmSendMsg.Text);
12 end
13 else
14 begin
15 comMain.WriteCommData(PChar(mmSendMsg.Text), Length(mmSendMsg.Text));
16 end;
17 if (cbAutoSend.Checked) and (edtTime.Text <> '') and (cbByte.Checked) then
18 begin
19 timerMain.Interval := StrToInt(edtTime.Text);
20 timerMain.Enabled := True;
21 end;
22 end;</pre>
</div>
SendHex函数 
<div class="cnblogs_code">
<pre> 1 procedure TMainFrm.SendHex(S: string);
 2 var
 3 s2: string;
 4 buf1: array[0..50000] of char;
 5 i: integer;
 6 begin
 7 s2 := '';
 8 for i := 1 to length(s) do
 9 begin
10 if ((copy(s, i, 1) >= '0') and (copy(s, i, 1) <= '9')) or ((copy(s, i, 1) >= 'a') and (copy(s, i, 1) <= 'f'))
11 or ((copy(s, i, 1) >= 'A') and (copy(s, i, 1) <= 'F')) then
12 begin
13 s2 := s2 + copy(s, i, 1);
14 end;
15 end;
16 for i := 0 to (length(s2) div 2 - 1) do
17 buf1 := char(strtoint('$' + copy(s2, i * 2 + 1, 2)));
18 comMain.WriteCommData(buf1, (length(s2) div 2));
19 mmMsg.Lines.Add('MsgSend[' + S + ']');
20 end;</pre>
</div>
接收指令
选中控件，添加OnReceiveError事件，代码如下。
<img src="https://img2018.cnblogs.com/blog/1335881/201909/1335881-20190903130932292-958400172.png" alt="">
<div class="cnblogs_code">
<pre> 1 procedure TMainFrm.comMainReceiveData(Sender: TObject; Buffer: Pointer;
 2 BufferLength: Word);
 3 var
 4 S: string;
 5 I, L: INTEGER;
 6 RBUF: array[0..2048] of BYTE;
 7 begin
 8 Move(Buffer^, pchar(@rbuf)^, BufferLength);
 9 L := BufferLength;
10 for I := 0 to L - 1 do
11 begin
12 S := S + INTTOHEX(RBUF, 2);
13 end;
14 mmMsg.Lines.Add('MsgReceived[' + S + ']');
15 end;</pre>
</div>
断开串口连接
comMain.StopComm；
附录
<div class="cnblogs_code">
<pre>1 unit uMain;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls, ExtCtrls, SPComm, RzPanel, AdvSmoothButton,
8 AdvSmoothStatusIndicator, AdvGlassButton, RzButton, RzRadChk, RzStatus,
9 RzPrgres;
 10
 11 type
 12 TMainFrm = class(TForm)
 13 gbSerialParams: TRzGroupBox;
 14 gbMsg: TRzGroupBox;
 15 mmMsg: TMemo;
 16 gbPortSet: TRzGroupBox;
 17 gbSendMsg: TRzGroupBox;
 18 lbCom: TLabel;
 19 lbStopBit: TLabel;
 20 lbByteSize: TLabel;
 21 lbCheckBit: TLabel;
 22 lbBaudRate: TLabel;
 23 comMain: TComm;
 24 cbbCOM: TComboBox;
 25 cbbStopBit: TComboBox;
 26 cbbByteSize: TComboBox;
 27 cbbBaudRate: TComboBox;
 28 cbbCheckBit: TComboBox;
 29 gbMsgSendParams: TRzGroupBox;
 30 gbMsgSendList: TRzGroupBox;
 31 cbByte: TRzCheckBox;
 32 cbAutoSend: TRzCheckBox;
 33 lbCT: TLabel;
 34 edtTime: TEdit;
 35 advBtnConfirm: TAdvGlassButton;
 36 advBtnConnect: TAdvGlassButton;
 37 AdvGlassButton1: TAdvGlassButton;
 38 lbMs: TLabel;
 39 mmSendMsg: TMemo;
 40 statusBar: TRzStatusBar;
 41 clock: TRzClockStatus;
 42 versionStatus: TRzVersionInfoStatus;
 43 mqStatus: TRzMarqueeStatus;
 44 progressBar: TRzProgressBar;
 45 connectStatus: TRzStatusPane;
 46 timerMain: TTimer;
 47 procedure advBtnConnectClick(Sender: TObject);
 48 procedure comMainReceiveData(Sender: TObject; Buffer: Pointer;
 49 BufferLength: Word);
 50 procedure advBtnConfirmClick(Sender: TObject);
 51 procedure SendHex(S: string);
 52 procedure AdvGlassButton1Click(Sender: TObject);
 53 procedure timerMainTimer(Sender: TObject);
 54 private
 55 { Private declarations }
 56 public
 57 { Public declarations }
 58 end;
 59
 60 var
 61 MainFrm: TMainFrm;
 62
 63 implementation
 64
 65 {$R *.dfm}
 66
 67 procedure TMainFrm.SendHex(S: string);
 68 var
 69 s2: string;
 70 buf1: array[0..50000] of char;
 71 i: integer;
 72 begin
 73 s2 := '';
 74 for i := 1 to length(s) do
 75 begin
 76 if ((copy(s, i, 1) >= '0') and (copy(s, i, 1) <= '9')) or ((copy(s, i, 1) >= 'a') and (copy(s, i, 1) <= 'f'))
 77 or ((copy(s, i, 1) >= 'A') and (copy(s, i, 1) <= 'F')) then
 78 begin
 79 s2 := s2 + copy(s, i, 1);
 80 end;
 81 end;
 82 for i := 0 to (length(s2) div 2 - 1) do
 83 buf1 := char(strtoint('$' + copy(s2, i * 2 + 1, 2)));
 84 comMain.WriteCommData(buf1, (length(s2) div 2));
 85 mmMsg.Lines.Add('MsgSend[' + S + ']');
 86 end;
 87
 88
 89 procedure TMainFrm.advBtnConnectClick(Sender: TObject);
 90 var
 91 serialPortNO: string;
 92 begin
 93 try
 94 with comMain do
 95 begin
 96 StopComm;
 97 serialPortNO := Copy(cbbCOM.Text, 4, Length(cbbCOM.Text) - 3);
 98 BaudRate := StrToInt(cbbBaudRate.Text);
 99 // ByteSize := TByteSize(cbbByteSize.ItemIndex);
100 // StopBits := TStopBits(cbbStopBit.ItemIndex);
101 // Parity := TParity(cbbCheckBit.ItemIndex);
102 if StrToInt(serialPortNO) > 9 then
103 begin
104 CommName := '//./' + cbbCOM.Text;
105 end
106 else
107 begin
108 CommName := cbbCOM.Text;
109 end;
110 comMain.StartComm;
111 connectStatus.Caption := 'Connected';
112 connectStatus.FillColor := clLime;
113 advBtnConnect.Enabled := False;
114 gbSendMsg.Enabled := True;
115 end;
116 except
117 connectStatus.Caption := 'Not Connected';
118 connectStatus.FillColor := clRed;
119 gbSendMsg.Enabled := False;
120 end;
121
122 end;
123
124 procedure TMainFrm.comMainReceiveData(Sender: TObject; Buffer: Pointer;
125 BufferLength: Word);
126 var
127 S: string;
128 I, L: INTEGER;
129 RBUF: array[0..2048] of BYTE;
130 begin
131 Move(Buffer^, pchar(@rbuf)^, BufferLength);
132 L := BufferLength;
133 for I := 0 to L - 1 do
134 begin
135 S := S + INTTOHEX(RBUF, 2);
136 end;
137 mmMsg.Lines.Add('MsgReceived[' + S + ']');
138 end;
139 //var
140 // tmpArray: array of Byte;
141 // i: DWORD;
142 // tmpStr: string;
143 // pStr: PChar;
144 //begin
145 // pStr := Buffer;
146 // tmpStr := string(pStr);
147 // mmMsg.Lines.Add(tmpStr);
148 // Dec(PStr);
149 // for i := 0 to Length(tmpStr) - 1 do
150 // begin
151 // inc(PStr);
152 // tmpArray := Byte(PSTR^);
153 // mmMsg.Lines.Add(IntToHEX(Ord(tmpArray), 2));
154 // end;
155 // exit;
156 // pStr := Buffer;
157 // mmMsg.Lines.Add(pStr);
158 //end;
159
160 procedure TMainFrm.advBtnConfirmClick(Sender: TObject);
161 begin
162 if mmSendMsg.Lines.Count <= 0 then
163 begin
164 Application.MessageBox('There is no key word, please check the MsgSendList,thanks.', 'Error Information', MB_OK + MB_ICONSTOP);
165 mmSendMsg.SetFocus;
166 Exit;
167 end;
168 if cbByte.Checked then
169 begin
170 SendHex(mmSendMsg.Text);
171 end
172 else
173 begin
174 comMain.WriteCommData(PChar(mmSendMsg.Text), Length(mmSendMsg.Text));
175 end;
176 if (cbAutoSend.Checked) and (edtTime.Text <> '') and (cbByte.Checked) then
177 begin
178 timerMain.Interval := StrToInt(edtTime.Text);
179 timerMain.Enabled := True;
180 end;
181 end;
182
183 procedure TMainFrm.AdvGlassButton1Click(Sender: TObject);
184 begin
185 timerMain.Enabled := False;
186 gbSendMsg.Enabled := False;
187 cbByte.Checked := False;
188 cbAutoSend.Checked := False;
189 edtTime.Text := '';
190 mmMsg.Text := '';
191 mmSendMsg.Text := '';
192 comMain.StopComm;
193 connectStatus.Caption := 'Not Connected';
194 connectStatus.FillColor := clRed;
195 advBtnConnect.Enabled := True;
196 end;
197
198 procedure TMainFrm.timerMainTimer(Sender: TObject);
199 begin
200 SendHex(mmSendMsg.Text);
201 end;
202
203 end.</pre>
</div>
 
<div id="AllanboltSignature">
<p id="PSignature" style="padding: 10px 10px 10px 60px; background: url("https://images.cnblogs.com/cnblogs_com/jeremywucnblog/1607637/o_191206011825obs.png") 1% no-repeat rgba(229, 241, 244, 1); font-family: 微软雅黑; font-size: 11px; border: 1px dashed rgba(224, 224, 224, 1)">  作者：Jeremy.Wu   出处：https://www.cnblogs.com/jeremywucnblog/
   本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。
 

</div> 
来源：https://www.cnblogs.com/jeremywucnblog/p/11452396.html

頁: [1]

琼殿技术论坛's Archiver

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