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