Delphi

 

 

第三方控件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.