第三方控件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.
请发表评论