main.pas

串口调试助手V1.5

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, ExtCtrls, Spcomm, shlobj, WinSkinData;

type
  TFrmMain = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Memo1: TMemo;
    cbsendHex: TCheckBox;
    cbAutoSend: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    btnClrSnd: TButton;
    Panel4: TPanel;
    btnSend: TButton;
    btnFile: TButton;
    btnSndFile: TButton;
    edSendFile: TEdit;

    Memo2: TMemo;
    edStatus: TEdit;
    edRx: TEdit;
    edTx: TEdit;
    btnClrCnt: TButton;
    btnExit: TBitBtn;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    ComboBox5: TComboBox;
    btnSwitch: TButton;
    Panel5: TPanel;
    btnClrRev: TButton;
    cbRecHex: TCheckBox;
    cbAutoClean: TCheckBox;
    btnStopShow: TButton;
    btnSavDat: TButton;
    btnChgDir: TButton;
    edPath: TEdit;
    Timer1: TTimer;
    OpenDialog1: TOpenDialog;
    Comm1: TComm;
    ImageOff: TImage;
    ImageOn: TImage;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Label8: TLabel;
    ComboBox6: TComboBox;
    skndt1: TSkinData;
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure btnSwitchClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnClrRevClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnClrCntClick(Sender: TObject);
    procedure btnClrSndClick(Sender: TObject);
    procedure cbAutoSendClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnStopShowClick(Sender: TObject);
    procedure btnChgDirClick(Sender: TObject);
    procedure btnSavDatClick(Sender: TObject);
    procedure btnFileClick(Sender: TObject);
    procedure btnSndFileClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure ComboBox2KeyPress(Sender: TObject; var Key: Char);
    procedure ComboBox3Change(Sender: TObject);
    procedure ComboBox4Change(Sender: TObject);
    procedure ComboBox5Change(Sender: TObject);
    procedure Memo2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure Edit1Change(Sender: TObject);
    procedure Memo2KeyPress(Sender: TObject; var Key: Char);
    procedure ComboBox6Change(Sender: TObject);
  private
    { Private declarations }
    FShowText: Boolean;
    FRXNum: Cardinal;
    FTXNum: Cardinal;
    procedure ShowRX;
    procedure ShowTX;
    procedure ShowStatus;
    procedure SendFile(const FileName: string);
    procedure SendString(const Str: string);
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

type 
  ERegError = class(Exception);

const
  idHelp  = $F200;
  idAbout = $F201;

  {$R *.dfm}

//设为最上
procedure TFrmMain.SpeedButton1Click(Sender: TObject);
begin
  SetWindowPos(FrmMain.Handle, HWND_TOPMOST, FrmMain.Left, FrmMain.Top,
    FrmMain.Width, FrmMain.Height, 0);
  SpeedButton1.Visible := false;
  SpeedButton2.Visible := true;
end;

//取消最上
procedure TFrmMain.SpeedButton2Click(Sender: TObject);
begin
  SetWindowPos(FrmMain.Handle, HWND_NOTOPMOST, FrmMain.Left, FrmMain.Top,
    FrmMain.Width, FrmMain.Height, 0);
  SpeedButton2.Visible := false;
  SpeedButton1.Visible := true;
end;

procedure TFrmMain.btnSwitchClick(Sender: TObject);
begin
  //判断按键的状态可以避免打开串口出错时，要按两次按键
  if btnSwitch.Caption = '打开串口' then
  begin
    Comm1.StartComm;  //打开串口
    btnSwitch.Caption := '关闭串口';
    ComboBox1.Enabled := false;
    ComboBox2.Enabled := false;
    ComboBox3.Enabled := false;
    ComboBox4.Enabled := false;
    ComboBox5.Enabled := false;
    btnSend.Enabled   := true;
    ImageOff.Visible  := false;
    ImageOn.Visible   := true;
  end
  else //if Button1.Caption = '关闭串口' then
  begin
    Comm1.StopComm;  // 关闭串口
    btnSwitch.Caption := '打开串口';
    ComboBox1.Enabled := true;
    ComboBox2.Enabled := true;
    ComboBox3.Enabled := true;
    ComboBox4.Enabled := true;
    ComboBox5.Enabled := true;
    btnSend.Enabled   := false;
    ImageOn.Visible   := false;
    ImageOff.Visible  := true;
  end;
  ShowStatus;
end;

procedure TFrmMain.btnExitClick(Sender: TObject);
begin
  Close;
end;

procedure TFrmMain.btnClrRevClick(Sender: TObject);
begin
  Memo1.Clear;
end;

//获取串口列表
procedure EnumComPorts(Ports: TStrings);
var
  KeyHandle: HKEY;
  ErrCode, Index: Integer;
  ValueName, Data: string;
  ValueLen, DataLen, ValueType: DWORD;
  TmpPorts: TStringList;
