MSFlexGrid的鼠标滚轮带动问题

Question

做系统中我用了控件，但是这个控件不支持鼠标的滚轴的拉动，请问怎么办？

Answer 1

新建一个模块，贴上下面的代码：
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 TypePrivate GridList() As tGridList
Private nGridCount As LongPublic 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 FunctionPublic 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 SubPrivate 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
这样就可以支持滚轮了

Answer 2

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

Answer 3

测试要小心，子类化这种东西很容易让VB6环境崩溃的
最好等到别的部分都测试完了，再加上StartHook和EndHook这两个过程的调用
调试的时候一定要注意随时保存工程^_^

Answer 4

写API
 '支持滚轮鼠标API---------------------------------
          Public Const GWL_WNDPROC = (-4)
          Public Const WM_COMMAND = &H111
          Public Const WM_MBUTTONDOWN = &H207
          Public Const WM_MBUTTONUP = &H208
          Public Const WM_MOUSEWHEEL = &H20A
            
          Public Oldwinproc     As Long
          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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _
                                                          ByVal nIndex As Long) As Long
  Public Function FlexScroll(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  '支持滚轮的滚动
          Select Case wMsg
          Case WM_MOUSEWHEEL
                  Select Case wParam
                  Case -7864320       '向下滚
                          SendKeys "{PGDN}"
                  Case 7864320         '向上滚
                          SendKeys "{PGUP}"
                  End Select
                                      
          End Select
          FlexScroll = CallWindowProc(Oldwinproc, hWnd, wMsg, wParam, lParam)
  End Function
  '支持滚轮鼠标API---------------------------------
然后在Form中填入下面两段代码：
Private Sub GridList_GotFocus()
        Oldwinproc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
        SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf FlexScroll
End SubPrivate Sub GridList_LostFocus()
        SetWindowLong Me.hWnd, GWL_WNDPROC, Oldwinproc
End Sub
注：GridList就是MSFlexGrid