欢迎光临:
非常感谢您光临枕善居。本站是一个免费的基于VB,VB.NET源代码交流的平台,为大家提供优质的专业的源代码,如果您有需要,本站可以帮助在业余时间里给您寻找代码。当然,如果您有好的代码也可以在本站发布,共享给大家。
专业VB和.NET源码、编程开发教程、图标资源、USB电脑遥控器、智能家电控制开关....更多东东请进入我的淘宝小店--->
VB及.NET新源码2011(3DVD,控件+资源)
智能多路控制(串口编程开关) 带源码!
07-06
14
让MSflexgrid支持鼠标滚轮事件
作者:枕善居主 / 查看次数: 11166 / 评论: 7
以下程序放在一个公共模块中,
在窗体中的form_load事件中 写 HookWheel me.hwnd
在窗体中的form_unload事件中 写 UnHookWheel me.hwnd
在表格的GotFocus事件中 set CtlWheel=MSFlexGrid1 '( 表格名称,根据具体情况,修改这个名称)
在表格的LostFocus事件中 set CtlWheel=Nothing'( 表格名称,根据具体情况,修改这个名称)
Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_MOUSEWHEEL As Long = &H20A
Private m_OldWindowProc As Long
Public CtlWheel As Object
Public Sub HookWheel(ByVal frmHwnd)
m_OldWindowProc = SetWindowLong(frmHwnd, GWL_WNDPROC, AddressOf pvWindowProc)
End Sub
Public Sub UnHookWheel(ByVal hwnd As Long)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(hwnd, GWL_WNDPROC, m_OldWindowProc)
End Sub
Private Function pvWindowProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo errH
Select Case wMsg
Case WM_MOUSEWHEEL
If Not CtlWheel Is Nothing Then
If TypeOf CtlWheel Is MSFlexGrid Then
With CtlWheel
Select Case wParam
Case Is > 0
If CtlWheel.TopRow > 0 Then
CtlWheel.TopRow = CtlWheel.TopRow - 1
End If
Case Else
CtlWheel.TopRow = CtlWheel.TopRow + 1
End Select
End With
End If
End If
End Select
errH:
pvWindowProc = CallWindowProc(m_OldWindowProc, hwnd, wMsg, wParam, lParam)
End Function
【VB和.NET专业源码+解决方案+数据字典DVD光盘(全国包快递)】 点击查看源代码清单
在窗体中的form_load事件中 写 HookWheel me.hwnd
在窗体中的form_unload事件中 写 UnHookWheel me.hwnd
在表格的GotFocus事件中 set CtlWheel=MSFlexGrid1 '( 表格名称,根据具体情况,修改这个名称)
在表格的LostFocus事件中 set CtlWheel=Nothing'( 表格名称,根据具体情况,修改这个名称)
Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_MOUSEWHEEL As Long = &H20A
Private m_OldWindowProc As Long
Public CtlWheel As Object
Public Sub HookWheel(ByVal frmHwnd)
m_OldWindowProc = SetWindowLong(frmHwnd, GWL_WNDPROC, AddressOf pvWindowProc)
End Sub
Public Sub UnHookWheel(ByVal hwnd As Long)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(hwnd, GWL_WNDPROC, m_OldWindowProc)
End Sub
Private Function pvWindowProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo errH
Select Case wMsg
Case WM_MOUSEWHEEL
If Not CtlWheel Is Nothing Then
If TypeOf CtlWheel Is MSFlexGrid Then
With CtlWheel
Select Case wParam
Case Is > 0
If CtlWheel.TopRow > 0 Then
CtlWheel.TopRow = CtlWheel.TopRow - 1
End If
Case Else
CtlWheel.TopRow = CtlWheel.TopRow + 1
End Select
End With
End If
End If
End Select
errH:
pvWindowProc = CallWindowProc(m_OldWindowProc, hwnd, wMsg, wParam, lParam)
End Function
回复
|
]谢你了。
好极了,我找这个功能找了好久了。非常感谢。
试一下我的代码把,利用一个combo控件截获滚轮信息实现各种滚轮事件。
在窗体添加 combo1,msflexgrid1 复制下面代码直接运行,效率也挺高的
Dim 焦点判断 As Boolean
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 38 Then '滚轮向上
If MSFlexGrid1.TopRow > 1 Then
MSFlexGrid1.TopRow = MSFlexGrid1.TopRow - 1
End If
ElseIf KeyCode = 40 Then '滚轮向下
If MSFlexGrid1.TopRow < MSFlexGrid1.Rows - 1 Then
MSFlexGrid1.TopRow = MSFlexGrid1.TopRow + 1
End If
End If
End Sub
Private Sub Form_Load()
焦点判断 = False
End Sub
Private Sub MSFlexGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If 焦点判断 = False Then Combo1.SetFocus
End Sub
Private Sub Combo1_GotFocus()
焦点判断 = True
End Sub
Private Sub Combo1_LostFocus()
焦点判断 = False
End Sub
在窗体添加 combo1,msflexgrid1 复制下面代码直接运行,效率也挺高的
Dim 焦点判断 As Boolean
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 38 Then '滚轮向上
If MSFlexGrid1.TopRow > 1 Then
MSFlexGrid1.TopRow = MSFlexGrid1.TopRow - 1
End If
ElseIf KeyCode = 40 Then '滚轮向下
If MSFlexGrid1.TopRow < MSFlexGrid1.Rows - 1 Then
MSFlexGrid1.TopRow = MSFlexGrid1.TopRow + 1
End If
End If
End Sub
Private Sub Form_Load()
焦点判断 = False
End Sub
Private Sub MSFlexGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If 焦点判断 = False Then Combo1.SetFocus
End Sub
Private Sub Combo1_GotFocus()
焦点判断 = True
End Sub
Private Sub Combo1_LostFocus()
焦点判断 = False
End Sub
FORM unload 死机
测试后不是很好使,很容易引爆cpu!
发表评论
您没有权限发表评论!
上一篇
下一篇
相关日志:
文章来自:
Tags:
评论: 7 | 