unit Unit1;
(*
Getting Pixel coordinate and color under mouse cursor routine plus mousehook, rewritten by KodeZwerg
used Resources for hook
https://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-msllhookstruct
https://learn.microsoft.com/en-us/previous-versions/windows/desktop/legacy/ms644986(v=vs.85)
https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-setwindowshookexw
https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-callnexthookex
https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-unhookwindowshookex
used Resources for GetPixel
https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-createdcw
https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-getpixel
https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-deletedc
*)
{$mode objfpc}{$H+}
interface
uses
Windows, // hooks with windows api
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
strict private
private
public
end;
type
// structure for pixel information
TMyPixel = packed record
R, G, B : Byte;
X, Y : LongInt;
Color : TColor;
end;
// structure for low level mouse events
TMSLLHOOKSTRUCT = record
pt : TPoint;
mouseData : DWORD;
flags : DWORD;
time : DWORD;
dwExtraInfo : ULONG_PTR;
end;
PMSLLHOOKSTRUCT = ^TMSLLHOOKSTRUCT;
// mouse hook message handler
function LowLevelMouseProc(nCode: LongInt; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall;
// get pixel informations
function MyGetPixel(const X, Y: LongInt; var MyPixel: TMyPixel): Boolean;
var
Form1: TForm1;
mHook: HHOOK; // the hook, if 0 or -1 then its garbage
implementation
{$R *.lfm}
function LowLevelMouseProc(nCode: LongInt; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall;
var
msLL: PMSLLHOOKSTRUCT absolute lParam;
Pixel : TMyPixel;
begin
if ((mHook = 0) or (mHook = INVALID_HANDLE_VALUE)) then
Exit(0);
Result := CallNextHookEx(mHook, nCode, wParam, lParam);
with msLL^ do
begin
// react on mouse messages
case wParam of
WM_MOUSEMOVE : if MyGetPixel(pt.X, pt.Y, Pixel) then
begin
Form1.Label1.Caption := Format('X: %d - Y: %d', [Pixel.X, Pixel.Y]);
Form1.Label2.Caption := Format('R: %d - G: %d - B: %d - Color: %d', [Pixel.R, Pixel.G, Pixel.B, Pixel.Color]);
end;
WM_LBUTTONDOWN : Form1.Label6.Caption := 'WM_LBUTTONDOWN pressed';
WM_LBUTTONUP : begin
if MyGetPixel(pt.X, pt.Y, Pixel) then
begin
Form1.Label3.Caption := Format('X: %d - Y: %d', [Pixel.X, Pixel.Y]);
Form1.Label4.Caption := Format('R: %d - G: %d - B: %d - Color: %d', [Pixel.R, Pixel.G, Pixel.B, Pixel.Color]);
end;
Form1.Label6.Caption := 'WM_LBUTTONUP pressed';
end;
WM_MBUTTONDOWN : Form1.Label6.Caption := 'WM_MBUTTONDOWN pressed';
WM_MBUTTONUP : Form1.Label6.Caption := 'WM_MBUTTONUP pressed';
WM_RBUTTONDOWN : Form1.Label6.Caption := 'WM_RBUTTONDOWN pressed';
WM_RBUTTONUP : Form1.Label6.Caption := 'WM_RBUTTONUP pressed';
WM_MOUSEWHEEL : if (SmallInt(HiWord(mouseData)) >= 0) then // positive = away from user, negativ = toward to user
Form1.Label6.Caption := 'WM_MOUSEWHEEL (up) triggered'
else
Form1.Label6.Caption := 'WM_MOUSEWHEEL (down) triggered';
WM_XBUTTONDOWN : if (HiWord(mouseData) = 1) then // 1 = xbutton1, 2 = xbutton2
Form1.Label6.Caption := 'WM_XBUTTONDOWN (down) pressed'
else
Form1.Label6.Caption := 'WM_XBUTTONDOWN (up) pressed';
WM_XBUTTONUP : if (HiWord(mouseData) = 1) then // 1 = xbutton1, 2 = xbutton2
Form1.Label6.Caption := 'WM_XBUTTONUP (down) pressed'
else
Form1.Label6.Caption := 'WM_XBUTTONUP (up) pressed';
else
Form1.Label6.Caption := 'Unknown mouse event! (' + IntToStr(wParam) + ')'; // here you can identify more stuff
end;
end;
end;
function MyGetPixel(const X, Y: LongInt; var MyPixel: TMyPixel): Boolean;
var
DC : HDC;
begin
DC := Windows.CreateDCW(PWideChar('DISPLAY'), nil, nil, nil);
if ((DC = 0) or (DC = INVALID_HANDLE_VALUE)) then
Exit(False);
MyPixel.X := X;
MyPixel.Y := Y;
MyPixel.Color := Windows.GetPixel(DC, X, Y);
MyPixel.R := MyPixel.Color and $000000FF;
MyPixel.G := (MyPixel.Color shr 8) and $000000FF;
MyPixel.B := (MyPixel.Color shr 16) and $000000FF;
Result := Windows.DeleteDC(DC);
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
const
LWH_MOUSE_LL = LongInt(14); // 14 = low level mouse messages
begin
// setup hook
mHook := SetWindowsHookExW(LWH_MOUSE_LL, @LowLevelMouseProc, hInstance, 0);
if ((mHook = 0) or (mHook = INVALID_HANDLE_VALUE)) then
ShowMessage('Problem during Hook install!' + sLineBreak +
'Error: ' + SysErrorMessage(GetLastError));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
// release hook
if ((mHook <> 0) and (mHook <> INVALID_HANDLE_VALUE)) then
if (not UnhookWindowsHookEx(mHook)) then
ShowMessage('Problem during Hook uninstall!' + sLineBreak +
'Error: ' + SysErrorMessage(GetLastError));
end;
end.
Recent
