第三方控件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(); 

procedure TMainFrm.advBtnConfirmClick(Sender: TObject);
begin
  if mmSendMsg.Lines.Count <= 0 then
  begin
    Application.MessageBox('There is no key word, please check the MsgSendList,thanks.', 'Error Information', MB_OK + MB_ICONSTOP);
    mmSendMsg.SetFocus;
    Exit;
  end;
  if cbByte.Checked then
  begin
    SendHex(mmSendMsg.Text);
  end
  else
  begin
    comMain.WriteCommData(PChar(mmSendMsg.Text), Length(mmSendMsg.Text));
  end;
  if (cbAutoSend.Checked) and (edtTime.Text <> '') and (cbByte.Checked) then
  begin
    timerMain.Interval := StrToInt(edtTime.Text);
    timerMain.Enabled := True;
  end;
end;

SendHex函数 

procedure TMainFrm.SendHex(S: string);
var
  s2: string;
  buf1: array[0..50000] of char;
  i: integer;
begin
  s2 := '';
  for i := 1 to length(s) do
  begin
    if ((copy(s, i, 1) >= '0') and (copy(s, i, 1) <= '9')) or ((copy(s, i, 1) >= 'a') and (copy(s, i, 1) <= 'f'))
      or ((copy(s, i, 1) >= 'A') and (copy(s, i, 1) <= 'F')) then
    begin
      s2 := s2 + copy(s, i, 1);
    end;
  end;
  for i := 0 to (length(s2) div 2 - 1) do
    buf1[i] := char(strtoint('$' + copy(s2, i * 2 + 1, 2)));
  comMain.WriteCommData(buf1, (length(s2) div 2));
  mmMsg.Lines.Add('MsgSend[' + S + ']');
end;

接收指令

选中控件，添加OnReceiveError事件，代码如下。

procedure TMainFrm.comMainReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  S: string;
  I, L: INTEGER;
  RBUF: array[0..2048] of BYTE;
begin
  Move(Buffer^, pchar(@rbuf)^, BufferLength);
  L := BufferLength;
  for I := 0 to L - 1 do
  begin
    S := S + INTTOHEX(RBUF[I], 2);
  end;
  mmMsg.Lines.Add('MsgReceived[' + S + ']');
end;

断开串口连接

comMain.StopComm；

附录

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, SPComm, RzPanel, AdvSmoothButton,
  AdvSmoothStatusIndicator, AdvGlassButton, RzButton, RzRadChk, RzStatus,
  RzPrgres;

type
  TMainFrm = class(TForm)