Bloody Mousheel - Nearly done, still not perfect. Please help!

[ice & fire]

Hi folks!
Sorry for bothering you all the time with that bloody Mouswheel:

I have that Code in a module:

Option Explicit
 
'API Constants
Public Const WH_MOUSE As Long = 7
 
'API Declarations
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
'Global mouse function callback handles
Public g_hMouseHook As Long
Public Const WM_MOUSEWHEEL = &H20A
 
Public Function MouseProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    'Mouse Function Hook...
    If idHook < 0 Then
        MouseProc = CallNextHookEx(g_hMouseHook, idHook, wParam, ByVal lParam)
    Else
        If wParam = WM_MOUSEWHEEL Then
            Debug.Print idHook & ", " & wParam & ", " & lParam
        Else
            MouseProc = CallNextHookEx(g_hMouseHook, idHook, wParam, ByVal lParam)
        End If
    End If
End Function
 
Public Sub HookMouse()
    If g_hMouseHook = 0 Then g_hMouseHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, App.hInstance, App.ThreadID)
End Sub
 
Public Sub UnhookMouse()
    If g_hMouseHook Then
        Call UnhookWindowsHookEx(g_hMouseHook)
        g_hMouseHook = 0
    End If
End Sub

And this one in a Form

Option Explicit
 
Private Sub Command1_Click()
HookMouse
End Sub
 
Private Sub Command2_Click()
UnhookMouse
End Sub
 
 
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
UnhookMouse
End Sub

It tells me, if someone uses the MouseWheel, but not in which direction (UP, DOWN)

Please help....

[nemaroller]

well, if you want to give up on the code...

there's a free mousewheel component to download...
mousewheel

[RoyceWindsor1]

Using this example, wparam is negative when the wheel is rolling towards the user.

From MSDN:

Option Explicit

Private MSWHEEL_ROLLMSG     As Long
Private m_PrevWndProc       As Long
Private Const GWL_WNDPROC = (-4)

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 Declare Function SetWindowLong Lib "user32" Alias _
   "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
   ByVal dwNewLong As Long) As Long
Private Declare Function RegisterWindowMessage Lib "user32" _
   Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long

Public Sub SubClassHookForm()
   MSWHEEL_ROLLMSG = RegisterWindowMessage("MSWHEEL_ROLLMSG")
   ' On Windows NT 4.0, Windows 98, and Windows Me, change the above line to
   ' MSWHEEL_ROLLMSG = &H20A
   m_PrevWndProc = SetWindowLong(Form1.hwnd, GWL_WNDPROC, _
                                 AddressOf WindowProc)
End Sub
Public Sub SubClassUnHookForm()
   Call SetWindowLong(Form1.hwnd, GWL_WNDPROC, m_PrevWndProc)
End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal msg As Long, _
   ByVal wParam As Long, ByVal lParam As Long) As Long

   If msg = MSWHEEL_ROLLMSG Then
      Debug.Print "Receive MSWHEEL_ROLLMSG"
   End If
   WindowProc = CallWindowProc(m_PrevWndProc, hwnd, msg, wParam, lParam)
End Function

John

[ice & fire]

Duh, it doesn´t work!
It says: Wrong use of AdressOf Operator!

[ice & fire]

Sorry, im silly!
It does work!

Thanks man!!!

[RoyceWindsor1]

Duh, put it in a module.

You can't use AddressOf on a proc in a form.

Put this in a form:

Option Explicit

Private Sub Form_Load()
   Me.Show
   Call SubClassHookForm
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Call SubClassUnHookForm
End Sub

----

No problem

[ice & fire]

Thanks, as i said, i forgot the AdressOf Procedure Crap.
It struck me two seconds after posting....