如何让VB的DATAGRID控件支持鼠标的滚轴
答案:1 悬赏:30 手机版
解决时间 2021-01-30 07:33
- 提问者网友:容嬷嬷拿针来
- 2021-01-29 17:12
请把代码或方法贴出来吧
最佳答案
- 五星知识达人网友:躲不过心动
- 2021-01-29 18:34
首先在DataGrid 的 拆分 属性中的 选取框样式 设置为 3,即整行高亮选择,然后加入如下代码就支持了,只要让鼠标的焦点在grid控件上,滚动鼠标滑轮,grid滚动条会自动滚动的。
如果需要更平滑的滚动以及自定义滚动方法,我还有个代码,到时发给你,你自己研究吧。
示例操作方法:
将以下代码写到公共模块中
'支持滚轮鼠标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
'支持滚轮的滚动 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
如果需要更平滑的滚动以及自定义滚动方法,我还有个代码,到时发给你,你自己研究吧。
示例操作方法:
将以下代码写到公共模块中
'支持滚轮鼠标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
'支持滚轮的滚动 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
我要举报
如以上问答信息为低俗、色情、不良、暴力、侵权、涉及违法等信息,可以点下面链接进行举报!
大家都在看
推荐资讯