vb如何监视鼠标滚轮事件

Posted

tags:

篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了vb如何监视鼠标滚轮事件相关的知识，希望对你有一定的参考价值。

我想写一个鼠标滚轮的类，使之能监视全局鼠标滚轮事件

下面是我写的这个类的大致结构，期望高手能帮我完成
该类只有一个事件MouseWheel(ByVal Flags As Integer)和一个属性Enabled
当属性Enabled设为True时开始监视，Enabled为False是停止监视，

Option Explicit

Dim sEnabled As Boolean '属性，是否启动监测

'事件，监测到鼠标滚轮事件时执行的事件
Public Event MouseWheel(ByVal Flags As Integer) 'Flags值：1表示向上滚动，2表示向下滚动

Public Property Let Enabled(s As Boolean)
sEnabled = s
'调用执行监测或停止监测的函数
End Property

Public Property Get Enabled() As Boolean
Enabled = sEnabled
End Property

'监测函数
'等候补充

希望高手能帮我完成这个单一功能的类，要监视全局鼠标滚轮事件，并传递回时向上滚还是向下滚

首先你的要求无法满足，因为你的是类模块，类模块内的任何过程都是对外不可见的，监视全局鼠标事件必须要提供一个全局可见的（可以使用AddressOf符号的）过程，这个过程必须在模块里用public方式声明，在类模块里做不到。

其次，你希望触发一个事件，然后让你执行代码，但是windows系统有要求就是鼠标事件钩子不可以被其它代码中断，也就是说就算你拿到了这个事件也不可以做进一步处理，否则别的程序无法正常接受消息，严重的时候会让系统崩溃。

唯一的手段是放到模块里，将鼠标事件写入一个标志变量里，然后用timer去读这个变量是可以的，以下是代码：

窗口内添加一个按钮和一个timer控件
代码如下

Private Sub Command1_Click()
If hookId = 0 Then
hookId = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, App.hInstance, 0)
ElseIf hookId <> 0 Then
UnhookWindowsHookEx hookId
hookId = 0
End If
End Sub

Private Sub Form_Load()
Timer1.Interval = 10
End Sub

Private Sub Form_Unload(Cancel As Integer)
If hookId <> 0 Then
UnhookWindowsHookEx hookId
hookId = 0
End If
End Sub

Private Sub Timer1_Timer()
If EventRaised = True Then
Debug.Print Direction
EventRaised = False
End If
End Sub

添加一个模块，粘贴如下代码：
Option Explicit
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Const WH_MOUSE_LL = 14
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Const WM_MOUSEWHEEL = &H20A
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As MSLLHOOKSTRUCT, ByVal Source As Long, ByVal Length As Long)

Public hookId As Long
Public Direction As Boolean
Public EventRaised As Boolean
Public Type MSLLHOOKSTRUCT
ptx As Long
pty As Long
deltax As Long
deltay As Long
time As Long
extinfo As Long
End Type

Public Function MouseProc(ByVal ncode As Long, ByVal wp As Long, ByVal lp As Long) As Long
Dim ll As MSLLHOOKSTRUCT
If wp = WM_MOUSEWHEEL Then
CopyMemory ll, lp, Len(ll)
If ll.deltax < 0 Then
Direction = False
Else
Direction = True
End If
EventRaised = True
End If
MouseProc = CallNextHookEx(hookId, ncode, wp, lp)
End Function

'运行的时候滚动滚轮可以看到调试窗口有信息输出，不明白的请百度HI我

'运行这个程序的时候务必正常关闭窗口，而不是直接在VB里中断掉，否则会让VB挂掉，因为你的钩子不正常退出会让程序崩溃 参考技术A 参照自http://dev.rdxx.com/VB/VBSYS/2001-11/5/221748547.shtml的代码，可以实现datagrid1的滚动

我刚才试过了，没有问题的。

Private Sub Form_Load()
Hook Me.hWnd
Hook Text1.hWnd'让text1控件能监听第三键
End Sub

Private Sub Form_Unload(Cancel As Integer)
UnHook Me.hWnd
UnHook Text1.hWnd
End Sub

'以下代码放到模块中
Option Explicit
Public Type POINTL
x As Long
y As Long
End Type
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

Declare Function SetWindowLong _
Lib "USER32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Declare Function SystemParametersInfo _
Lib "USER32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, _
ByVal uParam As Long, _
lpvParam As Any, _
ByVal fuWinIni As Long) As Long

Declare Function ScreenToClient Lib "USER32" _
(ByVal hWnd As Long, xyPoint As POINTL) As Long

Public Const GWL_WNDPROC = -4
Public Const SPI_GETWHEELSCROLLLINES = 104
Public Const WM_MOUSEWHEEL = &H20A
Public WHEEL_SCROLL_LINES As Long

Global lpPrevWndProc As Long

Public Sub Hook(ByVal hWnd As Long)
lpPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, _
AddressOf WindowProc)
'获取"控制面板"中的滚动行数值
Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, _
0, WHEEL_SCROLL_LINES, 0)

