让MSflexgrid支持鼠标滚轮(VB6).doc

让Msflexgrid控件支持鼠标滚轮（VB6）Msflexgrid控件是使用非常广泛的一个控件。但由于Msflexgrid控件不支持鼠标滚轮，给用户使用带来了不少使用上的不习惯。网上就“让Msflexgrid控件支持鼠标滚轮”给出了具体的例子，实现方法主要集中于“子类化”，使用全局鼠标钩子的很少。虽然这些例子解决了“让Msflexgrid控件支持鼠标滚轮”这个问题，但依然有一些小问题，那就是自由度还不够（或者说需要自己用代码控制以免出错），比如滚动一页，比如滚轮定位。下面，我将自己测试得到的成果介绍如下。（PS：后面我还附加了判断MSFGrid控件是否有滚动条的方法）（再PS：如果要引用本文，请注明出处）在Module模块里的代码：API函数和常数申明Private Declare Function SetWindowLong Lib user32 Alias SetWindowLongA (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Const GWL_WNDPROC = (-4)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 LongPrivate Const WM_MOUSEWHEEL = &H20APrivate Declare Function SendMessage Lib user32 Alias SendMessageA (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Declare Function GetScrollRange Lib user32 (ByVal hWnd As Long, ByVal nBar As Long, lpMinPos As Long, lpMaxPos As Long) As LongPrivate Const SB_HORZ = &H0Private Const SB_VERT = &H1Private Declare Function GetFocus Lib user32 () As LongPrivate Declare Function GetClassName Lib user32 Alias GetClassNameA (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long定义变量Private lhWnd As Long, SubhWnd As LongPrivate FhWnd As Long, L As Long, clsName As StringPublic MSFG As MSFlexGrid启动子类化，传入Form1.hWndPublic Sub Start_SubClass(ByVal hWnd As Long) lhWnd = hWnd SubhWnd = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf SubClass)End Sub结束子类化Public Sub Exit_SubClass() Call SetWindowLong(lhWnd, GWL_WNDPROC, SubhWnd)End Sub子类化函数Public Function SubClass(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long SubClass = CallWindowProc(SubhWnd, hWnd, Msg, wParam, lParam) If Msg = WM_MOUSEWHEEL Then 测试消息用 Form1.Print Hex(wParam) Call MoveMSFGWheel_A(wParam) 方法一 Call MoveMSFGWheel_B(wParam) 方法二 End IfEnd Function方法一Private Sub MoveMSFGWheel_A(wParam As Long) 判断是否有MSFlexGrid获得焦点，需要在MSFlexGrid的GotFocus事件里设置Set MSFG =MSFlexGrid1，在MSFlexGrid的LostFocus事件里设置Set MSFG =Nothing If Not MSFG Is Nothing Then With MSFG Select Case wParam Case &H780000 向上滚滚动条 If .TopRow .FixedRows Then .TopRow = .TopRow - 1 Case &H780008 按住Ctrl向左滚滚动条 If .LeftCol .FixedCols Then .LeftCol = .LeftCol - 1 Case &HFF880000 向下滚滚动条 If .TopRow .Rows - 2 Then .TopRow = .TopRow + 1 Case &HFF880008 按住Ctrl向右滚滚动条 If .LeftCol .Cols - 2 Then .LeftCol = .LeftCol + 1 End Select End With End IfEnd Sub方法二垂直 Call SendMessage(MSFlexGrid1.hwnd, 277, 0, 0) 往上滚 Call SendMessage(MSFlexGrid1.hwnd, 277, 1, 0) 往下滚 Call SendMessage(MSFlexGrid1.hwnd, 277, 2, 0) 往上滚一页 Call SendMessage(MSFlexGrid1.hwnd, 277, 3, 0) 往下滚一页 Call SendMessage(MSFlexGrid1.hwnd, 277, &HE0004, 0) 跳到第14行 Call SendMessage(MSFlexGrid1.hwnd, 277, 6, 0) 顶部 Call SendMessage(MSFlexGrid1.hwnd, 277, 7, 0) 底部水平 Call SendMessage(MSFlexGrid1.hwnd, 276, 0, 0) 往左滚 Call SendMessage(MSFlexGrid1.hwnd, 276, 1, 0) 往右滚 Call SendMessage(MSFlexGrid1.hwnd, 276, 2, 0) 往左滚一页 Call SendMessage(MSFlexGrid1.hwnd, 276, 3, 0) 往右滚一页 Call SendMessage(MSFlexGrid1.hwnd, 276, &HE0004, 0) 跳到第14列 Call SendMessage(MSFlexGrid1.hwnd, 276, 6, 0) 左边缘 Call SendMessage(MSFlexGrid1.hwnd, 276, 7, 0) 右边缘知道了上面那些消息，就能很自由的控制MSFlexGrid了，当然，结合LeftCol和TopRow属性来控制，那就更完美了。Private Sub MoveMSFGWheel_B(wParam As Long) 获得窗体上的拥有焦点的控件的hWnd和类名 FhWnd = GetFocus() L = 255: clsName = String(L, Chr(0) L = GetClassName(FhWnd, clsName, L): clsName = Left(clsName, L) 判断拥有焦点的控件的类型是否为MSFlexGrid If clsName = MSFlexGridWndClass Then Select Case wParam Case &H780000 向上滚滚动条 Call SendMessage(FhWnd, 277, 0, 0) Case &H780004 按住Shift向上滚一页滚动条 Call SendMessage(FhWnd, 277, 2, 0) Case &H780008 按住Ctrl向左滚滚动条 Call SendMessage(FhWnd, 276, 0, 0) Case &H78000C 按住Shift+Ctrl向左滚滚动条 Call SendMessage(FhWnd, 276, 2, 0) Case &HFF880000 向下滚滚动条 Call SendMessage(FhWnd, 277, 1, 0) Case &HFF880004 按住Shift向下滚一页滚动条 Call SendMessage(FhWnd, 277, 3, 0) Case &HFF880008 按住Ctrl向右滚滚动条 Call SendMessage(FhWnd, 276, 1, 0) Case &HFF88000C 按住Shift+Ctrl向右滚一页滚动条 Call SendMessage(FhWnd, 276, 3, 0) End Select End IfEnd Sub判断滚动条水平可见Public Function VsScroll(MSFGrid As MSFlexGrid) As Boolean Dim i As Long, lpMinPos As Long, lpMaxPos As Long i = GetScrollRange(MSFGrid.hWnd, SB_HORZ, lpMinPos, lpMaxPos) 网上介绍的判断“lpMaxPos lpMinPos”是否为真就能判断滚动条是否显示 实际测试时，这个判断不完全正确，还要再加上判断“lpMinPos 0”。 If lpMaxPos lpMinPos And lpMinPos 0 Then VsScroll = TrueEnd Function判断滚动条垂直可见Public Function HeScroll(MSFGrid As MSFlexGrid) As Boolean Dim i As Long, lpMinPos As Long, lpMaxPos As Long i = GetScrollRange(MSFGrid.hWnd, SB_VERT, lpMinPos, lpMaxPos) 网上介绍的判断“lpMaxPos lpMinPos”是否为真就能判断滚动条是否显示 实际测试时，这个判断不完全正确，还要再加上判断“lpMinPos 0”。 If lpMaxPos lpMinPos And lpMinPos 0 Then HeScroll = TrueEnd Function在Form模块里的代码：Private Sub Form_Load() Dim i As Long With MSFlexGrid1 .Rows=50 For i = 0 To .Rows - 1 .TextMatrix(i, 0) = CStr(i) Next i .Cols=50 For i = 0 To .Cols - 1 .TextMatrix(0, i) = CStr(i) Next i End With Call Start_Su