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

叶帆
博客专家认证
业界专家认证
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）
相关推荐
开源System.Windows.Forms库，让.Net Micro Framework界面开发和上位机一样简单
.Net Micro Framework本身支持WPF界面开发，但是对国内用户来说，WPF开发相对比较陌生，并且.Net Micro Framework对此功能的支持并不完善，Button、TextBox、ListBox、PictureBox等等基本控件并不支持，所以要想在...
《程序员》与我的程序员之路
》，受周奕的影响，也开始做一些共享软件，比如有些影响的共享软件，VB源码之友，API浏览器，西门子PPI控件，Modbus RTU控件等等。那个时候比较发愁的是，相关程序上传到什么网站，另外还有用户汇款还必须去邮局。这...
.Net Micro Framework 快速入门
窗体控件 http://blog.csdn.net/yefanqiu/archive/2007/11/15/1887238.aspx 10 、 .Net Micro Framework 研究 — 应用实例 http://blog.csdn.net/yefanqiu/archive/2007/11/28/1906289.aspx 11 、 .Net Micro ...
CHM帮助文件在VB程序中的应用
CHM帮助文件在VB程序中的应用――HTML Help Workshop作 者：叶帆(http://blog.csdn.net/yefanqiu)一．工欲利其事，必先利其器――CHM制作之工具1. 首推微软门下的专门工具HTML Help Workshop，它是制作chm帮助文件最...
自己动手编写 IronPython IDE
这段时间对IronPython充满了极大的兴趣，学习越深入，越感觉到现有IronPython IDE实在不太好用，正好项目中也需要一个IronPython编辑器，所以就动手做了起来... 引擎： IronPython 版本 V1.1.0 编辑控件：开源的ICSha
发帖
控件

1434

社区成员

4.1w+

社区内容

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