End Sub

Public Sub UnHook(ByVal hWnd As Long)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(hWnd,
GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hw As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim pt As POINTL
Select Case uMsg
Case WM_MOUSEWHEEL
Dim wzDelta, wKeys As Integer
wzDelta = HIWORD(wParam)
wKeys = LOWORD(wParam)
pt.x = LOWORD(lParam)
pt.y = HIWORD(lParam)
'将屏幕坐标转换为Form1.窗口坐标
ScreenToClient Form1.hWnd, pt
msgbox("滚动了")
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, _
uMsg, wParam, lParam)
End Select
End Function

Public Function HIWORD(LongIn As Long) As Integer
' 取出32位值的高16位
HIWORD = (LongIn And &HFFFF0000) \ &H10000
End Function

Public Function LOWORD(LongIn As Long) As Integer
' 取出32位值的低16位
LOWORD = LongIn And &HFFFF&
End Function

如何在 vb.net 中使用滚轮放大图片框

【中文标题】如何在 vb.net 中使用滚轮放大图片框【英文标题】：How to zoom in a Picturebox with scrollwheel in vb.net 【发布时间】：2012-11-09 21:46:48 【问题描述】：

我正在使用一组图形叠加层来使用图形对象在图片框控件内绘制图像。我已将 Picturebox 放置在 Panel 内并将 Panel 设置为自动滚动。我现在需要知道如何做的是使用鼠标滚轮以小增量放大图片的大小，同时保持绘制的图像质量。有人知道怎么做吗？

当我使用下面的 Abdias Software 代码更新时，当图片框的 Sizemode 属性设置为 StretchImage 时，图片开始变小。我的鼠标具有平移功能，可能会干扰此代码无法正常工作。有任何想法吗？是什么导致它无法正常工作？

已解决

这段代码对我来说比下面的任何一个都好得多：

Private Sub PictureBox_MouseWheel(sender As System.Object,
                             e As MouseEventArgs) Handles PictureBox1.MouseWheel
    If e.Delta <> 0 Then
        If e.Delta <= 0 Then
            If PictureBox1.Width < 500 Then Exit Sub 'minimum 500?
        Else
            If PictureBox1.Width > 2000 Then Exit Sub 'maximum 2000?
        End If

        PictureBox1.Width += CInt(PictureBox1.Width * e.Delta / 1000)
        PictureBox1.Height += CInt(PictureBox1.Height * e.Delta / 1000)
    End If

End Sub

【问题讨论】：

我添加了您的代码并按预期启用了移动，并且缩放也可以正常工作。这些事件无论如何都是分开的，所以它们不应该干扰。 sizemode 将强制图像为控件的大小，因此如果控件大小小于图像，则图像将缩小。您可以在加载事件（或设置图像的方法）中设置PictureBox1.Size = New Size(bmp.Width, bmp.Height)（也可以使用相同的方式更新_origjnalSize）。除此之外，如果不查看更多代码，我看不到任何潜在的问题。 我使用了你所有的代码，只是图片不同，但仍然有效。 （就像一个旁注：我不确定你为什么把 SetStyle() 放在那里。它们是为用户控件而设计的，在这一点上我不会做太多的代码）。除了一切都按预期工作（即使启用了 setstyles）。这有点神秘。我在 XP 顺便说一句。我认为这并不重要，但如果您使用的是其他 win 版本，则值得一试并希望消除。 我正在使用带有 Visual Studio Express 2012 的 Windows 7。您认为这可能是他们尚未修复的错误吗？我不想移动所有这些代码并将所有内容重绘到 Visual Basic Express 2010。Uggg！如果您不介意我问，您在 PictureBox 控件和 Panel 控件中的属性设置是什么。不知道是不是这么简单。但谁知道也许我的一个疯了。 这是我的所有设置：pastebin.com/FnAzVKzF 这可能是 VS2012 中的一个错误，它肯定是这样的。不过只有一种方法可以找出答案.. :) 【参考方案1】：

你可以试试这个代码。它假设表单上存在Panel1 和PictureBox1（Panel1 内的PictureBox1 和Panel1.AutoScroll = True），并在PictureBox 上设置图像。

代码不会计算缩放的中心点，但您可以使用 e.Location（或 e.X/e.Y）。

更新 - 这是（应该）比以前更健壮的新代码（见底部）：

