Advertisement
sglienke

MouseWheelHook

Jun 22nd, 2016
154
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit MouseWheelHook;
  2.  
  3. interface
  4.  
  5. implementation
  6.  
  7. uses
  8.   Classes, Controls, Dialogs, Forms, Messages, Windows;
  9.  
  10. var
  11.   mouseHookHandle: HHOOK;
  12.  
  13. type
  14.   TWinControlAccess = class(TWinControl);
  15.  
  16. function DoCtrlMouseWheel(ctrl: TWinControl; delta: Integer; p: TPoint): Boolean;
  17. var
  18.   keyState: TKeyboardState;
  19.   shiftState: TShiftState;
  20. begin
  21.   GetKeyboardState(keyState);
  22.   shiftState := KeyboardStateToShiftState(keyState);
  23.   Result := TWinControlAccess(ctrl).DoMouseWheel(shiftState, delta, p);
  24. end;
  25.  
  26. function MouseHookProc(code: Integer; messageId: WPARAM; msgData: LPARAM): LRESULT stdcall;
  27. var
  28.   msgStruct: TMouseHookStructEx;
  29.   p: TPoint;
  30.   ctrl: TWinControl;
  31.   delta: Integer;
  32. begin
  33.   if (Code >= 0) and (messageId = WM_MOUSEWHEEL) then
  34.   begin
  35.     msgStruct := PMouseHookStructEx(msgData)^;
  36.     p := msgStruct.MouseHookStruct.pt;
  37.     ctrl := FindVCLWindow(p);
  38.     if ctrl <> nil then
  39.     begin
  40.       delta := SmallInt(msgStruct.mouseData shr 16);
  41.  
  42.       if DoCtrlMouseWheel(ctrl, delta, p) then
  43.         Exit(1);
  44.     end;
  45.   end;
  46.  
  47.   Result := CallNextHookEx(mouseHookHandle, code, messageId, msgData);
  48. end;
  49.  
  50. initialization
  51.   mouseHookHandle := SetWindowsHookEx(WH_MOUSE, @MouseHookProc, HInstance, GetCurrentThreadId);
  52.  
  53. finalization
  54.   if mouseHookHandle <> 0 then
  55.     UnhookWindowsHookEx(mouseHookHandle)
  56.  
  57. end.
Advertisement
RAW Paste Data Copied
Advertisement