MSFlexGrid MouseWheel Supported

原创 2004年09月25日 15:17:00

modMouseWheel.bas
Private Declare Function CallWindowProc Lib "user32.dll" 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 Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
                          ByVal hWnd As Long, _
                          ByVal nIndex As Long, _
                          ByVal dwNewLong As Long) As Long

Public Const MK_CONTROL = &H8
Public Const MK_LBUTTON = &H1
Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A

Dim LocalHwnd As Long
Dim LocalPrevWndProc As Long
Dim MyForm As Form

Private Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal Wparam As Long, ByVal Lparam As Long) As Long

    Dim MouseKeys As Long
    Dim Rotation As Long
    Dim Xpos As Long
    Dim Ypos As Long

    If Lmsg = WM_MOUSEWHEEL Then
        MouseKeys = Wparam And 65535
        Rotation = Wparam / 65536
        Xpos = Lparam And 65535
        Ypos = Lparam / 65536
        MyForm.MouseWheel MouseKeys, Rotation, Xpos, Ypos
    End If
    WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, Wparam, Lparam)
End Function
Public Sub WheelHook(PassedForm As Form)

    On Error Resume Next

    Set MyForm = PassedForm
    LocalHwnd = PassedForm.hWnd
    LocalPrevWndProc = SetWindowLong(LocalHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub WheelUnHook()
    Dim WorkFlag As Long

    On Error Resume Next
    WorkFlag = SetWindowLong(LocalHwnd, GWL_WNDPROC, LocalPrevWndProc)
    Set MyForm = Nothing
End Sub
Add MsFlexGrid1 to Form1 and code below
Private Sub Form_Load()
    Call WheelHook(Form1)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call WheelUnHook
End Sub
Public Sub MouseWheel(ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
    Dim NewValue As Long
    Dim Lstep As Single

    On Error Resume Next

    With MSFlexGrid1
        Lstep = .Height / .RowHeight(0)
        Lstep = Int(Lstep)
        If Lstep < 10 Then
            Lstep = 10
        End If
        If Rotation > 0 Then
            NewValue = .TopRow - Lstep
            If NewValue < 1 Then
                NewValue = 1
            End If
        Else
            NewValue = .TopRow + Lstep
            If NewValue > .Rows - 1 Then
                NewValue = .Rows - 1
            End If
        End If
        .TopRow = NewValue
    End With
End Sub
'For a VScrollBar Version
'Public Sub MouseWheel(ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
'    Dim NewValue As Long
'
'    On Error Resume Next
'
'    With VScroll
'        If Rotation > 0 Then
'            NewValue = .Value - .LargeChange
'            If NewValue < .Min Then
'                NewValue = .Min
'            End If
'        Else
'           NewValue = .Value + .LargeChange
'           If NewValue > .Max Then
'               NewValue = .Max
'            End If
'        End If
'.Value = NewValue
'    End With
'End Sub

'Winxp+sp2+VB6+sp6
Refer to:http://www.adit.co.uk/html/mousewheelsupport.html

VC MSFlexGrid基本使用

原文出处:http://blog.sina.com.cn/s/blog_66d64ec90100ltcv.html 1. 给FlexGrid控件绑定成员变量:m_FlexGrid。 2. ...
  • HarmoniousED
  • HarmoniousED
  • 2012年05月17日 11:03
  • 3274

MSFLEXGRID控件在win7、VS2008下注册

VS2008选择完整安装也找不到MsFlexGrid控件的踪影了。这给我之前使用VC6添加过MsFlexGrid控件的MFC程序移植到vs2008下增加了很多困扰。几经尝试才找到解决方案,记录备忘。 ...
  • laocunzhangxiashan
  • laocunzhangxiashan
  • 2015年10月10日 10:45
  • 1567

vb中MSFlexgrid 和 MSHFlexgrid 的区别

前几天敲机房的时候,敲到查询内容的时候,需要添加查询控件,但是有MSFlexgrid和MSHFlexgrid两种,接下来我就不知道该怎么办了,该添加哪个好呢,于是我就问了一下度娘,下面是我整理出来的结...
  • zmh458
  • zmh458
  • 2016年07月05日 09:27
  • 1557

MSFlexGrid 实现删除连续选择的多行数据。

自己写的代码,贴出来,免得以后忘记。private void btnDel_Click(object sender, EventArgs e)        ...{            try  ...
  • baihe_591
  • baihe_591
  • 2008年05月05日 19:38
  • 1297

msflexgrid在vs2010中的使用

VC6.0 是 工程-添加工程-componts and controls-Register Activex Controls vc2010 如果只在工具箱里面添加msflexgrid控件,再添加变...
  • zhengyanan815
  • zhengyanan815
  • 2016年12月03日 09:43
  • 1197

MSFlexGrid控件

MSFlexGrid控件
  • wzcyamadie
  • wzcyamadie
  • 2016年10月11日 19:31
  • 1017

让MSFlexGrid支持滚轮

如果程序里面有多个窗体,每个窗体包含多个MSFlexGrid控件,使用这种办法比单独为每个网格控件编写代码方便一些用文本替换把“MSFlexGrid”替换为“MSHFlexGrid”就可以支持MSHF...
  • yachong
  • yachong
  • 2007年01月26日 11:16
  • 2599

MsFlexGrid用法大全(转)

 最近在用VB中MsFlexGrid ,关键字就叫vb6., MSFlexGrid,数据库,MSDataBase 虽然本人已早不使用MSFGID了,但看着代码较全 ,给别人学习也不错.. 还是收藏吧~...
  • Ryen_hao
  • Ryen_hao
  • 2010年05月17日 08:44
  • 2054

鼠标滚动事件mousewheel(DOMMouseScroll)

滚轮事件只有firefox比较特殊,使用DOMMouseScroll; 其他浏览器使用mousewheel; 1.mousewheel事件中的 “event.wheelDelta”属性值:返...
  • panying0903
  • panying0903
  • 2015年12月30日 15:36
  • 1359

VC6.0中基于MSFlexGrid(ActiveX控件)的可编辑表格的制作及其若干问题的解决方案

VC6.0中基于MSFlexGrid(ActiveX控件)的可编辑表格的制作及其若干问题的解决方案
  • fengbingchun
  • fengbingchun
  • 2011年04月27日 15:02
  • 3578
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:MSFlexGrid MouseWheel Supported
举报原因:
原因补充:

(最多只允许输入30个字)