这要用到鼠标hook,我有一个很详细的例子能实现你要的功能,
先把Hookdll.dpr的工程编译生成DLL
Hookdll.dpr
---------------------------
library HookDLL;
uses WinTypes, WinProcs, Messages;
{ Global variables }
{$IFDEF WIN32}
{ For a system-wide hook, global variables must be Memory Mapped to be
accessible by all processes because the data segment of 32-bit DLL is private
to each process using it. }
type
PSharedData = ^TSharedData;
TSharedData = record
{ In this record, mirror the global variables of the 16-bit version }
HookCount: integer;
HookHandle: HHook;
MonitorWnd: HWND;
WM_MONITORMOUSEMOVE: UINT;
end;
var
{ global data for the DLL for a single process }
hMapObject: THandle;
SharedData: PSharedData;
{$ELSE}
{ 16 bit Windows }
type
UINT = Longint;
var
HookCount: integer;
HookHandle: HHook;
MonitorWnd: HWND;
WM_MONITORMOUSEMOVE: UINT;
{$ENDIF}
const
MESSAGE_MONITOR_MOUSE_MOVE = 'DFSHookDLLMonitorMouseMoveMessage';
function GetMonitorMouseMoveMsg: UINT; export;
begin
{$IFDEF WIN32}
if SharedData = NIL then
Result := 0
else
Result := SharedData^.WM_MONITORMOUSEMOVE;
{$ELSE}
Result := WM_MONITORMOUSEMOVE;
{$ENDIF}
end;
{ This is where you do your special processing. }
{$IFDEF WIN32}
function MouseHookCallBack(Code: integer; Msg: WPARAM; MouseHook: LPARAM): LRESULT; stdcall;
{$ELSE}
function MouseHookCallBack(Code: integer; Msg: word; MouseHook: longint): longint; export;
{$ENDIF}
var
{$IFDEF WIN32}
HookHandle: HHOOK;
MonitorWnd: HWND;
WM_MONITORMOUSEMOVE: UINT;
{$ENDIF}
MouseHookStruct: PMouseHookStruct absolute MouseHook;
begin
{$IFDEF WIN32}
{ Access the shared data. Do check if SharedData is assigned, because under
some circumstances the hook filter can be called after all processes have
detached }
if SharedData <> NIL then
begin
MonitorWnd := SharedData^.MonitorWnd;
HookHandle := SharedData^.HookHandle;
WM_MONITORMOUSEMOVE := SharedData^.WM_MONITORMOUSEMOVE;
end
else
begin
WM_MONITORMOUSEMOVE := 0;
MonitorWnd := 0;
HookHandle := 0; { It seems that this handle is not used in the CallNextHookEx
function anyway. Several sources on the microsoft web site
indicate this. }
end;
{$ENDIF}
{ If the value of Code is less than 0, we are not allowed to do anything }
{ except pass it on to the next hook procedure immediately. }
if (Code >= 0) and (MonitorWnd <> 0) then
begin
{ This example sends the coordinates of all mouse move messages to the
monitoring app (the one that installed the hook). }
if (Msg = WM_MOUSEMOVE) and (MouseHookStruct <> NIL) then
PostMessage(MonitorWnd, WM_MONITORMOUSEMOVE, MouseHookStruct^.pt.x,
MouseHookStruct^.pt.y);
{ You could do any number of things here based on the different mouse
messages...
case Msg of:
WM_LBUTTONDOWN:
begin
end;
WM_LBUTTONUP:
begin
end;
WM_LBUTTONDBLCLK:
begin
end;
WM_RBUTTONDOWN:
begin
end;
WM_RBUTTONUP:
begin
end;
WM_RBUTTONDBLCLK:
begin
end;
WM_MBUTTONDOWN:
begin
end;
WM_MBUTTONUP:
begin
end;
WM_MBUTTONDBLCLK:
begin
end;
WM_MOUSEMOVE:
begin
end;
end;}
{ If you handled the situation, and don't want Windows to process the }
{ message, do *NOT* execute the next line. Be very sure this is what }
{ want, though. If you don't pass on stuff like WM_MOUSEMOVE, you }
{ will NOT like the results you get. }
Result := CallNextHookEx(HookHandle, Code, Msg, MouseHook);
end
else
Result := CallNextHookEx(HookHandle, Code, Msg, MouseHook);
end;
{ Call InstallHook to set the hook. }
function InstallHook(SystemHook: boolean; TaskHandle: THandle;
AMonitorWnd: HWND) : boolean; export;
{ This is really silly, but that's the way it goes. The only way to get the }
{ module handle, *not* instance, is from the filename. The Microsoft example }
{ just hard-codes the DLL filename. I think this is a little bit better. }
function GetModuleHandleFromInstance: THandle;
var
s: array[0..512] of char;
begin
{ Find the DLL filename from the instance value. }
GetModuleFileName(hInstance, s, sizeof(s)-1);
{ Find the handle from the filename. }
Result := GetModuleHandle(s);
end;
begin
{ Technically, this procedure could do nothing but call SetWindowsHookEx(), }
{ but it is probably better to be sure about things, and not set the hook }
{ more than once. You definitely don't want your callback being called more }
{ than once per message, do you? }
{$IFDEF WIN32}
Result := FALSE;
if SharedData = NIL then
exit
else
with SharedData^ do
begin
{$ENDIF}
Result := TRUE;
if HookCount = 0 then
begin
MonitorWnd := AMonitorWnd;
if SystemHook then
HookHandle := SetWindowsHookEx(WH_MOUSE, MouseHookCallBack, HInstance, 0)
else
{ See the Microsoft KnowledgeBase, PSS ID Number: Q92659, for a
discussion of the Windows bug that requires GetModuleHandle() to be
used. }
HookHandle := SetWindowsHookEx(WH_MOUSE, MouseHookCallBack,
GetModuleHandleFromInstance, TaskHandle);
if HookHandle <> 0 then
inc(HookCount)
else
Result := FALSE;
end
else
inc(HookCount);
{$IFDEF WIN32}
end;
{$ENDIF}
end;
{ Call RemoveHook to remove the system hook. }
function RemoveHook: boolean; export;
begin
{ See if our reference count is down to 0, and if so then unhook. }
Result := FALSE;
{$IFDEF WIN32}
if SharedData = NIL then
exit
else
with SharedData^ do
begin
{$ENDIF}
if HookCount < 1 then exit;
Result := TRUE;
dec(HookCount);
if HookCount = 0 then
Result := UnhookWindowsHookEx(HookHandle);
{$IFDEF WIN32}
end;
{$ENDIF}
end;
{ Have we hooked into the system? }
function IsHookSet: boolean; export;
begin
{$IFDEF WIN32}
if SharedData = NIL then
Result := FALSE
else
with SharedData^ do
{$ENDIF}
Result := (HookCount > 0) and (HookHandle <> 0);
end;
{$IFDEF WIN32}
{ Shared data management }
procedure AllocSharedData;
var
Init: boolean;
begin
if hMapObject = 0 then
begin
// Create a named file mapping object.
hMapObject := CreateFileMapping(
THandle($FFFFFFFF), // use paging file
NIL, // no security attributes
PAGE_READWRITE, // read/write access
0, // size: high 32-bits
SizeOf(TSharedData), // size: low 32-bits
'DFSHookDLLSharedDataBlock'); // name of map object, THIS MUST BE UNIQUE!
// The first process to attach initializes memory.
Init := GetLastError <> ERROR_ALREADY_EXISTS;
if hMapObject = 0 then exit;
// Get a pointer to the file-mapped shared memory.
SharedData := MapViewOfFile(
hMapObject, // object to map view of
FILE_MAP_WRITE, // read/write access
0, // high offset: map from
0, // low offset: beginning
0); // default: map entire file
if SharedData = NIL then exit;
// Initialize memory if this is the first process.
if Init then
FillChar(SharedData^, SizeOf(TSharedData), 0);
SharedData^.WM_MONITORMOUSEMOVE := RegisterWindowMessage(
MESSAGE_MONITOR_MOUSE_MOVE);
end;
end;
procedure FreeSharedData;
begin
if hMapObject <> 0 then
try
try
UnMapViewOfFile(SharedData);
CloseHandle(hMapObject);
except
end;
finally
SharedData := NIL;
hMapObject := 0;
end;
end;
procedure EntryPointProc(Reason: Integer);
begin
case Reason of
DLL_PROCESS_DETACH: FreeSharedData;
DLL_PROCESS_ATTACH: AllocSharedData;
DLL_THREAD_ATTACH: {} ;
DLL_THREAD_DETACH: {} ;
end;
end;
{$ENDIF}
exports
GetMonitorMouseMoveMsg,
InstallHook,
RemoveHook,
IsHookSet,
MouseHookCallBack;
{ Initialize DLL data. }
begin
{$IFDEF WIN32}
SharedData := NIL;
hMapObject := 0;
DllProc := @EntryPointProc;
EntryPointProc(DLL_PROCESS_ATTACH); // Must call manually in the Delphi world
{$ELSE}
HookCount := 0;
HookHandle := 0;
WM_MONITORMOUSEMOVE := RegisterWindowMessage(MESSAGE_MONITOR_MOUSE_MOVE);
{$ENDIF}
end.
Hookunit.pas
--------------------------------
{ This is a simple DLL import unit to give us access to the functions in }
{ the HOOKDLL.PAS file. This is the unit your project will use. }
unit Hookunit;
interface
uses WinTypes;
{$IFNDEF WIN32}
type
UINT = Longint;
{$ENDIF}
function GetMonitorMouseMoveMsg: UINT;
function InstallSystemHook(AMonitorWnd: HWND): boolean;
function InstallTaskHook(AMonitorWnd: HWND): boolean;
function RemoveHook: boolean;
function IsHookSet: boolean;
{ Do not use InstallHook directly. Use InstallSystemHook or InstallTaskHook. }
function InstallHook(SystemHook: boolean; TaskHandle: THandle;
AMonitorWnd: HWND): boolean;
implementation
uses WinProcs;
const
{$IFDEF WIN32}
HOOK_DLL = 'HOOKDLL.DLL';
{$ELSE}
HOOK_DLL = 'HOOKDLL';
{$ENDIF}
function GetMonitorMouseMoveMsg: UINT; external HOOK_DLL;
function InstallHook(SystemHook: boolean; TaskHandle: THandle;
AMonitorWnd: HWND): boolean; external HOOK_DLL;
function RemoveHook: boolean; external HOOK_DLL;
function IsHookSet: boolean; external HOOK_DLL;
function InstallSystemHook(AMonitorWnd: HWND): boolean;
begin
Result := InstallHook(TRUE, 0, AMonitorWnd);
end;
function InstallTaskHook(AMonitorWnd: HWND): boolean;
begin
Result := InstallHook(FALSE,
{$IFDEF WIN32}
GetCurrentThreadID,
{$ELSE}
GetCurrentTask,
{$ENDIF}
AMonitorWnd
);
end;
end.
使用是这个hook的主程序
-----------------------------------
unit MainFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TMainForm = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
HandleEdit: TEdit;
ClassEdit: TEdit;
TextEdit: TEdit;
OnTopCheckBox: TCheckBox;
lblMousePos: TLabel;
procedure FormCreate(Sender: TObject);
procedure OnTopCheckBoxClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
procedure WndProc(var Message: TMessage); override;
procedure UpdateMousePosInfo(X, Y: integer);
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
uses Hookunit;
{$R *.DFM}
function GetWorkAreaRect: TRect;
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);
end;
procedure SetStayOnTop(Form: TForm; Value: Boolean);
begin
if Value Then
SetWindowPos(Form.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
else
SetWindowPos(Form.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE);
end;
procedure TMainForm.FormCreate(Sender: TObject);
var
R: TRect;
begin
R := GetWorkAreaRect;
Left := R.Right - Width;
Top := R.Bottom - Height;
SetStayOnTop(Self, True);
// install windows hook
if not InstallSystemHook(Handle) then
ShowMessage('Could not install mouse hook. SetWindowsHookEx() failed.');
end;
procedure TMainForm.OnTopCheckBoxClick(Sender: TObject);
begin
SetStayOnTop(Self, OnTopCheckBox.Checked);
end;
procedure TMainForm.WndProc(var Message: TMessage);
begin
if Message.Msg = GetMonitorMouseMoveMsg then
UpdateMousePosInfo(Message.WParam, Message.LParam)
else
inherited WndProc(Message);
end;
procedure TMainForm.UpdateMousePosInfo(X, Y: integer);
var
Pos1: TPoint;
Handle: HWND;
Buf: array[0..1024] of Char;
begin
lblMousePos.Caption := Format('X = %d, Y = %d', [X, Y]);
pos1.x:=X; pos1.Y:=Y;
Handle := WindowFromPoint(Pos1);
HandleEdit.Text := IntToStr(Handle);
GetClassName(Handle, Buf, 1024);
ClassEdit.Text := Buf;
SendMessage(Handle, WM_GETTEXT, 1024, Integer(@Buf));
TextEdit.Text := Buf;
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
RemoveHook;
end;
end.