一运行就死机，谁能帮我看看，重重有赏！

Question

工程中有一个窗体和一个模块，窗体中有一个Timer控件，默认值为True,Interval=1000
窗体(from1.frm)的代码：
Private Sub Form_Load()
    Hook Me.hwnd
End Sub
Private Sub Timer1_Timer()
    Dim t As Long
    t = TempHwnd
    Call GetCursorPos(CursorPosition)
    TempHwnd = WindowFromPoint(CursorPosition.X, CursorPosition.Y)
    Debug.Print TempHwnd
    If TempHwnd = t Then
        Exit Sub
    Else
        UnHook t
        Hook TempHwnd
        Debug.Print "TempHwnd--", TempHwnd
    End If
End Sub模块Module1.bas的代码：
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Public 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
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic Type POINTAPI
        X As Long
        Y As Long
End Type
Public Const GWL_WNDPROC = (-4)
Public CursorPosition As POINTAPI
Public TempHwnd As Long
Public Const WM_MOUSEWHEEL = &H20A
Global lpPrevWndProcPublic Sub Hook(ByVal hwnd As Long)
    lpPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End SubPublic Sub UnHook(ByVal hwnd As Long)
    Dim lngReturnValue As Long
    lngReturnValue = SetWindowLong(hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Debug.Print "uMsg--", uMsg
End Function

Answer 1

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Debug.Print "uMsg--", uMsg
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function

Answer 2

加上这行的主要目的是如果你不处理 windows 消息的话那就调用 windows 默认的消息处理
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)

Answer 3

补充一下，不是死机，是达不到俺的效果。俺想让鼠标指向的控件支持滚轮！那位大哥再帮我看一下？
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Form1.Print "uMsg--", uMsg
    Select Case uMsg
        Case WM_MOUSEWHEEL
            '这里加入消息函数，是控间的滚动条滚动
        Case Else
        WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
    End Select
End Function

Answer 4

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Form1.Print "uMsg--", uMsg
    Select Case uMsg
        Case WM_MOUSEWHEEL
            '这里加入消息函数，是控间的滚动条滚动
            If wParam > 0 Then
                Debug.Print "向上滚动"
            Else
                Debug.Print "向下滚动"
            End If
        Case Else
            WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
    End Select
End Function

Answer 5

前边的程序失败，后来我改用SetWindowsHookEx将鼠标事件指向MouseHookProc
现在能捕获到滚轮事件，可我怎么才能知道它是往前滚还是往后滚？
下边是MouseHookProc：
Public Function MouseHookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case nCode
        Case HC_ACTION
            If wParam = WM_MOUSEWHEEL Then
                Dim mStru As MOUSEHOOKSTRUCT
                CopyMemory mStru, lParam, LenB(mStru)
                '这里的代码怎么写啊？ 
            End If
    End Select
End Function

Answer 6

' 有两个地方要改动，一个是结构体要改，二是拷贝内存的地方是传值还是传址Private Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type' 这里增加一个类型声明
Private Type MOUSEHOOKSTRUCTEX
    MHS As MOUSEHOOKSTRUCT
    mouseData As Long
End TypePublic Function MouseHookProc(ByVal nCode As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case nCode
        Case HC_ACTION
            If wParam = WM_MOUSEWHEEL Then
                ' 这里的声明改为新增加的
                Dim mStru As MOUSEHOOKSTRUCTEX
                ' 这里拷贝的内存应为传值
                CopyMemory mStru, ByVal lParam, LenB(mStru)
                ' 这里的代码应该这么写
                If mStru.mouseData < 0 Then
                    Debug.Print "向下滚动"
                Else
                    Debug.Print "向上滚动"
                End If
            End If
    End Select
End Function' 可以结贴了吧，呵呵。