在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中的一些常用控件（如：文件框、列表框等）中没有提供鼠标滚轮滚动选择的效果。现将自己写的鼠标滚轮特效实现代码分享给大家： 本例子就是一个对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
点击panel时得到panel的焦点，就可以用鼠标滚轮来控制滚动条了！代码如下：
Private Sub Panel1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Panel1.Click
Panel1.Focus()
End Sub
拦截窗口程序消息可以解决
参考 VB王国荣API讲座 讲消息的那章
几个API就可以搞定
根据我的经验，应该是PICtureBox没有获取焦点，而win10下不知道什么原因能自动获取焦点，所以凑巧成功了，因此你应该让图形框获取焦点
如：picturebox1.focus（）
不知道是不是解决了你的问题
