在应用程序中跟蹤MOUSE的坐标

第一步建一DLLDELPHI中NEW》DLL SAVE AS GETKEY

library getKey;

uses

SysUtils

Windows

HookMain in hookmainpas;

exports

OpenGetKeyHook

CloseGetKeyHook

GetPublicP;

begin

NextHook := ;

procSaveExit := ExitProc;

DLLproc := @DLLMain;

ExitProc := @HookExit;

DLLMain(DLL_PROCESS_ATTACH);

end

第二步建一UNIT HOOK MAIN关键在于CreateFileMapping 和 消息 WM_NCMouseMoveWM_MOUSEMOVE:

unit HookMain;

interface

uses Windows Messages Dialogs SysUtils;

//type DataBuf = Array [] of DWORD;

type mydata=record

data:array [] of DWORD;

data:TMOUSEHOOKSTRUCT;

end;

var hObject : Thandle;

pMem : Pointer;

NextHook: Hhook;

procSaveExit: Pointer;

function HookHandler(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; export;

function OpenGetKeyHook(sender : HWND;MessageID : WORD) : BOOL; export;

function CloseGetKeyHook: BOOL; export;

function GetPublicP : Pointer;stdcall; export;

Procedure DLLMain(dwReason:Dword); far;

procedure HookExit; far;

implementation

Procedure UnMapMem;

begin

if Assigned(pMem) then

begin

UnMapViewOfFile(pMem);

pMem := Nil

end;

end;

Procedure MapMem;

begin

hObject := CreateFileMapping($FFFFFFFFNilPage_ReadWrite$FFFFpChar(_IOBuffer));

if hObject = then Raise ExceptionCreate(创建公用数据的Buffer不成? ;

pMem := MapViewOfFile(hObjectFILE_MAP_WRITESizeOf(mydata));

// or SizeOf(DataBuf) ????

// 创建SizeOf(DataBuf)的数据区

if not Assigned(pMem) then

begin

UnMapMem;

Raise ExceptionCreate(创建公用数据的映射关系不成功!);

end;

end;

Procedure DLLMain(dwReason:Dword); far;

begin

Case dwReason of

DLL_PROCESS_ATTACH :

begin

pMem := nil;

hObject := ;

MapMem; //以下的公有数据如tHWNDtMessageID将直接使用本Buf

End;

DLL_PROCESS_DETACH : UnMapMem;

DLL_THREAD_ATTACH

DLL_THREAD_DETACH :; //缺省

end;

end;

procedure HookExit; far;

begin

CloseGetKeyHook;

ExitProc := procSaveExit;

end;

function GetPublicP : Pointer;export;

begin //这里引出了公用数据区的指针你可以在你的应用程序中自由操作它但建议去掉此接口

Result := pMem;

end;

function HookHandler(iCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; export;

begin

Result := ;

If iCode $#@;

Then Result := CallNextHookEx(NextHook iCode wParam lParam);

// This is probably closer to what you would want to do

Case wparam of

WM_LBUTTONDOWN:

begin

end;

WM_LBUTTONUP:

begin

end;

WM_LBUTTONDBLCLK:

begin

end;

WM_RBUTTONDOWN:

begin

messagebeep();

end;

WM_RBUTTONUP:

begin

end;

WM_RBUTTONDBLCLK:

begin

end;

WM_MBUTTONDOWN:

begin

end;

WM_MBUTTONUP:

begin

end;

WM_MBUTTONDBLCLK:

begin

end;

WM_NCMouseMove WM_MOUSEMOVE:

begin

mydata(pmem^)data:=pMOUSEHOOKSTRUCT(lparam)^;

// messagebeep();

//SendMessage(DataBuf(pMem^)[]DataBuf(pMem^)[]wParamlParam );

SendMessage(mydata(pMem^)data[]mydata(pMem^)data[]wParaminteger(@(mydata(pmem^)data)) );

end;

end; //发送消息

end;

function OpenGetKeyHook(sender : HWND;MessageID : WORD) : BOOL; export;

begin

Result := False;

if NextHook $#@;$#@; then Exit; //已经安装了本钩子

// DataBuf(pMem^)[] := Sender; //填数据区

// DataBuf(pMem^)[] := MessageID; //填数据区

mydata(pmem^)data[]:=sender;

mydata(pmem^)data[]:=messageid;

NextHook := SetWindowsHookEx(WH_mouse HookHandler Hinstance );

Result := NextHook $#@;$#@; ;

end;

function CloseGetKeyHook: BOOL; export;

begin

if NextHook $#@;$#@; then

begin

UnhookWindowshookEx(NextHook); //把钩子链链接到下一个钩子处理上

NextHook := ;

end;

Result := NextHook = ;

end;

end

第三步测试DLL建一PROJECT关键在于override WndProc

unit Unit;

interface

uses

Windows Messages SysUtils Classes Graphics Controls Forms Dialogs

StdCtrls ExtCtrls;

type

TForm = class(Tform)

uncapture: Tbutton;

capture: Tbutton;

Exit: Tbutton;

Panel: Tpanel;

show: Tlabel;

Label: Tlabel;

counter: Tlabel;

procedure ExitClick(Sender: Tobject);

procedure uncaptureClick(Sender: Tobject);

procedure captureClick(Sender: Tobject);

private

{ Private declarations }

public

{ Public declarations }

procedure WndProc(var Message: Tmessage); override;

end;

var

Form: TForm;

var num : integer;

const MessageID = WM_User + ;

implementation

{$R *DFM}

function OpenGetKeyHook(sender : HWND;MessageID : WORD) : BOOL; external GetKeyDLL;

function CloseGetKeyHook: BOOL; external GetKeyDLL;

procedure TFormExitClick(Sender: Tobject);

begin

close;

end;

procedure TFormuncaptureClick(Sender: Tobject);

begin

if CloseGetKeyHook then //ShowMessage(结束记录);

showcaption:=结束记录;

end;

procedure TFormcaptureClick(Sender: Tobject);

begin

// if OpenGetKeyHook(selfHandleMessageID) then ShowMessage(开始记录);

if OpenGetKeyHook(FormHandleMessageID) then

//ShowMessage(开始记录);

showcaption:=开始记录;

num := ;

end;

procedure TFormWndProc(var Message: Tmessage);

var xy:integer;

begin

if MessageMsg = MessageID then

begin

// PanelCaption := IntToStr(Num);

x:=PMouseHookStruct( messagelparam)^ptx ;

y:=PMouseHookStruct( messagelparam)^pty ;

panelcaption:=x=+inttostr(x)+ y=+inttostr(y);

inc(Num);

counterCaption := IntToStr(Num);

end

else Inherited;

end;

end

上一篇：通过实例看VCL组件开发全过程（三）

下一篇：经典案例 财务管理系统（4）