main.pas

在网上找的Delphi开发的源程序

{*****************************************************************
*串口调试助手V1.0
*作    者：sky
*Email   : [e-mail]
*QQ      : 11116580
*版    本：V1.0
*编写时间：2005/12/19
*说    明：本程序完全参照龚建伟VC版《串口调试助手V2.2》编写而成。
           仅供学习测试之用。
******************************************************************}
{==================================================================
= 串口调试助手DELPHI SPCOMM V1.1
= 作者    ：谢利洪
= Email   : [e-mail]
= 版本    : V1.1
= 编写时间: 2006.10.21
= 说明    ：本版本由sky的1.0修改而成，本来只是用来学习SPCOMM控件的，想不到经过一
            个晚上的努力，程序已经近于完善了。就将我的成果共享出来吧。由于改用
            COMPORT控件为SPCOMM控件，整个代码已经经过大规模的改动，去除了Email等
            与程序应用不太相关的部分，改进了绝大部分算法，添加原未完成的功能 ，程序
            依然是参照龚建伟VC版《串口调试助手V2.2》来编写的。
===================================================================}

unit main;

interface

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

type
  TFrmMain = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Memo1: TMemo;
    cbsendHex: TCheckBox;
    cbAutoSend: TCheckBox;
    Label1: TLabel;
    SpinEdit1: TSpinEdit;
    Label2: TLabel;
    Button1: TButton;
    Panel4: TPanel;
    btnSend: TButton;
    Button3: TButton;
    Button4: TButton;
    edSendFile: TEdit;
    SpeedButton1: TSpeedButton;
    Memo2: TMemo;
    edStatus: TEdit;
    edRx: TEdit;
    edTx: TEdit;
    Button5: TButton;
    ImageList1: TImageList;
    BitBtn1: TBitBtn;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    btnSwitch: TButton;
    Panel5: TPanel;
    Button6: TButton;
    cbRecHex: TCheckBox;
    cbAutoClean: TCheckBox;
    btnStopShow: TButton;
    Button8: TButton;
    Button9: TButton;
    edPath: TEdit;
    Timer1: TTimer;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    ComboBox5: TComboBox;
    Comm1: TComm;
    ImageOff: TImage;
    ImageOn: TImage;
    procedure SpeedButton1Click(Sender: TObject);
    procedure btnSwitchClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure cbAutoSendClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnStopShowClick(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);
    procedure ComboBox4Change(Sender: TObject);
    procedure ComboBox5Change(Sender: TObject);
    procedure ComboBox2KeyPress(Sender: TObject; var Key: Char);
    procedure Memo2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    OnTop : Boolean;
    FShowText:Boolean;
    FRXNum:Integer;
    FTXNum:Integer;
    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

const
  minWidth=627;
  minHeight=444;
  idAbout =$F200;

{$R *.dfm}

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;
  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 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
    Exit;  // raise EComPort.Create(CError_RegError, ErrCode);

  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
          exit; //raise EComPort.Create(CError_RegError, ErrCode);

    until (ErrCode <> ERROR_SUCCESS) ;

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

end;


procedure TFrmMain.SpeedButton1Click(Sender: TObject);
var
  B:TBitmap;

begin
  B:=TBitmap.Create;
  if not OnTop then
    begin
      SetWindowPos(FrmMain.handle, HWND_TOPMOST, FrmMain.Left, FrmMain.Top,
                    FrmMain.Width, FrmMain.Height,0);
      if ImageList1.GetBitmap(1,B) then
        begin
          SpeedButton1.Glyph.Assign(B);
        end;
    end
    else begin
      SetWindowPos(FrmMain.handle, HWND_NOTOPMOST, FrmMain.Left, FrmMain.Top,
                    FrmMain.Width, FrmMain.Height,0);
      if ImageList1.GetBitmap(0,B) then
        begin
          SpeedButton1.Glyph.Assign(B);
        end;
    end;
  OnTop := not OnTop;
  SpeedButton1.Down := false;
  B.Free;
end;

procedure TFrmMain.btnSwitchClick(Sender: TObject);
var BaudRate :integer;
begin
if btnSwitch.Caption = '打开串口' then
  begin
  if not TryStrToInt(ComboBox2.Text,BaudRate) then
     begin
     Application.MessageBox('波特率设定有误'+#13+
                             ' 请重新输入','警告',MB_ICONWARNING or MB_OK);
     ComboBox2.SetFocus;
     exit;
     end;

  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;