在應用程序中跟蹤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

From:http://tw.wingwit.com/Article/program/Delphi/201311/24762.html