第三方控件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();
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;
SendHex函数
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[i] := char(strtoint('$' + copy(s2, i * 2 + 1, 2)));
18 comMain.WriteCommData(buf1, (length(s2) div 2));
19 mmMsg.Lines.Add('MsgSend[' + S + ']');
20 end;
接收指令
选中控件，添加OnReceiveError事件，代码如下。
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[I], 2);
13 end;
14 mmMsg.Lines.Add('MsgReceived[' + S + ']');
15 end;
断开串口连接
comMain.StopComm；
附录
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[i] := 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[I], 2);
136 end;
137 mmMsg.Lines.Add('MsgReceived[' + S + ']');
138 end;
139 //var
140 // tmpArray: array[0..4096] 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[i] := Byte(PSTR^);
153 // mmMsg.Lines.Add(IntToHEX(Ord(tmpArray[i]), 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.