魅族官网专卖店地址:使用钩子函数[6] - 数据传递

　　为了方便测试, 提供一个源码下载吧: http://files.cnblogs.com/del/MouseHook_2.rar

　　本例效果图(和上一例是一样的):

　　DLL 文件:

library　MyHook;

uses
　SysUtils,
　Windows,
　Messages,
　Classes;

{$R　*.res}

const　WM_MyMessage　=　WM_USER　+　1;　{自定义消息}

var
　hook:　HHOOK;
　info:　string;
　h:　HWND;　{用作外部窗口的句柄}

{获取外部窗口的句柄}
function　SetHWnd(hwnd:　HWND):　Boolean;　stdcall;
begin
　h　:=　hwnd;
　Result　:=　True;
end;

function　MouseHook(nCode:　Integer;　wParam:　WPARAM;　lParam:　LPARAM):　LRESULT;　stdcall;
begin
　case　wParam　of
　　WM_MOUSEMOVE　　:　info　:=　'鼠标位置';
　　WM_LBUTTONDOWN　:　info　:=　'按下';
　　WM_LBUTTONUp　　:　info　:=　'放开';
　end;
　info　:=　Format('%s:　%d,%d',　[info,　PMouseHookStruct(lParam)^.pt.X,　PMouseHookStruct(lParam)^.pt.Y]);

　{通过消息把数据传递给指定窗口}
　PostMessage(h,　WM_MyMessage,　0,　Integer(PChar(info)));

　Result　:=　CallNextHookEx(hook,　nCode,　wParam,　lParam);
end;

function　SetHook:　Boolean;　stdcall;
const
　WH_MOUSE_LL　=14;
begin
　hook　:=　SetWindowsHookEx(WH_MOUSE_LL,　@MouseHook,　HInstance,　0);
　Result　:=　hook　<>　0;
end;

function　DelHook:　Boolean;　stdcall;
begin
　Result　:=　UnhookWindowsHookEx(hook);
end;

exports　SetHook,　DelHook,　MouseHook,　SetHWnd;
begin
end.

　　测试代码:

unit　Unit1;

interface

uses
　Windows,　Messages,　SysUtils,　Variants,　Classes,　Graphics,　Controls,　Forms,
　Dialogs,　StdCtrls,　ExtCtrls;

const　WM_MyMessage　=　WM_USER　+　1;

type
　TForm1　=　class(TForm)
　　Button1:　TButton;
　　Button2:　TButton;
　　procedure　FormCreate(Sender:　TObject);
　　procedure　Button1Click(Sender:　TObject);
　　procedure　Button2Click(Sender:　TObject);
　　procedure　FormDestroy(Sender:　TObject);
　　procedure　MyMessage(var　msg:　TMessage);　message　WM_MyMessage;　{定义一个消息方法接受消息}
　end;

　function　SetHook:　Boolean;　stdcall;
　function　DelHook:　Boolean;　stdcall;
　function　SetHWnd(hwnd:　HWND):　Boolean;　stdcall;

var
　Form1:　TForm1;

implementation

{$R　*.dfm}

function　SetHook;　external　'MyHook.dll';
function　DelHook;　external　'MyHook.dll';
function　SetHWnd;　external　'MyHook.dll';

procedure　TForm1.Button1Click(Sender:　TObject);
begin
　SetHook;
　SetHWnd(Handle);
end;

procedure　TForm1.Button2Click(Sender:　TObject);
begin
　DelHook;
end;

procedure　TForm1.FormCreate(Sender:　TObject);
begin
　Button1.Caption　:=　'安装钩子';
　Button2.Caption　:=　'载卸钩子';
　FormStyle　:=　fsStayOnTop;　{为了测试,　让窗口一直在前面}
end;

procedure　TForm1.FormDestroy(Sender:　TObject);
begin
　DelHook;
end;

{把接受到的内容显示在窗体}
procedure　TForm1.MyMessage(var　msg:　TMessage);
begin
　Text　:=　PChar(msg.LParam);
end;

end.

　　测试窗体:

object　Form1:　TForm1
　Left　=　0
　Top　=　0
　Caption　=　'Form1'
　ClientHeight　=　78
　ClientWidth　=　271
　Color　=　clBtnFace
　Font.Charset　=　DEFAULT_CHARSET
　Font.Color　=　clWindowText
　Font.Height　=　-11
　Font.Name　=　'Tahoma'
　Font.Style　=　[]
　OldCreateOrder　=　False
　OnCreate　=　FormCreate
　OnDestroy　=　FormDestroy
　PixelsPerInch　=　96
　TextHeight　=　13
　object　Button1:　TButton
　　Left　=　48
　　Top　=　32
　　Width　=　75
　　Height　=　25
　　Caption　=　'Button1'
　　TabOrder　=　0
　　OnClick　=　Button1Click
　end
　object　Button2:　TButton
　　Left　=　144
　　Top　=　32
　　Width　=　75
　　Height　=　25
　　Caption　=　'Button2'
　　TabOrder　=　1
　　OnClick　=　Button2Click
　end
end