begin
  ErrCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'HARDWARE\DEVICEMAP\SERIALCOMM', 0,
    KEY_READ, KeyHandle);

  if ErrCode <> ERROR_SUCCESS then
    raise ERegError.Create('打开串口列表的注册表项出错');

  TmpPorts := TStringList.Create;
  try
    Index := 0;
    repeat
      ValueLen := 256;
      DataLen := 256;
      SetLength(ValueName, ValueLen);
      SetLength(Data, DataLen);
      ErrCode := RegEnumValue(KeyHandle, Index, PChar(ValueName),
        Cardinal(ValueLen), nil, @ValueType, PByte(PChar(Data)), @DataLen);

      if ErrCode = ERROR_SUCCESS then
      begin
        SetLength(Data, DataLen);
        TmpPorts.Add(Data);
        Inc(Index);
      end
      else if ErrCode <> ERROR_NO_MORE_ITEMS then
        raise ERegError.Create('打开串口列表的注册表项出错');

    until (ErrCode <> ERROR_SUCCESS);

    TmpPorts.Sort;
    Ports.Assign(TmpPorts);
  finally
    RegCloseKey(KeyHandle);
    TmpPorts.Free;
  end;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
var
  myMenu: HMENU;
begin
  //设置窗体的最小大小
  FrmMain.Constraints.MinHeight := FrmMain.Height;
  FrmMain.Constraints.MinWidth := FrmMain.Width;

  FShowText := true;
  FRXNum := 0;
  FTXNum := 0;

  //串口初始化
  EnumComPorts(ComboBox1.Items);    //得到串口列表
  ComboBox1.ItemIndex := 0;
  Comm1.CommName := ComboBox1.Text;
  ComboBox2.ItemIndex := 7;
  Comm1.BaudRate := StrToInt(ComboBox2.Text);
  ComboBox3.ItemIndex := 0;
  Comm1.Parity := None;
  ComboBox4.ItemIndex := 3;
  Comm1.ByteSize := _8;
  ComboBox5.ItemIndex := 0;
  Comm1.StopBits := _1;

  //添加系统菜单
  myMenu := GetSystemMenu(Handle, false);
  AppendMenu(myMenu, MF_SEPARATOR, 0, '');
  AppendMenu(myMenu, MF_STRING, idHelp, '帮助');
  AppendMenu(myMenu, MF_STRING, idAbout, '关于');

  //设置EDIT控件为只能输入数字
  SetWindowLong(Edit1.Handle, GWL_STYLE,
    GetWindowLong(Edit1.Handle, GWL_STYLE) or ES_NUMBER {or ES_RIGHT});
end;

procedure TFrmMain.ShowRX;
begin
  edRX.Text := 'Rx:' + IntToStr(FRXNum);
end;

procedure TFrmMain.ShowStatus;
begin
  if btnSwitch.Caption = '关闭串口' then
  begin
    edStatus.Text := Format(' STATUS: %s Opened %s %s %s %s', [ComboBox1.Text,
      {ComboBox2.Text,}IntToStr(Comm1.BaudRate), ComboBox3.Text,
      ComboBox4.Text, ComboBox5.Text]);
  end
  else
    edStatus.Text := ' STATUS: COM Port Closed';
end;

procedure TFrmMain.ShowTX;
begin
  edTx.Text := 'Tx:' + IntToStr(FTXNum);
end;

procedure TFrmMain.btnClrCntClick(Sender: TObject);
begin
  FRXNum := 0;
  FTXNum := 0;
  ShowRX;
  ShowTX;
end;

procedure TFrmMain.btnClrSndClick(Sender: TObject);
begin
  Memo2.Clear;
end;

procedure TFrmMain.cbAutoSendClick(Sender: TObject);
begin
  Timer1.Enabled := cbAutoSend.Checked;
  Edit1.Enabled := not cbAutoSend.Checked;
end;

procedure TFrmMain.Timer1Timer(Sender: TObject);
begin
  if (btnSend.Enabled) and (Memo2.Text <> '') then
    btnSend.Click;
end;

procedure TFrmMain.btnStopShowClick(Sender: TObject);
begin
  FShowText := not FShowText;
  if FShowText then
    btnStopShow.Caption := '停止显示'
  else
    btnStopShow.Caption := '继续显示';
end;

//选择目录函数，需包含 shlobj 单元
function SelectDirectory(Handle: hwnd; const Caption: string;
  const Root: WideString; out Directory: string): Boolean;
var
  lpBI: _BrowseInfo;
  Buf: array[0..MAX_PATH] of Char;
  ID: IShellFolder;
  Eaten, Att: Cardinal;
  rt: pItemIDList;
  initdir: PWideChar;
begin
  Result := false;
  lpbi.hwndOwner := Handle;
  lpbi.lpfn := nil;
  lpbi.lpszTitle := PChar(Caption);
  //lpbi.ulFlags := BIF_RETURNONLYFSDIRS + BIF_EDITBOX;
  lpbi.ulFlags := BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE;
  SHGetDesktopFolder(ID);
  initdir := PWChar(Root);
  ID.ParseDisplayName(0, nil, InitDir, Eaten, rt, Att);
  lpbi.pidlRoot := rt;
  GetMem(lpbi.pszDisplayName, MAX_PATH);
  try
    Result := SHGetPathFromIDList(SHBrowseForFolder(lpbi), buf);
  except
    FreeMem(lpbi.pszDisplayName);
  end;
  if Result then 
  begin
    Directory := buf;
    if Length(Directory) <> 3 then
      Directory := Directory + '\';
  end;
end;

procedure TFrmMain.btnChgDirClick(Sender: TObject);
var
  Dir: string;