co_main.~pas

很好用的串口通信工具软件。Comport目录下是用到的通信控件。

unit Co_Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Forms, CPort, StdCtrls,
  IniFiles, Syncobjs, ComCtrls, ImgList, Buttons, ToolWin, ExtCtrls,
  TriggerUtil,Dialogs;

const
  sVerInfo = '串口测试程序 Ver1.0';
  cmdBuffCapacity = 100;

type

  TFrm_Main = class(TForm)
    Panel1: TPanel;
    ToolBar1: TToolBar;
    btn_Open: TToolButton;
    btn_Close: TToolButton;
    btn_Clear: TToolButton;
    btn_Exit: TToolButton;
    TitleImageList: TImageList;
    btn_Trigger: TToolButton;
    ToolButton1: TToolButton;
    ToolButton3: TToolButton;
    sb: TStatusBar;
    Panel2: TPanel;
    Panel3: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Combo_Port: TComboBox;
    Combo_BaudRate: TComboBox;
    GroupBox1: TGroupBox;
    CB_RTS: TCheckBox;
    CB_DTR: TCheckBox;
    GroupBox2: TGroupBox;
    CB_CRLF: TCheckBox;
    CB_Hex: TCheckBox;
    Panel4: TPanel;
    Splitter1: TSplitter;
    Pc_Info: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    ComPort: TComPort;
    Panel5: TPanel;
    btn_Send: TSpeedButton;
    Panel6: TPanel;
    CB_CMD: TComboBox;
    btn_ClearCmd: TToolButton;
    Label3: TLabel;
    Mem_Hex: TMemo;
    Mem_Text: TMemo;
    Mem_Info: TMemo;
    Label4: TLabel;
    Cb_DataBits: TComboBox;
    Label5: TLabel;
    CB_StopBits: TComboBox;
    Label6: TLabel;
    Cb_ParityBits: TComboBox;
    tbAutoSend: TToolButton;
    TimerAutoSend: TTimer;
    tbByteSend: TToolButton;
    TimerByteSend: TTimer;
    procedure Combo_BaudRateChange(Sender: TObject);
    procedure Combo_PortChange(Sender: TObject);
    procedure CB_RTSClick(Sender: TObject);
    procedure CB_DTRClick(Sender: TObject);
    procedure Btn_ExitClick(Sender: TObject);
    procedure Btn_OpenClick(Sender: TObject);
    procedure Btn_CloseClick(Sender: TObject);
    procedure Btn_SendClick(Sender: TObject);
    procedure Btn_ClearClick(Sender: TObject);
    procedure ComPortTxEmpty(Sender: TObject);
    procedure ComPortRxChar(Sender: TObject; Count: Integer);
    procedure ComPortError(Sender: TObject; Errors: TComErrors);
    procedure ComPortDSRChange(Sender: TObject; OnOff: Boolean);
    procedure ComPortCTSChange(Sender: TObject; OnOff: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ComPortAfterOpen(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Panel1Resize(Sender: TObject);
    procedure btn_ClearCmdClick(Sender: TObject);
    procedure CB_CMDKeyPress(Sender: TObject; var Key: Char);
    procedure btn_TriggerClick(Sender: TObject);
    procedure Cb_DataBitsChange(Sender: TObject);
    procedure CB_StopBitsChange(Sender: TObject);
    procedure Cb_ParityBitsChange(Sender: TObject);
    procedure ComPortAfterClose(Sender: TObject);
    procedure tbAutoSendClick(Sender: TObject);
    procedure TimerAutoSendTimer(Sender: TObject);
    procedure tbByteSendClick(Sender: TObject);
    procedure TimerByteSendTimer(Sender: TObject);
  private
    { Private declarations }
    LineData: string;
    TriggerBuff: string;
    Inis: TIniFile;
    FTrigger: TTrigger;
    FTriggerFileName: string;
    con: Boolean;
    FAutoSend:Boolean;
    FAutoIntervel:Cardinal;
    procedure SetCommStatus;
    procedure LinkToTrigger(var buf: string);
  public
    { Public declarations }
  end;

var
  Frm_Main: TFrm_Main;

implementation


uses Trigger, dlgByteSend, UnitPublic;

{$R *.DFM}

function StrToDataBits(str: string): TDataBits;
begin
  str := Trim(Str);
  if str = '5' then Result := dbFive
  else if str = '6' then Result := dbSix
  else if str = '7' then Result := dbSeven
  else Result := dbEight;
end;

function DataBitsToStr(Bits: TDataBits): string;
begin
  case Bits of
    dbFive: Result := '5';
    dbSix: Result := '6';
    dbSeven: Result := '7';
    else Result := '8';
  end;
end;

function StrToStopBits(str: string): TStopBits;
begin
  str := Trim(Str);
  if Str = '1' then Result := sbOneStopBit
  else if Str = '1.5' then Result := sbOne5StopBits
  else Result := sbTwoStopBits;
end;

function StopBitsToStr(Bits: TStopBits): string;
begin
  Case Bits of
    sbOneStopBit: Result := '1';
    sbOne5StopBits: Result := '1.5';
    else Result := '2';
  end;
end;

function StrToParityBits(str: string): TParityBits;
begin
  str := UpperCase(Trim(str));
  if str = 'EVEN' then Result := prEven
  else if str = 'MARK' then Result := prMark
  else if str = 'SPACE' then Result := prSpace
  else if str = 'NONE' then Result := prNone
  else Result := prOdd;
end;

function ParityBitsToStr(Bits: TParityBits): string;
begin
  case Bits of
    prEven: Result := 'EVEN';
    prMark: Result := 'MARK';
    prSpace: Result := 'SPACE';
    prNone: Result := 'NONE';
    prOdd: Result := 'ODD';
  end;
end;

procedure TFrm_Main.Combo_BaudRateChange(Sender: TObject);
begin
  con := ComPort.Connected;
  ComPort.Connected := False;
  ComPort.BaudRate := TBaudRate(Combo_BaudRate.ItemIndex + 1);
  ComPort.Connected := Con;
end;

procedure TFrm_Main.Combo_PortChange(Sender: TObject);
begin
  Con := ComPort.Connected;
  ComPort.Connected := False;
  ComPort.Port := Combo_Port.Text;
  ComPort.Connected := Con;
end;

procedure TFrm_Main.CB_RTSClick(Sender: TObject);
begin
  if ComPort.Connected then
    ComPort.SetRTS(CB_RTS.Checked);
end;

procedure TFrm_Main.CB_DTRClick(Sender: TObject);
begin
  if ComPort.Connected then
    ComPort.SetDTR(CB_DTR.Checked);
end;

procedure TFrm_Main.Btn_ExitClick(Sender: TObject);
begin
  Close;
end;

procedure TFrm_Main.Btn_OpenClick(Sender: TObject);
begin
  if ComPort.Connected then Exit;
  try
    ComPort.Port := Combo_Port.Text;
    ComPort.BaudRate := TBaudRate(Combo_BaudRate.ItemIndex + 1);
    ComPort.Open;
    tbAutoSend.Enabled :=true;
  except
    MessageBox(Handle, PChar('无法打开端口' + ComPort.Port), '错误', MB_OK + MB_ICONError);
  end;
  SetCommStatus;
end;

procedure TFrm_Main.Btn_CloseClick(Sender: TObject);
begin
  if ComPort.Connected then
  begin
    tbAutoSend.Enabled :=false;
    ComPort.Close;
  end;  
  SetCommStatus;
end;

procedure TFrm_Main.Btn_SendClick(Sender: TObject);
var
  DataStr: string;
  i, Idx: Integer;
  cmd: string;
begin
  SB.Panels[0].Text := '';
  if not ComPort.Connected then Exit;
  DataStr := '';
  cmd := CB_CMD.Text;
  if length(cmd) = 0 then Exit;
  if CB_Hex.Checked then
  begin
    if (Length(cmd) mod 2) <> 0 then
    begin
      MessageBox(Handle, '要发送的数据长度错误。十六进制数据长度必须为双数', '错误', MB_OK + MB_ICONError);
      Exit;
    end;
    for i := 1 to Length(cmd) do
      if not (cmd[i] in ['0'..'9', 'A'..'F', 'a'..'f']) then
      begin
        MessageBox(Handle, '数据内容错误。十六进制数据必须为0..9, A..F', '错误', MB_OK + MB_ICONError);
        Exit;
      end;

    for i := 0 to (Length(cmd) div 2) - 1 do
    begin
      DataStr := DataStr + Chr(StrToInt('$' + Copy(cmd, i * 2 + 1, 2)));
    end;
  end
  else
    DataStr := cmd;

  if CB_CRLF.Checked then
    DataStr := DataStr + #$0D;
  ComPort.WriteStr(DataStr);
  Idx := CB_CMD.Items.IndexOf(CMD);
  if Idx = -1 then
  begin
    CB_CMD.Items.Insert(0, CMD);
    if CB_CMD.Items.Count > cmdBuffCapacity then
      for i := cmdBuffCapacity + 1 to CB_CMD.Items.Count do
        CB_CMD.Items.Delete(cmdBuffCapacity);
  end
  else
    Cb_Cmd.Items.Move(Idx, 0);
end;

procedure TFrm_Main.Btn_ClearClick(Sender: TObject);
begin
  Mem_Info.Lines.Clear;
  Mem_Hex.Clear;
  Mem_Text.Clear;
end;

procedure TFrm_Main.ComPortTxEmpty(Sender: TObject);
begin
  Sb.Panels[0].Text := '◆ 发送完毕';
end;

function FmtNow: string;
begin
  Result := FormatDateTime('hh:nn:ss zzz ', Now);
end;

procedure TFrm_Main.ComPortRxChar(Sender: TObject; Count: Integer);
type
  CharBuf = array[0..9999] of Char;
var
  Buffer: ^CharBuf;
  Bytes, P: Integer;
  dats: string;
begin
  Sb.Panels[0].Text := '√ 收到数据';
  GetMem(Buffer, Count);
  try
    Fillchar(Buffer^, Count, 0);
    Bytes := ComPort.Read(Buffer^, Count);
    dats := '';
    for P := 0 to Bytes - 1 do
    begin
      Dats := Dats + IntToHex(Ord(CharBuf(Buffer^)[P]), 2);
      TriggerBuff := TriggerBuff + Buffer^[P];
      case Buffer^[P] of
        #0, #10: ;
        #13:
          begin
            Mem_Text.Lines.Add(FmtNow + LineData);
            LineData := '';
          end;
      else
        LineData := LineData + CharBuf(Buffer^)[P];
      end;
    end;