使MSHFlexGrid支持鼠标滚动

使MSHFlexGrid支持鼠标滚动 

以下程序放在一个公共模块中，

在窗体中的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