使用钩子令flexgrid具有支持滚轮的功能,但是在vb ide中运行时中断出现调试窗口时,按下停止会导致VB异常关闭,大家帮看哪的原因?
总之,钩子用到的函数我放在一个模块中了,
下面就是这个模块的代码,
我的用法是在窗体的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
[解决办法]
Unhook Subclassing When Windows is Ready
Don’t unhook your Windows procedures from Form_Unload when
subclassing forms. When you subclass forms, the hook is often set
during Form_Load with code like this:
OriginalProc = SetWindowLong Me.hWnd, _
GWL_WNDPROC, AddressOf MyWindowProc
A common mistake is forgetting to put the corresponding unhook
call in your Form_Unload event:(很容易忘了在Form_Unload 事件写如下代码)
SetWindowLong Me.hWnd, GWL_WNDPROC, _
AddressOf OriginalProc
If you forget to reinstate the old procedure in your Form_Unload
event, it’s bye-bye VB. Instead, add this code within your
subclassing procedure:(其实可以在安装子类时就写上如下窗口过程代码,就可以了,而且不怕进入调试模式!!!!)
Select Case Msg
Case WM_NCDESTROY
If OriginalProc <> 0 Then
Call SetWindowLong(hWnd, _
GWL_WNDPROC, OriginalProc)
OriginalProc=0
End If
Case ...
This code restores the original procedure automatically when the
window is destroyed. To make it even safer, place all your
subclassing code in a separate DLL and debug your subclassed
forms without worrying about the Integrated Development Environment
(IDE) crashing. You can always move the code back to
your EXE when it’s fully debugged.
[解决办法]
VB的钩子是这样的,出错会把调试环境一起崩溃掉的
[解决办法]
哪个叫你写在一起的啊?
钩子放在专门的DLL中。
[解决办法]
'试了2楼说的,能捕捉到错误且VB系统不崩溃
Select Case Msg
Case WM_NCDESTROY
If OriginalProc < > 0 Then
Call SetWindowLong(hWnd, _
GWL_WNDPROC, OriginalProc)
OriginalProc=0
End If
End Select
HookWheel Me.HWnd
[解决办法]
VB的钩子是这样的,出错会把调试环境一起崩溃掉的
俺调试的时候,向来都是先把这样的代码关闭,正式发布的时候才打开
[解决办法]
应该是子类化的问题,用 mnSubClass 试试吧
[解决办法]
试试这个 http://www.vbaccelerator.com/home/VB/Code/Libraries/Subclassing/SSubTimer/article.asp