vb.net鼠标滚轮事件的简单介绍

VB 鼠标滚轮事件在哪?

在VB中，并没有包含鼠标滚轮的滚动事件，所以必须用API自己捕获滚动信息并加以处理。主要需要用到CallWindowProc和SetWindowLong两个函数，请参考以下代码：

成都网络公司-成都网站建设公司成都创新互联公司10多年经验成就非凡，专业从事成都网站设计、做网站，成都网页设计，成都网页制作，软文发布平台，一元广告等。10多年来已成功提供全面的成都网站建设方案，打造行业特色的成都网站建设案例，建站热线：18982081108，我们期待您的来电！

’在模块中

‘声明方法

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

Public Const GWL_WNDPROC = (-4)

Public Const WM_MOUSEWHEEL = H20A

Public PrevWndProc As Long

Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long ‘写自己处理鼠标滚动的事件，这里让Form上下滚动

Dim t(0 To 1) As Integer

If uMsg = WM_MOUSEWHEEL Then

If wParam 0 Then 'backward

Form1.Top = Form1.Top + 10

Else 'forforward

Form1.Top = Form1.Top - 10

End If

Else

WndProc = CallWindowProc(PrevWndProc, hwnd, uMsg, wParam, lParam) ‘让Windows处理其他事件

End If

End Function

然后在Form中写入：

Option Explicit

Private Sub Form_Load()

PrevWndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WndProc) ‘让WndProc来处理该窗体的事件

End Sub

Private Sub Form_Unload(Cancel As Integer)

Dim lResult As Long

lResult = SetWindowLong(Me.hwnd, GWL_WNDPROC, PrevWndProc) ‘让Windows默认的函数来处理事件

End Sub

关于CallWindowProc和SetWindowLong您可以参考以下文章：

SetWindowLong

CallWindowProc

vb鼠标滚轮问题

标滚轮能给系统的使用带来很大便利，如使用滚轮移动选择这项，但在VB中的一些常用控件（如：文件框、列表框等）中没有提供鼠标滚轮滚动选择的效果。现将自己写的鼠标滚轮特效实现代码分享给大家： 本例子就是一个对Win32 API的调用，达到对ListBox、PictureBox等的鼠标滚轮控制。首先，申明windows API调用，将其放在模块modWheel中，以供用户控件使用。原理很简单，通过鼠标滚轮可以对如下白色的横线进行控制，效果图如下：相关代码如下： 鼠标滚轮处理模块(modWheel)

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _

(pDest As Any, pSource As Any, ByVal ByteLen As Long)

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _

(ByVal hWnd As Long, ByVal nIndex 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

Public Const GWL_WNDPROC = (-4)

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 SetProp Lib "user32" Alias "SetPropA" _

(ByVal hWnd As Long, ByVal lpString As String, _

ByVal hData As Long) As Long

Declare Function GetProp Lib "user32" Alias "GetPropA" _

(ByVal hWnd As Long, ByVal lpString As String) As Long

Declare Function RemoveProp Lib "user32" Alias "RemovePropA" _

(ByVal hWnd As Long, ByVal lpString As String) As Long

Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long

Public Const WM_MOUSEWHEEL = H20A

Public Const WM_MOUSELAST = H20A

Public Const WHEEL_DELTA = 120

Public Function HIWORD(LongIn As Long) As Integer

HIWORD = (LongIn And HFFFF0000) \ H10000

End Function

Public Function MWheelProc(ByVal hWnd As Long, _

ByVal wMsg As Long, ByVal wParam As Long, _

ByVal lParam As Long) As Long

Dim OldProc As Long

Dim CtlWnd As Long

Dim CtlPtr As Long

Dim IntObj As Object

Dim MWObject As MWheel

CtlWnd = GetProp(hWnd, "WheelWnd")

CtlPtr = GetProp(CtlWnd, "WheelPtr")

OldProc = GetProp(CtlWnd, "OldWheelProc")

If wMsg = WM_MOUSEWHEEL Then

CopyMemory IntObj, CtlPtr, 4

Set MWObject = IntObj

MWObject.WndProc hWnd, wMsg, wParam, lParam

Set MWObject = Nothing

CopyMemory IntObj, 0, 4

Exit Function

End If

MWheelProc = CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam)

End Function

Public Sub Subclass(MWCtl As MWheel, ParentWnd As Long)

If GetProp(MWCtl.hWnd, "OldWheelProc") 0 Then

Exit Sub

End If

SetProp MWCtl.hWnd, "OldWheelProc", _

GetWindowLong(ParentWnd, GWL_WNDPROC)

SetProp MWCtl.hWnd, "WheelPtr", ObjPtr(MWCtl)

SetProp ParentWnd, "WheelWnd", MWCtl.hWnd

