Option Explicit
Private 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
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Const GWL_WNDPROC = -4
Private Const WM_MouseWheel = &H20A
Private hWnd_UserForm As Long
Private lngWndProc As Long
'this traps the mousewheel scroll message as it's sent to your form by Wiindows,
'then it calls the procedure in the form's code module in order to scroll the list
Private Function WindowProc(ByVal lWnd As Long, ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim MouseKeys As Long
Dim Rotation As Long
If lMsg = WM_MouseWheel Then
MouseKeys = wParam And 65535
Rotation = wParam / 65536
'you will have to replace "UserForm1" in the following line, with the name of your form ;-)
UserForm1.ComboBox1_MouseWheel Rotation
End If
WindowProc = CallWindowProc(lngWndProc, lWnd, lMsg, wParam, lParam)
End Function
Public Sub WheelHook(ClientForm As UserForm)
hWnd_UserForm = FindWindow("ThunderDFrame", ClientForm.Caption)
lngWndProc = SetWindowLong(hWnd_UserForm, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub WheelUnHook()
Dim lRet As Long
lRet = SetWindowLong(hWnd_UserForm, GWL_WNDPROC, lngWndProc)
End Sub
