co_main.pas

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

  finally
    Mem_Hex.Lines.Add(FmtNow + Dats);
    FreeMem(Buffer);
  end;
  LinkToTrigger(TriggerBuff);
end;

procedure TFrm_Main.LinkToTrigger(var buf: string);
var i, j, PacketLen: Integer;
  Item: TTriggerItem;
begin
  for i:=0 to FTrigger.Count-1 do
  begin
    Item := FTrigger[i];
    if not Item.Actived then
      Continue;
    j := Pos(Item.TriggerHead, Buf);
    PacketLen := j + Item.TriggerLen - 1;
    if (j > 0) and (length(Buf) >= PacketLen) then
    begin
      Mem_Info.Lines.Add(FmtNow + ' 触发: ' + Item.TriggerName);
      Delete(Buf, 1, PacketLen);
      Sleep(Item.RespondeDelay);
      ComPort.WriteStr(Item.RespondeData);
      Break;
    end;
  end;
end;

procedure TFrm_Main.ComPortError(Sender: TObject; Errors: TComErrors);
begin
  Sb.Panels[0].Text := '接收错误';
end;

procedure TFrm_Main.ComPortDSRChange(Sender: TObject; OnOff: Boolean);
begin
  if ONOff then
    Sb.Panels[2].Text := 'DSR On'
  else
    Sb.Panels[2].Text := 'DSR Off';
end;

procedure TFrm_Main.ComPortCTSChange(Sender: TObject; OnOff: Boolean);
begin
  if ONOff then
    Sb.Panels[1].Text := 'CTS On'
  else
    Sb.Panels[1].Text := 'CTS Off';
end;

procedure FitFormSize(Frm: TCustomForm);
var i, Px, Py: Integer;
begin
   with Frm do
   begin
     Px := GetDeviceCaps(Canvas.Handle, LOGPIXELSX);
     Py := GetDeviceCaps(Canvas.Handle, LOGPIXELSY);
     Width := MulDiv(Width, Px, 96);
     Height := MulDiv(Height, Py, 96);
     for i:=0 to ControlCount-1 do
     begin
       Controls[i].Width := MulDiv(Controls[i].Width, Px, 96);
       Controls[i].Height := MulDiv(Controls[i].Height, Py, 96);;
     end;
   end;
end;

procedure TFrm_Main.FormCreate(Sender: TObject);
var
  Port, Br, cmd: string;
  iCmd: Integer;
begin
  Caption := sVerInfo;
  FitFormSize(Self);
  Inis := TIniFile.Create(GetCurrentDir + '\Comm.ini');
  Port := Inis.ReadString('系统参数', '串口', 'COM1');
  FTrigger := TTrigger.Create(TTriggerItem);
  ComBo_Port.ItemIndex := ComBo_Port.Items.IndexOf(Port);
  BR := Inis.ReadString('系统参数', '速率', '9600');
  Combo_BaudRate.ItemIndex := Combo_BaudRate.Items.IndexOf(Br);
  CB_DTR.Checked := Inis.ReadBool('系统参数', 'DTR', False);
  CB_RTS.Checked := Inis.ReadBool('系统参数', 'RTS', False);
  CB_CRLF.Checked := Inis.ReadBool('系统参数', 'CRLF', False);
  CB_Hex.Checked := Inis.ReadBool('系统参数', '十六进制', False);
  Cb_DataBits.ItemIndex := Cb_DataBits.Items.IndexOf(Inis.ReadString('系统参数', '数据位', '8'));
  Cb_StopBits.ItemIndex := Cb_StopBits.Items.IndexOf(Inis.ReadString('系统参数', '停止位', '1'));
  Cb_ParityBits.ItemIndex := Cb_ParityBits.Items.IndexOf(Inis.ReadString('系统参数', '校验位', 'NONE'));
  FTriggerFileName := Inis.ReadString('系统参数', 'Triggerfn', '');
  if (FTriggerFileName <> '') and (FileExists(FTriggerFileName)) then
  try
    FTrigger.LoadFromFile(FTriggerFileName);
  except
    FTRigger.Clear;
    FTriggerFileName := '';
  end;
  for iCmd := 0 to cmdBuffCapacity do
  begin
    cmd := Inis.ReadString('系统参数', 'Command#' + IntToStr(iCmd), '');
    if (cmd <> '') and (CB_CMD.Items.IndexOf(cmd) = -1) then
      CB_CMD.Items.Add(cmd);
  end;
  CB_CMD.ItemIndex := 0;
  SetCommStatus;
end;

procedure TFrm_Main.FormDestroy(Sender: TObject);
var
  iCmd: Integer;
begin
  Inis.WriteBool('系统参数', 'DTR', CB_DTR.Checked);
  Inis.WriteBool('系统参数', 'CRLF', CB_CRLF.Checked);
  Inis.WriteBool('系统参数', 'RTS', CB_RTS.Checked);
  Inis.WriteBool('系统参数', '十六进制', CB_Hex.Checked);
  Inis.writeString('系统参数', '速率', Combo_BaudRate.Text);
  Inis.writeString('系统参数', '串口', Combo_Port.Text);
  Inis.writeString('系统参数', 'Triggerfn', FTriggerFileName);
  Inis.writeString('系统参数', '数据位', DataBitsToStr(ComPort.DataBits));
  Inis.writeString('系统参数', '停止位', StopBitsToStr(ComPort.StopBits));
  Inis.writeString('系统参数', '校验位', ParityBitsToStr(ComPort.Parity.Bits));

  for iCMD := 1 to cmdBuffCapacity do
    if iCMD <= CB_CMD.items.Count then
      Inis.writeString('系统参数', 'Command#' + IntToStr(iCMD), CB_CMD.items[iCMD - 1])
    else
      Inis.writeString('系统参数', 'Command#' + IntToStr(iCMD), '');
  ComPort.Close;
  FTrigger.Free;