Public Class Form1

    Private _originalSize As Size = Nothing
    Private _scale As Single = 1
    Private _scaleDelta As Single = 0.0005

    Private Sub Form_MouseWheel(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel

        'if very sensitive mouse, change 0.00005 to something even smaller   
        _scaleDelta = Math.Sqrt(PictureBox1.Width * PictureBox1.Height) * 0.00005

        If e.Delta < 0 Then
            _scale -= _scaleDelta
        ElseIf e.Delta > 0 Then
            _scale += _scaleDelta
        End If

        If e.Delta <> 0 Then _
        PictureBox1.Size = New Size(CInt(Math.Round(_originalSize.Width * _scale)), _
                                    CInt(Math.Round(_originalSize.Height * _scale)))

    End Sub

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage

        'init this from here or a method depending on your needs
        If PictureBox1.Image IsNot Nothing Then
            PictureBox1.Size = Panel1.Size
            _originalSize = Panel1.Size
        End If

    End Sub

End Class

旧代码 - 可以工作，但可能由于 Scale() 中的舍入错误而在大更改时不稳定：

Public Class Form1

    Private _scale As New SizeF(1, 1)
    Private _scaleDelta As New SizeF(0.01, 0.01) '1% for each wheel tick

    Private Sub Form_MouseWheel(sender As System.Object, 
                                e As MouseEventArgs) Handles Me.MouseWheel
'count incrementally 
        _scale.Height = 1
        _scale.Width = 1

        If e.Delta < 0 Then
            _scale += _scaleDelta
        ElseIf e.Delta > 0 Then
            _scale -= _scaleDelta
        End If

        If e.Delta <> 0 Then _
        PictureBox1.Scale(_scale)

    End Sub

    Private Sub Form1_Load(sender As System.Object, 
                           e As EventArgs) Handles MyBase.Load

        PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage

        'init picturebox size = image size
        If PictureBox1.Image IsNot Nothing Then
            PictureBox1.Scale(New SizeF(1, 1))
            PictureBox1.Size = PictureBox1.Image.Size
        End If

    End Sub

End Class

【讨论】：

我尝试了代码，它运行良好，但似乎有一个大问题。当我启动程序时，图片框会在添加代码之前自动缩小图片的全尺寸。当我使用滚轮时，它会变小，当我以其他方式滚动时，它会变大，直到只有图片大小的一半。任何线索是什么原因造成的？ 我在表单的加载事件中添加了一个小代码-sn-p，以将 pbox 的大小调整为设置在其上的图像的大小。如果图像是从其他地方设置的，当然只需将代码移动到那里。 @GregWillard 我可能是一个舍入错误问题。另一种方法是直接使用变量计算 Size，而不是使用 Scale()。我将进行测试以确认是否使用该代码更新我的答案。 我已经更新了我的原始帖子，看看是否是该代码导致了问题。谢谢，让我知道。 :) 我已经用另一种看起来稳定的方法更新了代码。【参考方案2】：

基本上，您需要一个图像查看器。我以前用过这个： http://cyotek.com/blog/creating-a-scrollable-and-zoomable-image-viewer-in-csharp-part-4

效果很好。但是，它是一个用户控件。

对于图片框，您需要从图像中创建图形，然后对其进行插值。这是一个例子： http://www.dotnetcurry.com/ShowArticle.aspx?ID=196

我没有检查这个，但看起来可以。

【讨论】：

感谢您的回复，但我希望在 VB.NET 中完成此操作，并且不使用第三方控件。 检查第二个链接，它有 c# 和 vb 代码。它是用于图片框的，但我之前没有尝试过。 我看到了，这是一个很好的例子，但是我正在寻找一个使用鼠标滚轮而不是缩放滑块滚动的例子。谢谢！【参考方案3】：

我注意到StretchImage SizeMode 忽略图像比例会产生不良影响。我刚刚添加了一个宽度和高度比率变量以包含在“缩放”算法中。请参阅下面代码中的_ratWidth 和_ratHeight。

Public Class Form1

Private _originalSize As Size = Nothing
Private _scale As Single = 1
Private _scaleDelta As Single = 0.0005
Private _ratWidth, _ratHeight As Double

Private Sub Form_MouseWheel(sender As System.Object, e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel

    'if very sensitive mouse, change 0.00005 to something even smaller   
    _scaleDelta = Math.Sqrt(PictureBox1.Width * PictureBox1.Height) * 0.00005

    If e.Delta < 0 Then
        _scale -= _scaleDelta
    ElseIf e.Delta > 0 Then
        _scale += _scaleDelta
    End If

    If e.Delta <> 0 Then _
    PictureBox1.Size = New Size(CInt(Math.Round((_originalSize.Width * _ratWidth) * _scale)), _
                                CInt(Math.Round((_originalSize.Height * _ratHeight) * _scale)))

End Sub

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
    PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage

    'init this from here or a method depending on your needs
    If PictureBox1.Image IsNot Nothing Then
        _ratWidth = PictureBox1.Image.Width / PictureBox1.Image.Height
        _ratHeight = PirctureBox1.Image.Height / PictureBox1.Image.Width
        PictureBox1.Size = Panel1.Size
        _originalSize = Panel1.Size
    End If
End Sub
End Class

【讨论】：

以上是关于vb如何监视鼠标滚轮事件的主要内容，如果未能解决你的问题，请参考以下文章

js中如何禁用鼠标滚轮事件？急，在线等！

jQuery中有鼠标滚轮事件么？

jQ中鼠标滚轮事件事件吗

如何使用鼠标滚轮事件移动剖面

现代浏览器中的鼠标滚轮事件

js如何取消鼠标滚轮绑定的事件