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

如题所述

使用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下会出错,好几年前的事了。现在应该没问题了。

温馨提示:内容为网友见解,仅供参考
无其他回答

VB6如何实现 vsflexgrid 控件 鼠标滚动操作
使用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 "{PG...

VB6.0中怎么添加VSFlexGrid?想在VB6.0上做个平台,平台运行时控件可以...
添加VSFlexGrid?想在VB6.0上做个平台,平台运行时控件可以实现自动编辑鼠标指定的网格。并且网格的后几列可以实现数学计算,实现加减乘除,运算法

vb6.0操作 vsflexgrid让用户可以像excel一样调节列宽
设置vsflexgrid.AllowUserResizing=flexResizeBoth就可以了

vb好用的表格控件vsflexgrid要钱么
可以实现非常灵活的控制和快捷的编码。在VB6开发环境下使用,winxp,win7,win8,win10亲测可用。功能强大的数据表格控件,高速、紧凑、灵活、轻便、无须依赖任何应用工具,支持数据化格式选项,能将表格列连接到图象列和墙纸属性上以提高应用工具的实现程度。

求VB6.0的一个控件
用ListView控件,代码和图:Private Sub Form_Load()With ListView1 .View = lvwReport .FullRowSelect = True .Checkboxes = True .MultiSelect = True .ColumnHeaders.Add , , "序号", 800 .ColumnHeaders.Add , , "大写字母", 900 .ColumnHeaders.Add , , "小写字母", 900 End With Dim ...

如何用vb6.0保存嵌入vsflexgrid控件中的文本框
Text = Table.Text kongJian.Visible = True If MSHF1.Col = 9 Then kongJian.Text = "" kongJian.SetFocus End IfEnd Function Call YiDongTXT(MSHF1, txt, MSHF1.Rows, MSHF1.Cols)和mshf的方法一样,只能移动文本框到上去,单击按钮触发事件,修改后内容给vs ...

VB6如何改变MSFlexGrid 表中某行的背景颜色
Private Sub Command1_Click() '按下按钮改变背景色 setrowbgcolor MSFlexGrid1, 3, vbRed '改MSFlexGrid1第3行背景为红色 End Sub Private Sub setrowbgcolor(obj As MSFlexGrid, row As Long, color As Long) '改色子程序 '用法 setrowbgcolor MSFlexGrid的实例名称,行号,颜色数值 Dim ...

vb6.0 如何将vsflexgrid里的数据 保存到ACCESS
有啊,遍历vsflexgrid表里的所有数据,用for ... next 保存就行 我用的是mshflexgrid控件 For i = 1 To MSHFlexGrid2.Rows - 1 rs.Open "select * from sqlymdd where 合同编号='" + MSHFlexGrid2.TextMatrix(i, 1) + "'", cn, adOpenKeyset, adLockOptimistic If rs.RecordCount > 0...

VB6.0 企业版 添加表格控件后怎么在表格里面编辑
VB自带的表格控件功能太少,编辑内容也需要自己写代码的。建议你使用ComponentOne VSFlexGrid,功能非常强大!

如何在VB6.0用Data Report控件打印查询的记录
If rec.State = adStateOpen Then rec.Close '判断记录集状态,如果是打开就先关闭 sql = "select * from txgz where ygname = '" + Text13.Text + "' "rec.Open sql, con, adOpenStatic, adLockOptimistic '打开记录集 rec.Requery If rec.RecordCount < 1 Then MsgBox ("无此员工!")Ex...

相似回答
大家正在搜