Forum > Windows
Extended Mouse Hook Demo by KodeZwerg
KodeZwerg:
Since I have corrected an example from here and showed in this thread, what just covered the left mouse button up event, here is a full example to discuss or freely use.
I hope you like it and it is understandable.
Full Demo Project in attachment, just source I show you here.
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; (*Getting Pixel coordinate and color under mouse cursor routine plus mousehook, rewritten by KodeZwerg used Resources for hookhttps://learn.microsoft.com/en-us/windows/win32/api/winuser/ns-winuser-msllhookstructhttps://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-setwindowshookexwhttps://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-callnexthookexhttps://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-unhookwindowshookexused Resources for GetPixelhttps://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-createdcwhttps://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-getpixelhttps://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 handlerfunction LowLevelMouseProc(nCode: LongInt; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall;// get pixel informationsfunction 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 messagesbegin // 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.
Enjoy!
KodeZwerg:
Small update:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} --- WM_XBUTTONDOWN : case HiWord(mouseData) of 1: Form1.Label6.Caption := 'WM_XBUTTONDOWN (down) pressed'; 2: Form1.Label6.Caption := 'WM_XBUTTONDOWN (up) pressed'; else Form1.Label6.Caption := 'WM_XBUTTONDOWN (' + IntToStr(HiWord(mouseData)) + ') pressed'; end; WM_XBUTTONUP : case HiWord(mouseData) of 1: Form1.Label6.Caption := 'WM_XBUTTONUP (down) pressed'; 2: Form1.Label6.Caption := 'WM_XBUTTONUP (up) pressed'; else Form1.Label6.Caption := 'WM_XBUTTONUP (' + IntToStr(HiWord(mouseData)) + ') pressed'; end;
fabiopesaju:
this works on linux?
Handoko:
No. It has Windows in the uses clause. See the code in the first post, line #24.
KodeZwerg:
--- Quote from: fabiopesaju on December 14, 2022, 02:31:41 pm ---this works on linux?
--- End quote ---
Maybe compiling for Windows OS and running on Linux Wine will work, total untested.
--- Quote from: Handoko on December 14, 2022, 02:33:59 pm ---No. It has Windows in the uses clause. See the code in the first post, line #24.
--- End quote ---
I also was thinking that my first lines speak for themself, I am referring to Microsoft Windows Api pages ::)
If someone has code for other OS, please feel free to add your project in here :-*
Navigation
[0] Message Index
[#] Next page