以下代码写在模块里面 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 '支持滚轮的滚动 Yu 2004-5-10 15:33 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 以下代码写在窗体里面 Private Sub MfgMonth_GotFocus() Oldwinproc = GetWindowLong(Me.hWnd, GWL_WNDPROC) SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf FlexScroll End Sub Private Sub MfgMonth_LostFocus() SetWindowLong Me.hWnd, GWL_WNDPROC, Oldwinproc End Sub
|