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

[VBDN]

工程中有一个窗体和一个模块，窗体中有一个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 Long

Public 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 lpPrevWndProc

Public Sub Hook(ByVal hwnd As Long)
lpPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public 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

[铁拳]

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

[铁拳]

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

[daisy8675]

明天去試。豁出去好了，呵呵~~
現在不試，死機，事情就沒有辦法做了。

[铁拳]

正等着您结贴呢，呵呵。

[daisy8675]

樓主結給樓上的，偶找不到機器試，都不肯給我試。我也沒有為科學而奉獻的精神。

[铁拳]

我已经测试通过了，没有问题。

[csdnmzk]

期待死机。。。

[铁拳]

晕，以前看过一个动画片有只老狼叫迈克尔。

[csdnmzk]

我不是老狼，我是色狼，呵呵

[VBDN]

补充一下，不是死机，是达不到俺的效果。俺想让鼠标指向的控件支持滚轮！那位大哥再帮我看一下？
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

[铁拳]

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

[铁拳]

我闪。

[VBDN]

前边的程序失败，后来我改用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

[铁拳]

' 有两个地方要改动，一个是结构体要改，二是拷贝内存的地方是传值还是传址

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 Type

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 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



' 可以结贴了吧，呵呵。