end;

procedure TFrm_Main.ComPortAfterOpen(Sender: TObject);
begin
  CB_RTS.OnClick(self);
  CB_DTR.OnClick(self);
  SetCommStatus;
end;

procedure TFrm_Main.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Shift = [ssAlt]) and (Key = $58) then
  begin
    if btn_Exit.Enabled then
      btn_Exit.Click;
    Key := 0;
  end;

  if Shift = [] then
  begin
    case Key of
      VK_F2:
        begin
          if Btn_Open.Enabled then
            btn_Open.Click;
          Key := 0;
        end;
      VK_F3:
        begin
          if Btn_close.Enabled then
            btn_Close.Click;
          Key := 0;
        end;
      VK_F4:
        begin
          if Btn_Send.Enabled then
            btn_Send.Click;
          Key := 0;
        end;
      VK_F5:
        begin
          if Btn_Clear.Enabled then
            btn_Clear.Click;
          Key := 0;
        end;
      VK_F6:
        begin
          Key := 0;
        end;
      VK_F7:
        begin
          if Btn_Trigger.Enabled then
            btn_Trigger.Click;
          Key := 0;
        end;
    end;
  end;
end;

procedure TFrm_Main.Panel1Resize(Sender: TObject);
begin
  CB_CMD.Width := (Sender as TPanel).Width - 110;
end;

procedure TFrm_Main.SetCommStatus;
begin
  Btn_Open.Enabled := not ComPort.Connected;
  Btn_Close.Enabled := ComPort.Connected;
end;

procedure TFrm_Main.btn_ClearCmdClick(Sender: TObject);
begin
  CB_CMD.Items.Clear;
end;

procedure TFrm_Main.CB_CMDKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = Chr(VK_RETURN) then
    btn_Send.Click;
end;

procedure TFrm_Main.btn_TriggerClick(Sender: TObject);
begin
  Show_Trigger(FTrigger, FTriggerFileName);
end;

procedure TFrm_Main.Cb_DataBitsChange(Sender: TObject);
begin
  ComPort.DataBits := StrToDataBits(CB_DataBits.Text);
end;

procedure TFrm_Main.CB_StopBitsChange(Sender: TObject);
begin
  ComPort.StopBits := StrToStopBits(Cb_StopBits.Text);
end;

procedure TFrm_Main.Cb_ParityBitsChange(Sender: TObject);
begin
  ComPort.Parity.Bits := StrToParityBits(cb_ParityBits.Text);
end;

procedure TFrm_Main.ComPortAfterClose(Sender: TObject);
begin
  SetCommStatus;
end;

procedure TFrm_Main.tbAutoSendClick(Sender: TObject);
var
  mst:string;
begin
  if FAutoSend then
  begin
    FAutoSend:=false;
    tbAutoSend.Down := false;
  end else
  begin
    if FAutoIntervel<=0 then
      FAutoIntervel:=1000;
    mst:=inttostr(FAutoIntervel);
    if InputQuery('设置时间间隔', '循环发送时间间隔(ms):   ', mst) then
    begin
      try
        TimerAutoSend.Enabled := false;
        FAutoIntervel := strtoint(mst);
        TimerAutoSend.Interval :=FAutoIntervel;
        FAutoSend:=True;
        tbAutoSend.Down := true;
        Btn_SendClick(nil);
        TimerAutoSend.Enabled := true;
      except
        showmessage('输入时间不正确!');
        exit;
      end;
    end else
    begin
      FAutoSend:=false;
      tbAutoSend.Down := false;
      TimerAutoSend.Enabled := false;
    end;
  end;
end;

procedure TFrm_Main.TimerAutoSendTimer(Sender: TObject);
begin
  if (not FAutoSend) then
  begin
    TimerAutoSend.Enabled := false;
    exit;
  end;
  TimerAutoSend.Enabled := false;
  try
    Btn_SendClick(nil);
  finally
    if (FAutoSend) then
      TimerAutoSend.Enabled := true
    else
      TimerAutoSend.Enabled := false;
  end;
end;

procedure TFrm_Main.tbByteSendClick(Sender: TObject);
begin
  Show_ByteSend;
  if ByteSend.IsEnable then
  begin
    ByteSend.CurByte := ByteSend.StartByte;
    ByteSend.CurCount := 0;
    TimerByteSend.Enabled := false;
    TimerByteSend.Interval := ByteSend.SendIntervel ;
    ComPort.WriteStr(chr(ByteSend.CurByte));
    IntSendByte;
    TimerByteSend.Enabled := true;
  end;
end;

procedure TFrm_Main.TimerByteSendTimer(Sender: TObject);
begin
  if (not ByteSend.IsEnable) then
  begin
    TimerByteSend.Enabled := false;
    exit;
  end;
  TimerByteSend.Enabled := false;
  try
    if ByteSend.IsEnable then
    begin
      ComPort.WriteStr(chr(ByteSend.CurByte));
      IntSendByte;
    end;
  finally
    if (ByteSend.IsEnable) then
      TimerByteSend.Enabled := true
    else
      TimerByteSend.Enabled := false;
  end;
end;

end.