乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 21|回复: 1

在VB中处理鼠标滚轮事件源代码

[复制链接]

11

主题

51

帖子

2

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
95
发表于 2005-4-25 20:23:00 | 显示全部楼层 |阅读模式
本人在上次编制Smart Bar ActiveX Control 1.0中使用了鼠标滚轮事件。现在将这部分代码拿出来,做成一个简单的例子,以便网友们使用。
1.首先在Module中定义如下函数和变量:
Option Explicit
Public 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
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = -4&
Public Const WM_MOUSEWHEEL = &H20A
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Public Type POINTAPI
                                                         x As Long
                                                         y As Long
End Type
Public OldWindowProc As Long '用来保存系统默认的窗口消息处理函数的地址
Public hwndTextBox As Long         '用来保存Text1控件的句柄
'自定义的消息处理函数
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
                         On Error Resume Next
                         If Msg = WM_MOUSEWHEEL Then
                                                         '下面得到鼠标位置处的对象的句柄
                                                         Dim CurPoint As POINTAPI, hwndUnderCursor As Long
                                                         GetCursorPos CurPoint
                                                         hwndUnderCursor = WindowFromPoint(CurPoint.x, CurPoint.y)
                                                         '如果鼠标位于Form1.Text1内部,则对鼠标滚轮事件进行处理
                                                         If hwndUnderCursor = hwndTextBox Then
                                                                                         If wParam = -7864320 Then '向下滚动
                                                                                                                         Form1.Text1 = CInt(Form1.Text1) - 1
                                                                                         ElseIf wParam = 7864320 Then '向上滚动
                                                                                                                         Form1.Text1 = CInt(Form1.Text1) + 1
                                                                                         End If
                                                         End If
                         Else
                                                         '调用Text1的默认窗口消息处理函数
                                                         NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
                         End If
End Function
2.在Form页面上放置一个Text1控件,在Form_Load事件中写入如下代码:
Private Sub Form_Load()
                         Text1 = 0
                         '取得Text1控件的句柄
                         hwndTextBox = Text1.hwnd
                         '保存Text1控件的默认窗口消息处理函数地址
                         OldWindowProc = GetWindowLong(Text1.hwnd, GWL_WNDPROC)
                         '将Text1控件的消息处理函数指定为自定义函数NewWindowProc
                         Call SetWindowLong(Text1.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
                 
End Sub
3.运行,在Text1控件上面滚动鼠标滚轮,就可以发现Text的文本发生相应改变。
附件为源代码。

本帖以下内容被隐藏保护;需要你回复后,才能看到!

游客,如果您要查看本帖隐藏内容请回复
回复

使用道具 举报

0

主题

2

帖子

1

银币

初来乍到

Rank: 1

铜币
2
发表于 2005-6-19 10:00:00 | 显示全部楼层
谢谢,如果能说明详细点就更好了!
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-4 00:44 , Processed in 0.964009 second(s), 62 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表