欢迎光临:
  
  非常感谢您光临枕善居。本站是一个免费的基于VB,VB.NET源代码交流的平台,为大家提供优质的专业的源代码,如果您有需要,本站可以帮助在业余时间里给您寻找代码。当然,如果您有好的代码也可以在本站发布,共享给大家。
专业VB和.NET源码、编程开发教程、图标资源、USB电脑遥控器、智能家电控制开关....更多东东请进入我的淘宝小店--->
VB及.NET新源码2011(3DVD,控件+资源) 智能多路控制(串口编程开关) 带源码!


07-06
14

让MSflexgrid支持鼠标滚轮事件

以下程序放在一个公共模块中,
在窗体中的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源码博客
网址http://www.mndsoft.com/blog/
【VB和.NET专业源码+解决方案+数据字典DVD光盘(全国包快递)】  点击查看源代码清单



回复回复油桶 [2009-04-14 20:16:14 |  | del]
谢你了。
回复回复wuwenquan [2008-12-27 18:34:50 |  | del]
好极了,我找这个功能找了好久了。非常感谢。
回复回复gz1148 [2008-06-13 11:31:12 |  | del]
试一下我的代码把,利用一个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
回复回复王昂 [2007-08-20 12:47:37 |  | del]
THANKS VERY MUCH~~~!
回复回复chchw2001 [2007-06-15 08:51:37 |  | del]
FORM unload 死机
回复回复dear [2007-06-14 19:41:17 |  | del]
有没有办法读取另一进程中MSflexgrid网格中的值?
回复回复luluhoy [2007-06-14 15:24:14 |  | del]
测试后不是很好使,很容易引爆cpu!
发表评论
您没有权限发表评论!