【转自8miu】使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 这样就可以支持滚轮了

转载于:https://www.cnblogs.com/feima-lxl/archive/2008/05/03/1180512.html

相关资源：MSFlexGrid控件函数详解