【转自csdn】使msflexgrid控件支持鼠标滚轮

方法1：
以下程序放在一个公共模块中，
在窗体中的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

方法2
转自：http://blog.csdn.net/yachong/archive/2007/01/26/1494442.aspx

如果程序里面有多个窗体，每个窗体包含多个MSFlexGrid控件，使用这种办法比单独为每个网格控件编写代码方便一些

用文本替换把“MSFlexGrid”替换为“MSHFlexGrid”就可以支持MSHFlexGrid控件了

新建一个模块，贴上下面的代码：
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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
Public Const GWL_WNDPROC = (-4)

Public Type tGridList
    frm As Form
    grid As MSFlexGrid
    grdHwnd As Long
    grdPreProc As Long
End Type

Private GridList() As tGridList
Private nGridCount As Long

Public Function WindowProcGridHook(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim nIndex As Long
    nIndex = GetGridIndex(hwnd)
    If uMsg <> 522 Then
        WindowProcGridHook = CallWindowProc(GridList(nIndex).grdPreProc, hwnd, uMsg, wParam, lParam)
    Else '滚轮
        On Error Resume Next
        With GridList(nIndex).grid
            Dim lngTopRow As Long, lngBottomRow As Long
            lngTopRow = 1
            lngBottomRow = .Rows - 1
            If wParam > 0 Then
                If Not .RowIsVisible(lngTopRow) Then
                    .TopRow = .TopRow - 1
                End If
            Else
                .TopRow = .TopRow + 1
            End If
        End With
    End If
End Function

Public Sub StartHook(frm As Form)
    Dim x As Variant
    Dim proc As Long
    For Each x In frm.Controls
        If TypeOf x Is MSFlexGrid Then
            nGridCount = nGridCount + 1
            ReDim Preserve GridList(1 To nGridCount) As tGridList
            Set GridList(nGridCount).grid = x
            Set GridList(nGridCount).frm = frm
            GridList(nGridCount).grdHwnd = x.hwnd
            proc = SetWindowLong(x.hwnd, GWL_WNDPROC, AddressOf WindowProcGridHook)
            GridList(nGridCount).grdPreProc = proc
        End If
    Next
End Sub

Public Sub EndHook(frm As Form)
    Dim i As Long, j As Long, n As Long
    For i = nGridCount To 1 Step -1
        If GridList(i).frm Is frm Then
            SetWindowLong GridList(i).grdHwnd, GWL_WNDPROC, GridList(i).grdPreProc
            n = n + 1
            For j = i To nGridCount - n
                GridList(j) = GridList(j + 1)
            Next
        End If
    Next
    nGridCount = nGridCount - n
End Sub

Private Function GetGridIndex(hwnd As Long) As Long
    Dim i As Long
    For i = 1 To nGridCount
        If GridList(i).grdHwnd = hwnd Then
            GetGridIndex = i
            Exit Function
        End If
    Next
End Function

然后在每个包含MSFlexGrid控件的窗体调用StartHook和EndHook这两个过程
例如：
Private Sub Form_Load()
    StartHook Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
    EndHook Me
End Sub
这样就可以支持滚轮了