SetWindowLong ParentWnd, GWL_WNDPROC, AddressOf MWheelProc

End Sub

Public Sub UnSubclass(MWCtl As MWheel, ParentWnd As Long)

Dim OldProc As Long

OldProc = GetProp(MWCtl.hWnd, "OldWheelProc")

If OldProc = 0 Then Exit Sub

SetWindowLong ParentWnd, GWL_WNDPROC, OldProc

RemoveProp ParentWnd, "WheelWnd"

RemoveProp MWCtl.hWnd, "WheelPtr"

RemoveProp MWCtl.hWnd, "OldWheelProc"

End Sub

然后，定义用户控件MWheel，实现对相关控件鼠标滚轮事件的处理。用户控件（MWheel)代码

Option Explicit

Dim m_CapWnd As Long

Dim m_Subclassed As Boolean

Event WheelScroll(Shift As Integer, zDelta As Integer, _

X As Single, Y As Single)

Private Sub UserControl_Resize()

Size 32 * Screen.TwipsPerPixelX, 32 * Screen.TwipsPerPixelY

End Sub

Public Sub DisableWheel()

If m_CapWnd = 0 Then Exit Sub

If m_Subclassed = False Then Exit Sub

UnSubclass Me, m_CapWnd

m_Subclassed = False

End Sub

Public Sub EnableWheel()

If m_CapWnd = 0 Then Exit Sub

m_Subclassed = True

Subclass Me, m_CapWnd

End Sub

Friend Property Get hWnd() As Long

hWnd = UserControl.hWnd

End Property

Public Property Get hWndCapture() As Long

hWndCapture = m_CapWnd

End Property

Public Property Let hWndCapture(ByVal vNewValue As Long)

m_CapWnd = vNewValue

End Property

Friend Sub WndProc(ByVal hWnd As Long, _

ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)

Dim wShift As Integer

Dim wzDelta As Integer

Dim wX As Single, wY As Single

wzDelta = HIWORD(wParam)

wY = HIWORD(lParam)

RaiseEvent WheelScroll(wShift, wzDelta, wX, wY)

End Sub最后，就可以将定义的用户控件用在vb窗体编程中，实现对鼠标滚轮事件的监听和处理，测试主窗体如下：Option Explicit

Dim KAs As Long

Dim KA1 As Long

Dim KA2 As Long

Private Sub Picture1_Click()

MWheel1.hWndCapture = Picture1.hWnd

MWheel1.EnableWheel

End Sub

Private Sub List1_Click()

MWheel2.hWndCapture = List1.hWnd

MWheel2.EnableWheel

KA1 = List1.ListCount

End Sub

Private Sub File1_Click()

MWheel3.hWndCapture = File1.hWnd

MWheel3.EnableWheel

KA1 = File1.ListCount

End Sub

Private Sub MWheel2_WheelScroll(Shift As Integer, zDelta As Integer, X As Single, Y As Single)

If KAs 0 Then

If zDelta = 120 Then

KAs = KAs - 1

List1.ListIndex = KAs

End If

End If

If KAs KA1 - 1 Then

If zDelta = -120 Then

KAs = KAs + 1

List1.ListIndex = KAs

End If

End If

End Sub

Private Sub MWheel1_WheelScroll(Shift As Integer, zDelta As Integer, X As Single, Y As Single)

If zDelta = 120 Then

KA2 = KA2 - 5

Line1.Y1 = KA2

Line1.Y2 = KA2

End If

If zDelta = -120 Then

KA2 = KA2 + 5

Line1.Y1 = KA2

Line1.Y2 = KA2

End If

End Sub

Private Sub MWheel3_WheelScroll(Shift As Integer, zDelta As Integer, X As Single, Y As Single)

If KAs 0 Then

If zDelta = 120 Then

KAs = KAs - 1

File1.ListIndex = KAs

End If

End If

If KAs KA1 - 1 Then

If zDelta = -120 Then

KAs = KAs + 1

File1.ListIndex = KAs

End If

End If

End Sub/SPAN

vb.net panel的vscroll的滑轮事件

点击panel时得到panel的焦点，就可以用鼠标滚轮来控制滚动条了！代码如下：

Private Sub Panel1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Panel1.Click

Panel1.Focus()

End Sub

vb.net 禁用第三方 控件滚轮事件

拦截窗口程序消息可以解决

参考 VB王国荣API讲座 讲消息的那章

几个API就可以搞定

vb.net 鼠标滚轮问题

根据我的经验，应该是PICtureBox没有获取焦点，而win10下不知道什么原因能自动获取焦点，所以凑巧成功了，因此你应该让图形框获取焦点

如：picturebox1.focus（）

不知道是不是解决了你的问题