鼠标滚轮支持、VB中数据表格类控件的滚轮支持方法

鼠标滚轮支持、VB中数据表格类控件的滚轮支持方法。

'''MSHFLEXGRID,DATAGRID,FLEXGRID等。

'''以下代码放到模块中

Option Explicit

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

'支持滚轮鼠标API---------------------------------
   
'
'   '将下列代码写到表格控件的GotFocus事件中
'   Private Sub 控件名称_GotFocus()
'           Oldwinproc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
'           SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf FlexScroll
'   End Sub
'
'   '将下列代码写到表格控件的LostFocus事件中
'   Private Sub 控件名称_LostFocus()
'           SetWindowLong Me.hWnd, GWL_WNDPROC, Oldwinproc
'   End Sub