【叶帆开源区】鼠标滚轮控件源码

叶帆
博客专家认证
业界专家认证
2004-09-25 05:20:38
现在基本上所有的软件都支持鼠标滚轮,可是用VB6开发软件,却没有直接的方法获取鼠标滚轮事件。我现在把使用了很长时间的一个封装了很好的控件拿出来共享,包含控件源码 和 示例源码。
有什么问题,望大家回帖交流

源码下载:http://blog.csdn.net/yefanqiu 【叶帆源码】- 鼠标滚轮控件

部分源码:--------------------

'*************************************************************************
'**模 块 名:frmTest
'**说 明:叶帆软件工作室(YFSoft) 版权所有2004 - 2005(C)
'**创 建 人:叶帆
'**日 期:2004-09-25 16:49:37
'**修 改 人:
'**日 期:
'**描 述:控件测试
'**版 本:V1.0.0
'*************************************************************************
Option Explicit
Dim lngFlag As Long

'*************************************************************************
'**函 数 名:Mouse1_MouseWheel
'**输 入:Way(Boolean) - True '朝用户方向 False '朝显示器方向
'** :Shift(Integer) - CTRL=8、SHIFT=4、鼠标键(左=2、中=16、右=2、附加)按下,允许复合
'** :X(Single) - 鼠标座标X
'** :Y(Single) - 鼠标座标Y
'**输 出:无
'**功能描述:鼠标滚轮事件
'**全局变量:
'**调用模块:
'**作 者:叶帆
'**日 期:2004-09-25 16:49:59
'**修 改 人:
'**日 期:
'**版 本:V1.0.0
'*************************************************************************
Private Sub Mouse1_MouseWheel(Way As Boolean, Shift As Integer, X As Single, Y As Single)
lblMsg.Caption = "方向:" & Str(Way) & " 按键:" & Str(Shift) & " 座标:(" & Str(X) & "," & Str(Y) & ")"
Select Case lngFlag
Case 1:
If Way = True Then
If VScroll1.Value <= VScroll1.Max - 3 Then
VScroll1.Value = VScroll1.Value + 3
End If
Else
If VScroll1.Value >= VScroll1.Min + 3 Then
VScroll1.Value = VScroll1.Value - 3
End If
End If
Case 2:
If Way = True Then
If HScroll1.Value <= HScroll1.Max - 3 Then
HScroll1.Value = HScroll1.Value + 3
End If
Else
If HScroll1.Value >= HScroll1.Min + 3 Then
HScroll1.Value = HScroll1.Value - 3
End If
End If
End Select

End Sub

'*************************************************************************
'**函 数 名:VScroll1_GotFocus
'**输 入:无
'**输 出:无
'**功能描述:添加滚轮钩子
'**全局变量:
'**调用模块:
'**作 者:叶帆
'**日 期:2004-09-25 16:54:44
'**修 改 人:
'**日 期:
'**版 本:V1.0.0
'*************************************************************************
Private Sub VScroll1_GotFocus()
Mouse1.SetWnd VScroll1.hWnd
lngFlag = 1
End Sub

'*************************************************************************
'**函 数 名:VScroll1_LostFocus
'**输 入:无
'**输 出:无
'**功能描述:去除滚轮钩子
'**全局变量:
'**调用模块:
'**作 者:叶帆
'**日 期:2004-09-25 16:55:11
'**修 改 人:
'**日 期:
'**版 本:V1.0.0
'*************************************************************************
Private Sub VScroll1_LostFocus()
Mouse1.UnWnd VScroll1.hWnd
End Sub

'*************************************************************************
'**函 数 名:HScroll1_GotFocus
'**输 入:无
'**输 出:无
'**功能描述:添加滚轮钩子
'**全局变量:
'**调用模块:
'**作 者:叶帆
'**日 期:2004-09-25 16:54:44
'**修 改 人:
'**日 期:
'**版 本:V1.0.0
'*************************************************************************
Private Sub HScroll1_GotFocus()
Mouse1.SetWnd HScroll1.hWnd
lngFlag = 2
End Sub

