--------------
我开发的分司用的程序,表格控件用的都是msflexgrid,但是这个控件本身没有支持鼠标滚轮的功能.
如何增加这个功能呢?谢谢大家.
如果程序里面有多个窗体,每个窗体包含多个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
这样就可以支持滚轮了
第二种方法:
以下程序放在一个公共模块中,
在窗体中的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