单元untMain.pas的代码，窗体设置见下
(*******************************************************************************
* Copy Right (C) Gan Huaxin 2001, 2002, huiyugan@263.net
* A Free Screen Words Capture Library
* Dedicated to my GirlFriend Sunny, Happy for ever
*
* Version Date Modification
* 0.1 2001-11-07~09 New, oly a test
* Can Get Word, Sometimes occure error
* 0.2 2002-05-14~16 Some Bugs Fixed,And
*******************************************************************************)
unit untMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, untTypes;
type
TfrmGanDict = class(TForm)
btnLoad: TButton;
btnUnLoad: TButton;
lblHwnd: TLabel;
btnAbout: TButton;
lblMousePos: TLabel;
memoThunk: TMemo;
lblFontWidth: TLabel;
lblRect: TLabel;
procedure btnLoadClick(Sender: TObject);
procedure btnUnLoadClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnAboutClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure WndProc(var Mess: TMessage); override;
end;
var
frmGanDict: TfrmGanDict;
implementation
uses untAbout;
{$R *.DFM}
var
HMapFile:THandle;
CommonData:^TCommonData;
const
STR_MSGNOTIFY
char='WM_GANNOTIFY';
var
idMsg : UINT;
function EnableMouseHook(hld:hwnd; ProcessID : DWORD; hInst : THandle): BOOL; external 'GFDict.dll';
function DisableMouseHook: BOOL; external 'GFDict.dll';
function SetCaptureFlag(bFlag:BOOL): BOOL; external 'GFDict.dll';
procedure MapCommonData;
var FirstCall: Boolean;
begin
HMapFile:=OpenFileMapping(FILE_MAP_WRITE, False, 'GanGan_ThunkDict');
FirstCall:=(HMapFile = 0);
if FirstCall then
HMapFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,
0,SizeOf(TCommonData),
'GanGan_ThunkDict');
CommonData:= MapViewOfFile(HMapFile, FILE_MAP_WRITE, 0, 0, 0);
if FirstCall then FillChar(CommonData^, SizeOf(TCommonData), 0);
end;
procedure TfrmGanDict.btnLoadClick(Sender: TObject);
begin
if not EnableMouseHook(handle, GetCurrentProcessID, Application.Handle) then
ShowMessage('ERROR')
else
SetCaptureFlag(TRUE);
end;
procedure TfrmGanDict.btnUnLoadClick(Sender: TObject);
begin
DisableMouseHook;
end;
procedure TfrmGanDict.FormDestroy(Sender: TObject);
begin
DisableMouseHook;
if CommonData<>nil then begin
UnMapViewOfFile(CommonData);
CommonData := nil;
CloseHandle(HMapFile);
HMapFile := 0;
end;
end;
procedure TfrmGanDict.FormCreate(Sender: TObject);
begin
idMsg := RegisterWindowMessage(STR_MSGNOTIFY);
CommonData := nil;
MapCommonData;
SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOSIZE or SWP_NOMOVE);
end;
const
StrProcNames : array[0..5] of String =
('TextOutA',
'TextOutW',
'ExtTextOutA',
'ExtTextOutW',
'DrawTextA',
'DrawTextW');
procedure TfrmGanDict.WndProc(var Mess: TMessage);
begin
case Mess.LParam of
0:
begin
if (mess.msg = idMsg) then begin
if (Mess.wParam >=0) and (Mess.WParam <= 5) then begin
lblHwnd.Caption := StrProcNames[mess.wParam]; //Format('Handle : 0x%X', [mess.wParam]);
if CommonData <> nil then with CommonData^ do begin
memoThunk.Text := CommonData.BufferA;
lblRect.Caption := Format('Client X:%d, Y:%d, Rect[%d,%d,%d,%d]',
[MousePClient.x, MousePClient.y,
Rect.Left, Rect.Top, Rect.Right, Rect.Bottom]);
// lblThunkText.Caption := CommonData.BufferA;
end
end else
lblHwnd.Caption := 'UnKnow Message';
end;
end;
1:
begin
if CommonData<>nil then with CommonData^ do
lblMousePos.Caption := Format('Mouse Pos X : %d, Y : %d',
[MousePos.X,
MousePos.Y]);
end;
2:
begin
memoThunk.Text := '---';
end;
3:
begin
lblFontWidth.Caption := Format('Font Width : %d', [mess.wParam]);
end;
end;
inherited;
end;
procedure TfrmGanDict.btnAboutClick(Sender: TObject);
begin
AboutBox.ShowModal;
end;
end.
（××××××××××××下面试窗体设置×××××××××××）
object frmGanDict: TfrmGanDict
Left = 564
Top = 163
Width = 280
Height = 237
Caption = 'Gan'#39's Free Dict'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object lblHwnd: TLabel
Left = 8
Top = 8
Width = 76
Height = 13
Caption = 'Window Handle'
end
object lblMousePos: TLabel
Left = 8
Top = 152
Width = 56
Height = 13
Caption = 'Mouse Pos:'
end
object lblFontWidth: TLabel
Left = 8
Top = 192
Width = 52
Height = 13
Caption = 'Font Width'
end
object lblRect: TLabel
Left = 8
Top = 176
Width = 23
Height = 13
Caption = 'Rect'
end
object btnLoad: TButton
Left = 104
Top = 112
Width = 75
Height = 25
Caption = 'Load'
TabOrder = 0
OnClick = btnLoadClick
end
object btnUnLoad: TButton
Left = 192
Top = 112
Width = 75
Height = 25
Caption = 'UnLoad'
TabOrder = 1
OnClick = btnUnLoadClick
end
object btnAbout: TButton
Left = 192
Top = 144
Width = 75
Height = 25
Caption = 'About'
TabOrder = 2
OnClick = btnAboutClick
end
object memoThunk: TMemo
Left = 8
Top = 24
Width = 257
Height = 81
TabOrder = 3
end
end