'*************************************************************************
'**函 数 名:VScroll1_LostFocus
'**输 入:无
'**输 出:无
'**功能描述:去除滚轮钩子
'**全局变量:
'**调用模块:
'**作 者:叶帆
'**日 期:2004-09-25 16:55:11
'**修 改 人:
'**日 期:
'**版 本:V1.0.0
'*************************************************************************
Private Sub HScroll1_LostFocus()
Mouse1.UnWnd HScroll1.hWnd
End Sub

......

【叶帆开源区】其它链接

1、XP界面窗体制作(可放缩、可缩小到托盘)
http://community.csdn.net/Expert/topic/3387/3387552.xml?temp=.416424
2、VB源码之友
http://community.csdn.net/Expert/topic/3365/3365079.xml?temp=7.926577E-02
3、定制公用对话框(如photoshop的文件打开对话框)
http://community.csdn.net/Expert/topic/3380/3380429.xml?temp=.3048517
4、MSComm串口通信示例
http://community.csdn.net/Expert/topic/3387/3387736.xml?temp=.2366754
5、任意透明窗体--运用API实现特异窗体
http://community.csdn.net/Expert/topic/3389/3389796.xml?temp=.8869898
...全文
585 30 打赏 收藏 举报
写回复
30 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
haen_zhou 2005-04-18
GOOD
  • 打赏
  • 举报
回复
铁拳 2004-11-17
up.
  • 打赏
  • 举报
回复
acev 2004-11-11
支持,收藏!

markup
  • 打赏
  • 举报
回复
starsrainmzl 2004-11-11
GOOD
  • 打赏
  • 举报
回复
lxjlz 2004-11-11
收藏
  • 打赏
  • 举报
回复
叶帆 2004-11-11
Private Sub DBGrid1_GotFocus()
Mouse1.SetWnd DBGrid1.hWnd
End Sub

Private Sub DBGrid1_LostFocus()
Mouse1.UnWnd DBGrid1.hWnd
End Sub

Private Sub Mouse1_MouseWheel(Way As Boolean, Shift As Integer, X As Single, Y As Single)
If Way = True Then
DBGrid1.Scroll 0, 1
Else
DBGrid1.Scroll 0, -1
End If
End Sub
  • 打赏
  • 举报
回复
creazyfish 2004-11-10
呵呵,看看!
  • 打赏
  • 举报
回复
xiaolusir 2004-11-10
这个怎么加到datagrid上呀!
  • 打赏
  • 举报
回复
w3k 2004-10-23
SHOW GOOD
  • 打赏
  • 举报
回复
cbr7619 2004-10-23
收藏
  • 打赏
  • 举报
回复
CatchWind 2004-10-22
我也收藏!
  • 打赏
  • 举报
回复
skyzj 2004-09-29
谢谢楼主,支持!
  • 打赏
  • 举报
回复
daisy8675 2004-09-29
收藏:)
  • 打赏
  • 举报
回复
Amuclan 2004-09-28
本来就有个开源的Vb鼠标滚轮控件啊 我一直在用...

当然更加支持楼主的..
  • 打赏
  • 举报
回复
guxizhw 2004-09-28
支持ing!!楼主是个大好人!:)
  • 打赏
  • 举报
回复
superbug1984 2004-09-28
我记得ms好像针对这个问题出了一个补丁的吧~~
我也下载下来用过,但是好像是没有解决问题,不知道什么原因,郁闷ing...
  • 打赏
  • 举报
回复
jam021 2004-09-28
好好,谢谢楼主,支持!
  • 打赏
  • 举报
回复
bciAnson 2004-09-28
mark
  • 打赏
  • 举报
回复
wxrwan 2004-09-28
谢谢!
  • 打赏
  • 举报
回复
superxiumu 2004-09-26
谢谢!
  • 打赏
  • 举报
回复
加载更多回复(10)
相关推荐
发帖
控件

1434

社区成员

VB 控件
社区管理员
  • 控件
加入社区
帖子事件
创建了帖子
2004-09-25 05:20
社区公告
暂无公告