commmain.pas

这是一个PC机串口通信控制软件 开发环境：基于window xp的delphi 7.0平台 开发语言：pascal语言

//*********************************************************
//                 Kaersoft    卡尔软件
//         *************************************
//          http://soft.kaer.cn
//          Email:[e-mail]
//          QQ:54076683
//          Delphi 7.0   PASS
//**********************************************************
unit commmain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OoMisc, AdPort, StdCtrls, ExtCtrls, ComCtrls, AdStatLt,IniFiles,
  Menus;

type
  TMainForm = class(TForm)
    ComPort1: TApdComPort;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Btn_Send: TButton;
    Btn_ClearView: TButton;
    StatusBar: TStatusBar;
    Btn_SaveView: TButton;
    Panel4: TPanel;
    CB_StopBits: TComboBox;
    Label3: TLabel;
    Label5: TLabel;
    CB_DataBits: TComboBox;
    CB_Parity: TComboBox;
    Label4: TLabel;
    Label2: TLabel;
    CB_Baud: TComboBox;
    CB_ComNum: TComboBox;
    Label1: TLabel;
    Btn_Reset: TButton;
    SaveDialog1: TSaveDialog;
    CB_hexSend: TCheckBox;
    Btn_ClearMome: TButton;
    CB_AutoSend: TCheckBox;
    Edt_Interval: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    Btn_OpenFile: TButton;
    OpenDialog1: TOpenDialog;
    Timer_AutoSend: TTimer;
    CB_Clear: TCheckBox;
    CB_Show: TCheckBox;
    CB_HexGet: TCheckBox;
    Btn_About: TButton;
    CB_StopShow: TCheckBox;
    Btn_CountReset: TButton;
    Timer_WatchState: TTimer;
    Shape_ComState: TShape;
    Memo_Show: TRichEdit;
    FindDialog1: TFindDialog;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    Panel5: TPanel;
    SendMemo: TRichEdit;
    Panel6: TPanel;
    CB_EnterSend: TCheckBox;
    CB_AddCenter: TCheckBox;
    CB_ShowSend: TCheckBox;
    procedure ComPort1Trigger(CP: TObject; Msg, TriggerHandle,
      Data: Word);
    procedure diff(s:string);
    procedure Btn_ResetClick(Sender: TObject);
    procedure SendHex(S: String);
    procedure Btn_SendClick(Sender: TObject);
    procedure Btn_ClearViewClick(Sender: TObject);
    procedure CB_ComNumSelect(Sender: TObject);
    procedure Btn_SaveViewClick(Sender: TObject);
    procedure Btn_OpenFileClick(Sender: TObject);
    procedure Btn_ClearMomeClick(Sender: TObject);
    procedure CB_AutoSendClick(Sender: TObject);
    procedure Edt_IntervalKeyPress(Sender: TObject; var Key: Char);
    procedure Timer_AutoSendTimer(Sender: TObject);
    procedure Memo_ShowChange(Sender: TObject);
    procedure leijia(s:string);
    procedure zhuhang(s:string);
    procedure Btn_AboutClick(Sender: TObject);
    procedure ComPortInit;
    procedure InitDate;
    procedure FormShow(Sender: TObject);
    procedure Btn_CountResetClick(Sender: TObject);
    procedure Timer_WatchStateTimer(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure N6Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FindDialog1Find(Sender: TObject);
    procedure Memo_ShowKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SendMemoKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
    procedure myMemoAddText(strAdd : string);
  public
    { Public declarations }
  end;

const
  version='版本号：V1.22';
  SoftName='串口通讯控制器';
  Verinfo='原创：jpyc'+#13+'山东威海'#13'OICQ：54076683'#13'主页：http://www.56kc.com'#13'E_mail:[e-mail] '#13'软件版本升级记录:'#13
    +'1.22:增加“回车发送数据、发送后缀回车、发送数据后清空发送区”功能。'#13+
    '1.20:调整发送16进制数据量时的错位问题；串口被占用时，自动停止“自动发送”。'#13+
    '1.18:调整发送较大数据量时的异常问题。'#13+
    '1.16:增加了ctrl+F,F3键组合使用，搜索字符串功能;'#13+
    '1.14:也是为了消除累加显示时的闪烁感，原来用memo,改为richedit；'#13+
    '1.12:消除累加显示时的闪烁感'#13+
    '1.10:增加窗口定位记忆功能；保存相应设置 ；'#13+
    '相关组件及最新版可以到支持者主页下载。'#13;

var
  MainForm  : TMainForm;
  JSdate,FSdate : integer;
implementation

uses about;

{$R *.dfm}

procedure TMainForm.myMemoAddText(strAdd : string);
var
  str : string;
begin
  str := Memo_Show.Lines[Memo_Show.Lines.Count-1];
  if Memo_Show.Lines.Count=0 then
    Memo_Show.Lines[0] := str + strAdd
  else
    Memo_Show.Lines[Memo_Show.Lines.Count-1] := str + strAdd;
end;

//累加显示
procedure TMainForm.leijia(s:string);
begin
  myMemoAddText(s);
end;

//逐行显示
procedure TMainForm.zhuhang(s:string);
begin
  Memo_Show.Lines.Add(s);
end;

procedure TMainForm.diff(s:string);
begin
  if not CB_StopShow.Checked then
    if CB_Show.Checked then
      zhuhang(s)
    else
      Leijia(s);
end;

//接收数据
procedure TMainForm.ComPort1Trigger(CP: TObject; Msg, TriggerHandle,
  Data: Word);
var
  I : Word;
  C : Char;
  s : String;
begin
  try
  case Msg of
    APW_TRIGGERDATA :
      {got 'login', send response}
      ;
    APW_TRIGGERAVAIL :
      {extract and display/process the data}
      begin
        s:='';
        for I:= 1 to Data do
        begin
          C := ComPort1.GetChar;
          if CB_hexGet.Checked then
          begin
            s:=s+inttohex(byte(c),2)+' ';
          end else
            s:=s+c;
          inc(JSdate);
        end;
        StatusBar.Panels.Items[2].Text:='接收：'+inttostr(JSdate);
        Diff(s);
      end;
    APW_TRIGGERTIMER :
      {timed out waiting for login prompt, handle error}
      ;
  end;
  except
  end;
end;

//发送16进制数据
procedure TMainForm.SendHex(S: String);
var
  buf1:array[0..50000] of byte;
  i:integer;
begin
  for i:=0 to (length(s) div 2-1) do
  begin
    buf1[i]:=strtoint('$'+copy(s,i*2+1,2));
  end;
  MainForm.ComPort1.PutBlock(buf1,(length(s) div 2));
end;

//等待串口发送完毕
procedure waitcommEmpty(x:integer);
begin
  application.ProcessMessages;
  while (MainForm.ComPort1.OutSize-MainForm.ComPort1.OutBuffUsed<x) do
  begin
    sleep(200);
  end;
    sleep(20);
end;

// 设置串口
procedure TMainForm.ComPortInit;
begin
  try
    ComPort1.Open:=false;
    Shape_ComState.Brush.Color:=clRed;
    sleep(50);
    ComPort1.ComNumber:=CB_ComNum.ItemIndex+1;
    ComPort1.Baud:=strtoint(CB_Baud.Text);
    case CB_Parity.ItemIndex of
    0:
      ComPort1.Parity:=pEven;
    1:
      ComPort1.Parity:=pMark;
    2:
      ComPort1.Parity:=pNone;
    3:
      ComPort1.Parity:=pOdd;
    4:
      ComPort1.Parity:=pSpace;
    else
      ComPort1.Parity:=pNone;
    end;
    ComPort1.DataBits:=strtoint(CB_DataBits.Text);
    ComPort1.StopBits:=strtoint(CB_StopBits.Text);
    ComPort1.Open:=true;
  except
    showmessage('串口不存在或被占用。');
  end;
end;

//设置计数器
procedure TMainForm.InitDate;
begin
  JSdate:=0;
  FSdate:=0;
  StatusBar.Panels.Items[1].Text:='发送：0';
  StatusBar.Panels.Items[2].Text:='接收：0';
end;

procedure TMainForm.Btn_ResetClick(Sender: TObject);
begin
  ComPortInit;
end;

procedure TMainForm.Btn_SendClick(Sender: TObject);
var
  s,s2,s3:string;
  x,i:integer;
begin
  s:=SendMemo.Text;
  if  CB_AddCenter.Checked then
    s:= s+#13;

  if  ComPort1.Open then
  begin
    begin
      if CB_hexSend.Checked then
      begin
        s:=stringreplace(s,' ','',[rfReplaceAll,rfIgnoreCase]);
        s:=stringreplace(s,#$a,'',[rfReplaceAll,rfIgnoreCase]);