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

叶帆 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
...全文
530 点赞 收藏 30
写回复
30 条回复
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日
谢谢!
回复 点赞
发动态
发帖子
控件
创建于2007-09-28

1223

社区成员

4.1w+

社区内容

VB 控件
社区公告
暂无公告