modMouseWheel.basPrivate Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (_ ByVal lpPrevWndFunc As Long, _ ByVal hWnd As Long, _ ByVal Msg As Long, _ ByVal Wparam As Long, _ ByVal Lparam As Long) As Long
Private declare function setwindowlong lib "user32.dll" alias "setwindowlonga" (_ byval hwnd as long, _ byval nindex as long, _ byval dwnewlong as long) As long
Public Const MK_CONTROL = & H8Public Const MK_LBUTTON = & H1Public Const MK_RBUTTON = & H2Public Const MK_MBUTTON = & H10Public Const MK_SHIFT = & H4Private Const GWL_WNDPROC = -4Private Const WM_MOUSEWHEEL = & H20A
DIM LOCALHWND AS LONGDIM LOCALPREVWNDPROC AS LONGDIM MyFORM AS FORM
Private function windowProc (Byval LWND As Long, Byval WParam As Long, Byval LParam as long) As long
DIM MOMSEKEYS AS Long Dim Rotation As Long Dim Xpos AS Long Dim Ypos AS LONG
If Lmsg = WM_MOUSEWHEEL Then MouseKeys = Wparam And 65535 Rotation = Wparam / 65536 Xpos = Lparam And 65535 Ypos = Lparam / 65536 MyForm.MouseWheel MouseKeys, Rotation, Xpos, Ypos End If WindowProc = CallWindowProc (LocalPrevWndProc, Lwnd, Lmsg, Wparam, Lparam ) End FunctionPublic Sub Wheelhook (PassedForm as Form)
ON Error ResMe next
Set MyForm = PassedForm LocalHwnd = PassedForm.hWnd LocalPrevWndProc = SetWindowLong (LocalHwnd, GWL_WNDPROC, AddressOf WindowProc) End SubPublic Sub WheelUnHook () Dim WorkFlag As LongOn Error Resume Next WorkFlag = SetWindowLong (LocalHwnd, GWL_WNDPROC, LocalPrevWndProc) Set MyForm = NothingEnd SubAdd MsFlexGrid1 to Form1 and code Belowprivate Sub Form_Load () Call Wheelhook (Form1) End Sub
Private Sub Form_Unload (Cancel As Integer) Call WheelUnHookEnd SubPublic Sub MouseWheel (ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long) Dim NewValue As Long Dim Lstep As Single
ON Error ResMe next
