Mouse Wheel Trouble

[-SUBS-Lenos]

Hi!

For some reason vb crashes every time I use This code

Subclassing :

'**************
'* Form Code
'**************
Option Explicit
 
Private Sub Form_Load()
    Hook Me.hwnd
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    Unhook Me.hwnd
End Sub

'**************
'* Standard Module Code
'**************
Option Explicit
 
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 Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, _
                                                                            ByVal wMsg As Long, _
                                                                            ByVal wParam As Long, _
                                                                            ByVal lParam As Long) _
                                                                            As Long
 
Private Const GWL_WNDPROC = (-4)
 
Private Const WM_MOUSEWHEEL = &H20A
 
Private mPrevProc As Long
 
Public Sub Hook(ByVal hwnd As Long)
    mPrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
 
Public Sub Unhook(ByVal hwnd As Long)
 
    Call SetWindowLong(hwnd, GWL_WNDPROC, mPrevProc)
    mPrevProc = 0&
 
End Sub
 
Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
    
Dim x As Long, y As Long, delta As Long
    
    If uMsg = WM_MOUSEWHEEL Then
        delta = HiWord(wParam)
        
        x = LoWord(lParam)
        y = HiWord(lParam)
        
        Debug.Print "Scrolling " & IIf((delta > 0), "Up", "Down") & " ,X:" & x & ",Y:" & y
    End If
 
    If mPrevProc& Then
        WndProc = CallWindowProc(mPrevProc, hwnd, uMsg, wParam, lParam)
    Else
        WndProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
    End If
    
End Function
 
Private Function LoWord(DWord As Long) As Long
    If DWord And &H8000& Then
        LoWord = DWord Or &HFFFF0000
    Else
        LoWord = DWord And &HFFFF&
    End If
End Function
 
Private Function HiWord(DWord As Long) As Long
    HiWord = (DWord And &HFFFF0000) \ &H10000
End Function

Is there any simple code that works to detect if the mouse is being scrolled up or down?

Thanks

[Static]

works for me.. no crash but....
can I take a guess that IDE crashes when u hit stop??

when subclassing.. u cant hit stop. u MUST click the X on the form.. (or use code to close it.. like behind a cmdButton..) Subclassing will crash the IDE if not UnHooked