commmain.pas

使用Delphi编写的串口通信控制器

//*********************************************************
//                 Kaersoft    卡尔软件
//         *************************************
//          http://www.kaer.cn/default.aspx
//          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;

type
  TMainForm = class(TForm)
    Memo_Show: TMemo;
    ComPort1: TApdComPort;
    Panel1: TPanel;
    SendMemo: TMemo;
    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;
    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);
  private
    { Private declarations }
    procedure myMemoAddText(strAdd : string);
  public
    { Public declarations }
  end;

const
  version='版本号：V1.12';
  SoftName='串口通讯控制器';
  {
   1.10:增加窗口定位记忆功能；保存相应设置 ；
   1.12:消除累加显示时的闪烁感
  }

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];
  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
  s2:string;
  buf1:array[0..50000] of byte;
  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
    begin
      buf1[i]:=strtoint('$'+copy(s2,i*2+1,2));
    end;
    MainForm.ComPort1.PutBlock(buf1,(length(s2) div 2));
end;

//等待串口发送完毕
procedure waitcommEmpty;
var
  t:integer;
begin
  t:=0;
  while (MainForm.ComPort1.OutBuffUsed>0) or (t>100) do
  begin
    sleep(200);
    inc(t);
  end;
    sleep(200);
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:string;
begin
  s:=SendMemo.Text;
  if  ComPort1.Open then
  begin
    if CB_hexSend.Checked then
      SendHex(S)
    else
      ComPort1.PutString(s);
    FSdate:=FSdate+length(s);
    StatusBar.Panels.Items[1].Text:='发送：'+inttostr(FSdate);
    waitcommEmpty;
  end else
    showmessage('串口未打开。');
end;

procedure TMainForm.Btn_ClearViewClick(Sender: TObject);
begin
  Memo_Show.Clear;
end;

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

procedure TMainForm.Btn_SaveViewClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
  begin
    Memo_Show.Lines.SaveToFile(SaveDialog1.FileName);
  end;
end;

procedure TMainForm.Btn_OpenFileClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    SendMemo.Lines.LoadFromFile(OpenDialog1.FileName);
  end;
end;

procedure TMainForm.Btn_ClearMomeClick(Sender: TObject);
begin
  SendMemo.Clear;
end;

procedure TMainForm.CB_AutoSendClick(Sender: TObject);
begin
  if CB_AutoSend.Checked then
  begin
    Timer_AutoSend.Interval:=strtoint(Edt_Interval.Text);
    Timer_AutoSend.Enabled:=true;
  end else
    Timer_AutoSend.Enabled:=false;
end;

procedure TMainForm.Edt_IntervalKeyPress(Sender: TObject; var Key: Char);
begin
  if key=#8 then exit;
  if (key>'9') or (key<'0') then
    key:=#0;
end;

procedure TMainForm.Timer_AutoSendTimer(Sender: TObject);
begin
  Btn_SendClick(Sender);
end;

procedure TMainForm.Memo_ShowChange(Sender: TObject);
begin
  if CB_Clear.Checked then
    if length(Memo_Show.Text)>10000 then
      Memo_Show.Clear;
end;

procedure TMainForm.Btn_AboutClick(Sender: TObject);
begin
  AboutBox.ShowModal;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  MainForm.Caption:=Application.Title;
  CB_ComNum.ItemIndex:=0;
  InitDate;
  ComPortInit;
end;

procedure TMainForm.Btn_CountResetClick(Sender: TObject);
begin
  InitDate;
end;

procedure TMainForm.Timer_WatchStateTimer(Sender: TObject);
begin
  if  ComPort1.Open then
    Shape_ComState.Brush.Color:=clLime
  else
    Shape_ComState.Brush.Color:=clRed;
  StatusBar.Panels.Items[0].Text:=datetimetostr(now);
  StatusBar.Panels.Items[3].Text:=version;
end;

procedure TMainForm.FormResize(Sender: TObject);
begin
  if MainForm.Width<670 then  MainForm.Width:=670;
  if MainForm.Height<490 then  MainForm.Height:=490;
end;

//通过INI文件，记忆设置和窗口位置
procedure TMainForm.FormCreate(Sender: TObject);
var
  Ini: TIniFile;
begin
  Ini := TIniFile.Create( ChangeFileExt( Application.ExeName, '.INI' ) );
  try
    Top     :=  Ini.ReadInteger( 'Form', 'Top', 100 );
    Left    :=  Ini.ReadInteger( 'Form', 'Left', 100 );
    Width   :=  Ini.ReadInteger( 'Form', 'Width', 500 );
    Height  :=  Ini.ReadInteger( 'Form', 'Height', 300 );
    Caption :=  Ini.ReadString( 'Form', 'Caption', SoftName );
    
    CB_HexGet.Checked:=Ini.ReadBool('Form', 'HexGet', false );
    CB_StopShow.Checked:=Ini.ReadBool('Form', 'StopShow', false);
    CB_Clear.Checked:=Ini.ReadBool('Form', 'Clear', true );
    CB_Show.Checked:=Ini.ReadBool('Form', 'Show', false );
    CB_hexSend.Checked:=Ini.ReadBool('Form', 'hexSend', false );

    Edt_Interval.Text:= inttostr(Ini.ReadInteger( 'Form', 'Interval', 1000 ));
    if Ini.ReadBool( 'Form', 'InitMax', false ) then
      WindowState := wsMaximized
    else
      WindowState := wsNormal;
  finally
    Ini.Free;
  end;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
  Ini: TIniFile;
begin
  Ini := TIniFile.Create( ChangeFileExt( Application.ExeName, '.INI' ) );
  try
    Ini.WriteInteger( 'Form', 'Top', Top);
    Ini.WriteInteger( 'Form', 'Left', Left);
    Ini.WriteInteger( 'Form', 'Width',Width);
    Ini.WriteInteger( 'Form', 'Height',Height);
    Ini.WriteString( 'Form', 'Caption', Caption );
    Ini.WriteBool( 'Form', 'InitMax', WindowState = wsMaximized );
    Ini.WriteBool('Form', 'HexGet',CB_HexGet.Checked);
    Ini.WriteBool('Form', 'StopShow',CB_StopShow.Checked);
    Ini.WriteBool('Form', 'Clear',CB_Clear.Checked);
    Ini.WriteBool('Form', 'Show',CB_Show.Checked);
    Ini.WriteBool('Form', 'hexSend',CB_hexSend.Checked);
    Ini.WriteInteger( 'Form', 'Interval', strtoint(Edt_Interval.Text));
  finally
    Ini.Free;
  end;
end;

end.