I have accepted the answer above, but my final version of this implementation is quite different. I thought I'd share what I came up with, as implementing a unique mouse hook multiple times was a little tricky.
Now the demonstration bummi provided was fixed and built-in to the form's unit. I created a new unit and wrapped everything in there. The tricky part was that the function LowLevelMouseProc cannot be part of the class. Yet, within this function, it makes a call specific to the hook handle (Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);). So what I did was created a bucket (TList) where I dump every instance of my mouse object. When this function is called, it iterates through this bucket and triggers the appropriate events of each instance. This model also includes built-in thread-safe protection (untested).
Here's the full unit:
JD.Mouse.pas
unit JD.Mouse;
interface
uses
Windows, Classes, SysUtils, Messages, Controls;
type
TJDMouseButtonPoints = Array[TMouseButton] of TPoint;
TJDMouseButtonStates = Array[TMouseButton] of Boolean;
TJDMouse = class(TComponent)
private
FOnButtonUp: TMouseEvent;
FOnMove: TMouseMoveEvent;
FOnButtonDown: TMouseEvent;
FButtonPoints: TJDMouseButtonPoints;
FButtonStates: TJDMouseButtonStates;
procedure SetCursorPos(const Value: TPoint);
function GetCursorPos: TPoint;
procedure DoButtonDown(const IsDown: Boolean; const Button: TMouseButton;
const Shift: TShiftState; const X, Y: Integer);
procedure DoMove(const Shift: TShiftState; const X, Y: Integer);
public
constructor Create(AOwner: TComponent);
destructor Destroy; override;
published
property CursorPos: TPoint read GetCursorPos write SetCursorPos;
property OnButtonDown: TMouseEvent read FOnButtonDown write FOnButtonDown;
property OnButtonUp: TMouseEvent read FOnButtonUp write FOnButtonUp;
property OnMove: TMouseMoveEvent read FOnMove write FOnMove;
end;
implementation
var
_Hook: Cardinal;
_Bucket: TList;
_Lock: TRTLCriticalSection;
procedure LockMouse;
begin
EnterCriticalSection(_Lock);
end;
procedure UnlockMouse;
begin
LeaveCriticalSection(_Lock);
end;
type
tagMSLLHOOKSTRUCT = record
POINT: TPoint;
mouseData: DWORD;
flags: DWORD;
time: DWORD;
dwExtraInfo: DWORD;
end;
TMSLLHOOKSTRUCT = tagMSLLHOOKSTRUCT;
PMSLLHOOKSTRUCT = ^TMSLLHOOKSTRUCT;
function LowLevelMouseProc(nCode: Integer; wParam: wParam; lParam: lParam): LRESULT; stdcall;
var
X: Integer;
Delta: Smallint;
M: TJDMouse;
P: TPoint;
Shift: TShiftState;
begin
if (nCode >= 0) then begin
LockMouse;
try
Delta := PMSLLHOOKSTRUCT(lParam)^.mouseData shr 16;
try
for X := 0 to _Bucket.Count - 1 do begin
try
M:= TJDMouse(_Bucket[X]);
P:= Controls.Mouse.CursorPos;
//Shift:= .....; //TODO
case wParam of
WM_LBUTTONDOWN: begin
M.DoButtonDown(True, mbLeft, Shift, P.X, P.Y);
end;
WM_LBUTTONUP: begin
M.DoButtonDown(False, mbLeft, Shift, P.X, P.Y);
end;
WM_RBUTTONDOWN: begin
M.DoButtonDown(True, mbRight, Shift, P.X, P.Y);
end;
WM_RBUTTONUP: begin
M.DoButtonDown(False, mbRight, Shift, P.X, P.Y);
end;
WM_MBUTTONDOWN: begin
M.DoButtonDown(True, mbMiddle, Shift, P.X, P.Y);
end;
WM_MBUTTONUP: begin
M.DoButtonDown(False, mbMiddle, Shift, P.X, P.Y);
end;
WM_MOUSEMOVE: begin
M.DoMove(Shift, P.X, P.Y);
end;
WM_MOUSEWHEEL: begin
//TODO
end;
WM_MOUSEHWHEEL: begin
//TODO
end;
end;
except
on e: exception do begin
//TODO
end;
end;
end;
except
on e: exception do begin
//TODO
end;
end;
finally
UnlockMouse;
end;
end;
Result:= CallNextHookEx(_Hook, nCode, wParam, lParam);
end;
{ TJDMouse }
constructor TJDMouse.Create(AOwner: TComponent);
begin
LockMouse;
try
_Bucket.Add(Self); //Add self to bucket, registering to get events
finally
UnlockMouse;
end;
end;
destructor TJDMouse.Destroy;
begin
LockMouse;
try
_Bucket.Delete(_Bucket.IndexOf(Self)); //Remove self from bucket
finally
UnlockMouse;
end;
inherited;
end;
procedure TJDMouse.DoButtonDown(const IsDown: Boolean;
const Button: TMouseButton; const Shift: TShiftState; const X, Y: Integer);
begin
//Do not use lock, this is called from the lock already
if IsDown then begin
if assigned(FOnButtonDown) then
FOnButtonDown(Self, Button, Shift, X, Y);
end else begin
if assigned(FOnButtonUp) then
FOnButtonUp(Self, Button, Shift, X, Y);
end;
end;
procedure TJDMouse.DoMove(const Shift: TShiftState; const X, Y: Integer);
begin
//Do not use lock, this is called from the lock already
if assigned(FOnMove) then
FOnMove(Self, Shift, X, Y);
end;
function TJDMouse.GetCursorPos: TPoint;
begin
LockMouse;
try
Result:= Controls.Mouse.CursorPos;
finally
UnlockMouse;
end;
end;
procedure TJDMouse.SetCursorPos(const Value: TPoint);
begin
LockMouse;
try
Controls.Mouse.CursorPos:= Value;
finally
UnlockMouse;
end;
end;
initialization
InitializeCriticalSection(_Lock);
_Bucket:= TList.Create;
_Hook:= SetWindowsHookEx(WH_MOUSE_LL, @LowLevelMouseProc, hInstance, 0);
finalization
UnhookWindowsHookEx(_Hook);
_Bucket.Free;
DeleteCriticalSection(_Lock);
end.
And here's how it's implemented:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FMouse: TJDMouse;
procedure MouseButtonDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MouseButtonUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MouseMoved(Sender: TObject; Shift: TShiftState; X, Y: Integer);
end;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
FMouse:= TJDMouse.Create(nil);
FMouse.OnButtonDown:= MouseButtonDown;
FMouse.OnButtonUp:= MouseButtonUp;
FMouse.OnMove:= MouseMoved;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FMouse.Free;
end;
procedure TForm1.MouseButtonDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
end;
procedure TForm1.MouseButtonUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
end;
procedure TForm1.MouseMoved(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
end;
end.
https://stackoverflow.com/questions/13345655
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
Russian