详解VB.NET中鼠标滚轮的实际应用

本文将从现实开发的角度为大家讲解VB.NET鼠标滚轮的使用，希望这样实用的文章能对大家有所帮助。

最近准备写一系列和工控、设备模拟仿真PC机软件有关的文章，主要是对若干年和软件有关的工作进行总结，感兴趣的朋友可以关注一下。

这一系列的文章主要以航空仪表模拟、步进电机控制、PLC交互和LED焊机的精确定位焊接控制等等作为例子，这些例子主要都是通过VB6.0实现的，但本人将以重原理轻语言的方式来进行叙述。

第一个例子很简单，就是一个和鼠标滚轮控制有关的例子，鼠标滚轮的控制在原来的VB6.0中可是不好控制的，呵呵，后续的例子正在整理中。

鼠标滚轮能给系统的使用带来很大便利，如使用滚轮移动选择这项，但在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窗体编程中，实现对鼠标滚轮事件的监听和处理，测试主窗体如下：

主窗体（Form1）代码

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 

代码下载：http://files.cnblogs.com/lvjinjie/VB鼠标滚动轮应用案例.rar

【编辑推荐】

1. VB.NET数据并发性具体处理方式
2. VB.NET菜单组件的实现方案
3. VB.NET运算符重载强大功能介绍
4. VB.NET关于对话框制作技巧分享
5. VB.NET事件访问器特性介绍

原文标题：VB鼠标滚轮的应用实现

链接：http://www.cnblogs.com/lvjinjie/archive/2010/02/04/1660810.html