Have in .bas the fixed reference for one msflexgrid, in my case msflexgrid1.
My friend who gave me the code, suggest me to change for dinamic reference of each msflexgrid, the param:
lParam
in the .bas, but not have idea.
in effect in have more msflexgrid for example:
msflexgrid1 and msflexgrid2 .... msflexgridxx
Code: Select all
Option Explicit
Private Sub Form_Load()
HookMWheel Me.hWnd '
End Sub
' Always exit via form's close button, else you will leave
' an unterminbated hook in place, which
' will generally crash VB to desktop
Private Sub Form_Unload(Cancel As Integer)
UnHookMWheel Me.hWnd
End Sub
Code: Select all
Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" 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 Const GWL_WNDPROC = (-4)
Private Const WM_MOUSEWHEEL = &H20A
Private hOldWheelProc As Long
Private Type vbWParam
Hiword As Long
Loword As Long
End Type
Public Sub HookMWheel(ParentWnd As Long)
If hOldWheelProc <> 0 Then Exit Sub
hOldWheelProc = GetWindowLong(ParentWnd, GWL_WNDPROC)
SetWindowLong ParentWnd, GWL_WNDPROC, AddressOf MWheelProc
End Sub
Public Sub UnHookMWheel(ParentWnd As Long)
If hOldWheelProc = 0 Then Exit Sub
SetWindowLong ParentWnd, GWL_WNDPROC, hOldWheelProc
End Sub
' Warning: any bugs in here, or attempts at debugging whilst in this function will at best casue
' unpredictable behaviour from Windows, and mostly hard crash VB.
Private Function MWheelProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim myWParam As vbWParam
' One of several methods to extract Hi- and lo-words from WParam
myWParam.Hiword = wParam / &H10000
myWParam.Loword = wParam And &HFFFF
Select Case wMsg
Case WM_MOUSEWHEEL ' Ah, the mouswheel is in use
' This is where you'd control the scroll of the flexgrid, assuming you are over the flexgrid when this event happens
' e.g. check coords held in lParam against flexgrid
Select Case Sgn(myWParam.Hiword)
Case 1: Debug.Print "Scroll up":
'If Form1.MSFlexGrid1.TopRow > 1 Then Form1.MSFlexGrid1.TopRow = Form1.MSFlexGrid1.TopRow - 1
Case -1: Debug.Print "Scroll down"
'Form1.MSFlexGrid1.TopRow = Form1.MSFlexGrid1.TopRow + 1
End Select
Case Else
MWheelProc = CallWindowProc(hOldWheelProc, hWnd, wMsg, wParam, lParam)
End Select
End Function