umain.pas

Delphi专用调试器bannico的源代码

{
Delphi 代码调试工具

类似Raize CodeSite的一个工具，利用程序间通讯的方法实现调试信息传递。
程序仅仅实现了一些简单的功能，代码接收框用TRichEdit是为以后接收图片信息提供一
个扩展的基础。感兴趣可以自己扩展功能。

本代码不保留版权，可自由使用。
转载请保留出处及本说明。


Bannico

E_Mail:[e-mail]

2006年11月24日 上海
}
unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Registry,
  Dialogs, ComCtrls, ExtCtrls, ToolWin, StdCtrls, bnDebug, ImgList, Menus,ShellAPI;

const
  icoMsg = wm_user + 1;
  iid = 100;

type
  TfMain = class(TForm)
    ToolBar1: TToolBar;
    MainPanel: TPanel;
    StatusBar: TStatusBar;
    btnClear: TToolButton;
    btnSave: TToolButton;
    RichEdit: TRichEdit;
    ToolButton6: TToolButton;
    ImageList1: TImageList;
    SaveDialog: TSaveDialog;
    ToolButton3: TToolButton;
    btnExit: TToolButton;
    btnConnect: TToolButton;
    ToolButton7: TToolButton;
    StayOnTop: TCheckBox;
    ToolButton1: TToolButton;
    PopupMenu: TPopupMenu;
    nShow: TMenuItem;
    N2: TMenuItem;
    nExit: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure StayOnTopClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure nExitClick(Sender: TObject);
    procedure nShowClick(Sender: TObject);
  private
    procedure DataMessage(var t:TWmCopyData);message WM_COPYDATA;
    procedure iconMessage(var message:TMessage); message icoMsg;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fMain: TfMain;
  ntid: TnotifyIconDataA;
implementation

{$R *.dfm}

procedure TfMain.DataMessage(var t: TWmCopyData);
begin
  if btnConnect.Down then
  begin
    RichEdit.Lines.BeginUpdate;
    RichEdit.Lines.Add(StrPas(t.CopyDataStruct^.lpData));
    RichEdit.Lines.EndUpdate;
  end;
end;

procedure TfMain.iconMessage(var message:TMessage);
var
  mypt:Tpoint;
begin
  Inherited;
  if message.LParam = WM_RBUTTONUP then
  begin
    getCursorPos(mypt);
    PopupMenu.Popup(mypt.X,mypt.Y);
  end;
  message.Result:= 0;
end;

procedure TfMain.StayOnTopClick(Sender: TObject);
begin
  if StayOnTop.Checked then
    FormStyle:=fsStayOnTop
  else
    FormStyle:=fsNormal;
end;

procedure TfMain.FormCreate(Sender: TObject);
var
  Reg:TRegistry;
  R:TRect;
begin
  Reg:=TRegistry.Create;
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  Reg.OpenKey(SoftKey,True);
  Reg.WriteString('FormPath',ParamStr(0));
  Reg.CloseKey;
  Reg.Free;

  Application.Title:=DebugHandle;
  Caption:=Application.Title;
  Left:=Screen.Width-Width;
  Top:=Screen.Height-Height-30;

  StatusBar.Panels[0].Text:='状态：接收中...';
  ntid.cbsize := sizeof(TnotifyIconDataA);
  ntid.Wnd := Handle;
  ntid.uID := iid;
  ntid.uFlags := NIF_ICON + NIF_TIP + NIF_MESSAGE;
  ntid.uCallbackMessage := icoMsg;
  ntid.hIcon:=Self.Icon.Handle;
  ntid.szTip :='代码调试工具';
  shell_notifyicona(NIM_ADD,@ntid);
  self.Visible := false;

  SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);
end;

procedure TfMain.btnClearClick(Sender: TObject);
begin
  RichEdit.Clear;
end;

procedure TfMain.btnSaveClick(Sender: TObject);
begin
  if SaveDialog.Execute then
    RichEdit.Lines.SaveToFile(SaveDialog.FileName); 
end;

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

procedure TfMain.btnConnectClick(Sender: TObject);
begin
  case btnConnect.Down of
    True:
    begin
      btnConnect.Caption:='断开';
      StatusBar.Panels[0].Text:='状态：接收中...';
    end;
    False:
    begin
      btnConnect.Caption:='接收';
      StatusBar.Panels[0].Text:='状态：断开';
    end;
  end;
end;

procedure TfMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Hide;
  Abort;
end;

procedure TfMain.nExitClick(Sender: TObject);
begin
  ntid.cbSize := sizeof(TnotifyIconDataA);
  ntid.Wnd := Handle;
  ntid.uID := iid;
  ntid.uFlags := NIF_ICON + NIF_TIP + NIF_MESSAGE;
  ntid.uCallbackMessage := icoMsg;
  ntid.hIcon := Self.Icon.Handle;
  ntid.szTip := '代码调试工具';
  shell_notifyicona(NIM_DELETE,@ntid);
  
  self.Visible := true;
  Application.Terminate;
end;

procedure TfMain.nShowClick(Sender: TObject);
begin
  Show;
end;

end.