使用钩子导致vb ide崩溃，如何解决 - VB6论坛

ggyy66

等　级：新手上路
帖　子：427
专家分：0
注　册：2007-8-14
结帖率：86.25%

楼主

问题点数：0 回复次数：15

使用钩子导致vb ide崩溃，如何解决

总之，钩子用到的函数我放在一个模块中了，
下面就是这个模块的代码，
我的用法是在窗体的load事件中，
写入:HookWheel me.hwnd
在窗本的unload事件中写入:unHookWheel me.hwnd
然后在flexgird的gotfocus事件中写入：set CtlWheel =grd1 'grd1是flexgrid的名称
在flexgrid的lostfocus事件中写放：set ctlwheel=nothing

注意，这样用完全没有问题，可以正常使用，效果也很好，让表格支持的鼠标滚轮的功能。
但是有一个问题没有解决，就是VB IDE窗口的异常关闭问题，当在 ide的环境中运行VB程序时，如果代码出现错误就会进入中断调试模式，此时我按下停止按钮，就会导致VBied异常关闭。
我不知是哪的原因。但是我将load事件中的 hootwheel me.hwnd 去除，就不会这样了，所以我断定vb崩溃的原因与钩子有关，但是我不知如何解决这个问题，请大家帮忙。

Option Explicit

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

'API函数 CallWindowProc 说明如下
'lpPrevWndFunc Long，原来的窗口过程地址
'HWnd Long，窗口句柄
'Msg Long，发送的消息
'wParam Long，消息类型，参考wParam参数表
'lParam Long，依据wParam参数的不同而不同
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 Const GWL_WNDPROC As Long = (-4)
Private Const WM_MOUSEWHEEL As Long = &H20A

Public m_OldWindowProc As Long
Public CtlWheel As Object '定义一个全局对象

Public Sub HookWheel(ByVal frmHwnd)
'frmHand是窗体的句柄
'在窗口结构中为指定的窗口设置信息
'GWL_WNDPROC 该窗口的窗口函数的地址
m_OldWindowProc = SetWindowLong(frmHwnd, GWL_WNDPROC, AddressOf pvWindowProc) '将当前窗体的信息存在私有变量 m_OldWindowProc 中
End Sub

Public Sub UnHookWheel(ByVal HWnd As Long)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(HWnd, GWL_WNDPROC, m_OldWindowProc)

End Sub

Public Function pvWindowProc(ByVal HWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo errH

Select Case wMsg
Case WM_MOUSEWHEEL
If Not CtlWheel Is Nothing Then
If (TypeOf CtlWheel Is MSFlexGrid) Or (TypeOf CtlWheel Is MSHFlexGrid) Then
With CtlWheel
Select Case wParam
Case Is > 0
If CtlWheel.TopRow > 0 Then
CtlWheel.TopRow = CtlWheel.TopRow - 1
End If
Case Else
CtlWheel.TopRow = CtlWheel.TopRow + 1
End Select
End With
End If
End If
End Select

errH:

pvWindowProc = CallWindowProc(m_OldWindowProc, HWnd, wMsg, wParam, lParam)
End Function