Mega Code Archive
Global mouse hook on Delphi
<![CDATA[
Title: Global mouse hook on Delphi
Question: How to write global mouse hook which will add functionality to the scroll (middle) button?
Answer:
Hello everyone!
On my primary job I have changed my mouse. At home I have A4Tech optical mouse with a scroll but on my job I have Genius mouse (optical and with a scroll as well). At home I use my scroll also as a middle button and when I press it the window which is under cursor getting minimized. It was easy to achieve this behavior because software which comes with my A4Tech mouse supports this functionality. Another case is my Genius mouse at work. Software which bundled with it does not allow to minimize the window under the cursor when the scroll button is pressed. Pity!
But solution always can be found! I decided to write a global mouse hook on Delphi which will intercept middle (scroll) button click (WM_NCMBUTTONDOWN and WM_MBUTTONDOWN messages), check if any top level window is under the cursor and if yes then minimize that window.
The code is pretty simple.
We need two projects: one - which runs the hook and then kills it; the other - the hook itself (it is supposed to be a DLL because it is a global hook). Nothing difficult (at least if you what is DLL and how to use them)!
Here is the mouse hook (WH_MOUSE) implementation:
library MiddleButton;
uses
Windows,
Messages;
const
MemMapFile = 'Igor_thief';
type
PDLLGlobal = ^TDLLGlobal;
TDLLGlobal = packed record
HookHandle: HHOOK;
end;
var
GlobalData: PDLLGlobal;
MMF: THandle;
{$R *.res}
function HookProc(Code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
CurrWND: THandle;
begin
if Code begin
Result := CallNextHookEx(GlobalData^.HookHandle, Code, wParam, lParam);
exit;
end; // if
if (wParam = WM_NCMBUTTONDOWN) or (wParam = WM_MBUTTONDOWN) then
begin
CurrWND := PMouseHookStruct(lParam)^.hwnd;
CurrWND := GetAncestor(CurrWND, GA_ROOTOWNER);
SendMessage(CurrWND, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end; // if
Result := CallNextHookEx(GlobalData^.HookHandle, Code, wParam, lParam);
end;
procedure CreateGlobalHeap;
begin
MMF:= CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0,
SizeOf(TDLLGlobal), MemMapFile);
if MMF = 0 then begin
MessageBox(0, 'CreateFileMapping -', '', 0);
exit;
end;
GlobalData:= MapViewOfFile(MMF, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TDLLGlobal));
if GlobalData = nil then begin
//
CloseHandle(MMF);
MessageBox(0, 'MapViewOfFile -', '', 0);
end;
end;
procedure DeleteGlobalHeap;
begin
if GlobalDatanil then
UnmapViewOfFile(GlobalData);
if MMF INVALID_HANDLE_VALUE then
CloseHandle(MMF);
end;
procedure RunHook; stdcall;
begin
GlobalData^.HookHandle:= SetWindowsHookEx(WH_MOUSE, @HookProc, HInstance, 0);
if GlobalData^.HookHandle = INVALID_HANDLE_VALUE then
begin
MessageBox(0, 'Error :)' , '' , MB_OK);
Exit;
end;
end;
procedure KillHook; stdcall;
begin
if (GlobalDatanil) and (GlobalData^.HookHandleINVALID_HANDLE_VALUE) then
UnhookWindowsHookEx(GlobalData^.HookHandle);
end;
procedure DLLEntry(dwReason: DWORD);
begin
case dwReason of
DLL_PROCESS_ATTACH: CreateGlobalHeap;
DLL_PROCESS_DETACH: DeleteGlobalHeap;
end;
end;
exports
KillHook,
RunHook;
begin
DLLProc:= @DLLEntry;
DLLEntry(DLL_PROCESS_ATTACH);
end.
And here is an implementation of the hook launcher:
unit RunMiddleButton;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
type
TfrmMain = class(TForm)
btnRunHook: TButton;
btnKillHook: TButton;
procedure btnRunHookClick(Sender: TObject);
procedure btnKillHookClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure RunHook; stdcall; external 'MiddleButton.dll' name 'RunHook';
procedure KillHook; stdcall; external 'MiddleButton.dll' name 'KillHook';
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
procedure TfrmMain.btnRunHookClick(Sender: TObject);
begin
RunHook;
end;
procedure TfrmMain.btnKillHookClick(Sender: TObject);
begin
KillHook;
end;
end.
If you don't know what is HOOK and how it works at all then you shoulf go and read MSDN.
Good luck! Study hard!
--
http://delphigeek.blogspot.com
]]>