Download and Installation of Third Party Control TMS and SPComm

The box can be downloaded with search keywords. The TMS is a. dpk file and the SPComm.pas file.

Installation method itself, not to repeat.

Interface Layout by Using TMS Controls

Interface Preview:

Delphi connects serial port, sends and receives instructions through SPComm

Connect serial port

Drag a TComm control onto the main form, select the control, and click F11 to complete the following configuration.

Here, some Boolean attributes are set to False, while others are set dynamically under the event of the front-end connection button.  

The connection code is as follows. Here's a special idea.

When the serial port parameters exceed COM9 (i.e. COM10, COM11, COM12...), there is BUG in SPComm unit. ComName can not be directly assigned here. The following processing is needed.

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;

Send instruction

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 function

 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;

Receive instruction

Select the control and add the OnReceiveError event. The code is as follows.

 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;

Disconnect Serial Port Connection

comMain.StopComm；

appendix

  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.