MSflexgrid支持鼠标滚轮事件

客户 要求 就加了这个功能 

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

下面代码放在公共模块里

'本模块'让MSflexgrid支持鼠标滚轮事件
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
'让MSflexgrid支持鼠标滚轮事件

在窗体中的form_load事件中　写　HookWheel　me.hwnd
在窗体中的form_unload事件中　写　UnHookWheel　me.hwnd
在表格的GotFocus事件中　set CtlWheel=MSFlexGrid1'( 表格名称，根据具体情况，修改这个名称)

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