MSHFlexgrid支持鼠标滑轮

vb mshflexgrid支持鼠标滑轮

1、建标准模块
  '''=========放标准模块================
Option Explicit
'Download by
'支持滚轮鼠标API---------------------------------
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
'支持滚轮的滚动
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
  '''=========放标准模块================


 '''====MSHFLEXGRID=====================
Private Sub MSHFlexGrid1_GotFocus()
Oldwinproc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf FlexScroll
End Sub


Private Sub MSHFlexGrid1_LostFocus()
SetWindowLong Me.hWnd, GWL_WNDPROC, Oldwinproc
End Sub


 '''====MSHFLEXGRID=====================