Question

VB6如何实现 vsflexgrid 控件 鼠标滚动操作

Answer 1

使用API函数SetWindowLong、CallWindowProc、GetWindowLong，混合使用。
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

追问

SetWindowLong、CallWindowProc、GetWindowLong 要怎么实现呢？
你写的这个函数传值进去的话wMsg 这个值是多少啊？要怎么传值啊？

追答

这个有点多，不过既然回答了，就写个完整的吧。
'定义常量和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

'上面的函数只要在表格控件获得焦点时触发就可以了。
Private Sub MSHFlexGrid1_GotFocus()
'处理单屏不支持滚动的错误
If MSHFlexGrid1.RowHeight(1) * MSHFlexGrid1.Rows < MSHFlexGrid1.Height Then Exit Sub
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

注意：若表格显示的数据仅在一个屏内，则不需要滚动，所以加了一句If MSHFlexGrid1.RowHeight(1) * MSHFlexGrid1.Rows < MSHFlexGrid1.Height Then Exit 进行处理
另外，好像老版本的360下会出错，好几年前的事了。现在应该没问题了。