MSflexgrid支持鼠标滚轮事件-优快云博客

本文提供了一个VB6程序，通过使用HookWheel和UnHookWheel函数，实现在MSflexgrid中支持鼠标滚轮事件的功能。在窗体加载时启用钩子，在卸载时禁用，通过在表格的GotFocus和LostFocus事件中设置和清除控件，实现了此功能。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

让MSflexgrid支持鼠标滚轮事件

作者:枕善居主 / 查看次数: 10423 / 评论: 7

http://www.mndsoft.com/blog/VB6/0923.html

以下程序放在一个公共模块中，
在窗体中的form_load事件中　写　HookWheel　me.hwnd
在窗体中的form_unload事件中　写　UnHookWheel　me.hwnd
在表格的GotFocus事件中　set CtlWheel=MSFlexGrid1'( 表格名称，根据具体情况，修改这个名称)

在表格的LostFocus事件中　set CtlWheel=Nothing'( 表格名称，根据具体情况，修改这个名称)

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 Const GWL_WNDPROC As Long = (-4)
Private Const WM_MOUSEWHEEL As Long = &H20A

Private m_OldWindowProc As Long

Public CtlWheel As Object

Public Sub HookWheel(ByVal frmHwnd)

m_OldWindowProc = SetWindowLong(frmHwnd, GWL_WNDPROC, AddressOf pvWindowProc)
End Sub

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

End Sub

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