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

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

成都创新互联专注于企业营销型网站建设、网站重做改版、同德网站定制设计、自适应品牌网站建设、H5场景定制、商城网站建设、集团公司官网建设、成都外贸网站制作、高端网站制作、响应式网页设计等建站业务，价格优惠性价比高，为同德等各大城市提供网站开发制作服务。

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

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

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

鼠标滚轮能给系统的使用带来很大便利，如使用滚轮移动选择这项，但在VB中的一些常用控件（如：文件框、列表框等）中没有提供鼠标滚轮滚动选择的效果。现将自己写的鼠标滚轮特效实现代码分享给大家：

本例子就是一个对Win32 API的调用，达到对ListBox、PictureBox等的鼠标滚轮控制。首先，申明windows API调用，将其放在模块modWheel中，以供用户控件使用。原理很简单，通过鼠标滚轮可以对如下白色的横线进行控制，效果图如下：

相关代码如下：

鼠标滚轮处理模块(modWheel)

 
 
 
 
      
  
  
  
  1. Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _  
    2.   
  
  
  
  2.      (pDest As Any, pSource As Any, ByVal ByteLen As Long)  
    3.   
  
  
  
  3.  
    4.   
  
  
  
  4. Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _  
    5.   
  
  
  
  5.      (ByVal hWnd As Long, ByVal nIndex As Long) As Long 
    6.   
  
  
  
  6. Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _  
    7.   
  
  
  
  7.      (ByVal hWnd As Long, ByVal nIndex As Long, _  
    8.   
  
  
  
  8.      ByVal dwNewLong As Long) As Long 
    9.   
  
  
  
  9. Public Const GWL_WNDPROC = (-4)  
    10.   
  
  
  
  10. Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _  
    11.   
  
  
  
  11.      (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, _  
    12.   
  
  
  
  12.      ByVal Msg As Long, ByVal wParam As Long, _  
    13.   
  
  
  
  13.      ByVal lParam As Long) As Long 
    14.   
  
  
  
  14. Declare Function SetProp Lib "user32" Alias "SetPropA" _  
    15.   
  
  
  
  15.      (ByVal hWnd As Long, ByVal lpString As String, _  
    16.   
  
  
  
  16.      ByVal hData As Long) As Long 
    17.   
  
  
  
  17. Declare Function GetProp Lib "user32" Alias "GetPropA" _  
    18.   
  
  
  
  18.      (ByVal hWnd As Long, ByVal lpString As String) As Long 
    19.   
  
  
  
  19. Declare Function RemoveProp Lib "user32" Alias "RemovePropA" _  
    20.   
  
  
  
  20.      (ByVal hWnd As Long, ByVal lpString As String) As Long 
    21.   
  
  
  
  21. Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long 
    22.   
  
  
  
  22.  
    23.   
  
  
  
  23. Public Const WM_MOUSEWHEEL = &H20A  
    24.   
  
  
  
  24. Public Const WM_MOUSELAST = &H20A  
    25.   
  
  
  
  25. Public Const WHEEL_DELTA = 120  
    26.   
  
  
  
  26.  
    27.   
  
  
  
  27.  
    28.   
  
  
  
  28. Public Function HIWORD(LongIn As Long) As Integer 
    29.   
  
  
  
  29.  
    30.   
  
  
  
  30.    HIWORD = (LongIn And &HFFFF0000) \ &H10000  
    31.   
  
  
  
  31. End Function 
    32.   
  
  
  
  32. Public Function MWheelProc(ByVal hWnd As Long, _  
    33.   
  
  
  
  33. ByVal wMsg As Long, ByVal wParam As Long, _  
    34.   
  
  
  
  34. ByVal lParam As Long) As Long 
    35.   
  
  
  
  35.  
    36.   
  
  
  
  36.      Dim OldProc As Long 
    37.   
  
  
  
  37.      Dim CtlWnd As Long 
    38.   
  
  
  
  38.      Dim CtlPtr As Long 
    39.   
  
  
  
  39.      Dim IntObj As Object 
    40.   
  
  
  
  40.      Dim MWObject As MWheel  
    41.   
  
  
  
  41.  
    42.   
  
  
  
  42.      CtlWnd = GetProp(hWnd, "WheelWnd")  
    43.   
  
  
  
  43.      CtlPtr = GetProp(CtlWnd, "WheelPtr")  
    44.   
  
  
  
  44.      OldProc = GetProp(CtlWnd, "OldWheelProc")  
    45.   
  
  
  
  45.  
    46.   
  
  
  
  46.      If wMsg = WM_MOUSEWHEEL Then 
    47.   
  
  
  
  47.           CopyMemory IntObj, CtlPtr, 4  
    48.   
  
  
  
  48.           Set MWObject = IntObj  
    49.   
  
  
  
  49.           MWObject.WndProc hWnd, wMsg, wParam, lParam  
    50.   
  
  
  
  50.           Set MWObject = Nothing 
    51.   
  
  
  
  51.           CopyMemory IntObj, 0&, 4  
    52.   
  
  
  
  52.           Exit Function 
    53.   
  
  
  
  53.     End If 
    54.   
  
  
  
  54.  MWheelProc = CallWindowProc(OldProc, hWnd, wMsg, wParam, lParam)  
    55.   
  
  
  
  55. End Function 
    56.   
  
  
  
  56.  
    57.   
  
  
  
  57. Public Sub Subclass(MWCtl As MWheel, ParentWnd As Long)  
    58.   
  
  
  
  58.      If GetProp(MWCtl.hWnd, "OldWheelProc") <> 0 Then 
    59.   
  
  
  
  59.           Exit Sub 
    60.   
  
  
  
  60.      End If 
    61.   
  
  
  
  61.  
    62.   
  
  
  
  62.      SetProp MWCtl.hWnd, "OldWheelProc", _  
    63.   
  
  
  
  63.           GetWindowLong(ParentWnd, GWL_WNDPROC)  
    64.   
  
  
  
  64.      
    65.   
  
  
  
  65.      SetProp MWCtl.hWnd, "WheelPtr", ObjPtr(MWCtl)  
    66.   
  
  
  
  66.      
    67.   
  
  
  
  67.      SetProp ParentWnd, "WheelWnd", MWCtl.hWnd  
    68.   
  
  
  
  68.  
    69.   
  
  
  
  69.      SetWindowLong ParentWnd, GWL_WNDPROC, AddressOf MWheelProc  
    70.   
  
  
  
  70. End Sub 
    71.   
  
  
  
  71.  
    72.   
  
  
  
  72. Public Sub UnSubclass(MWCtl As MWheel, ParentWnd As Long)  
    73.   
  
  
  
  73.      Dim OldProc As Long 
    74.   
  
  
  
  74.  
    75.   
  
  
  
  75.      OldProc = GetProp(MWCtl.hWnd, "OldWheelProc")  
    76.   
  
  
  
  76.      If OldProc = 0 Then Exit Sub 
    77.   
  
  
  
  77.     
    78.   
  
  
  
  78.      SetWindowLong ParentWnd, GWL_WNDPROC, OldProc  
    79.   
  
  
  
  79.      
    80.   
  
  
  
  80.      RemoveProp ParentWnd, "WheelWnd" 
    81.   
  
  
  
  81.      RemoveProp MWCtl.hWnd, "WheelPtr" 
    82.   
  
  
  
  82.      RemoveProp MWCtl.hWnd, "OldWheelProc" 
    83.   
  
  
  
  83. End Sub 
    84.

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

用户控件（MWheel)代码

 
 
 
 
      
  
  
  
  1. Option Explicit  
    2.   
  
  
  
  2.  
    3.   
  
  
  
  3. Dim m_CapWnd As Long 
    4.   
  
  
  
  4. Dim m_Subclassed As Boolean 
    5.   
  
  
  
  5.  
    6.   
  
  
  
  6. Event WheelScroll(Shift As Integer, zDelta As Integer, _  
    7.   
  
  
  
  7.     X As Single, Y As Single)  
    8.   
  
  
  
  8.  
    9.   
  
  
  
  9. Private Sub UserControl_Resize()  
    10.   
  
  
  
  10.      Size 32 * Screen.TwipsPerPixelX, 32 * Screen.TwipsPerPixelY  
    11.   
  
  
  
  11. End Sub 
    12.   
  
  
  
  12.  
    13.   
  
  
  
  13. Public Sub DisableWheel()  
    14.   
  
  
  
  14.      If m_CapWnd = 0 Then Exit Sub 
    15.   
  
  
  
  15.      If m_Subclassed = False Then Exit Sub 
    16.   
  
  
  
  16.  
    17.   
  
  
  
  17.      UnSubclass Me, m_CapWnd  
    18.   
  
  
  
  18.      m_Subclassed = False 
    19.   
  
  
  
  19. End Sub 
    20.   
  
  
  
  20.  
    21.   
  
  
  
  21. Public Sub EnableWheel()  
    22.   
  
  
  
  22.      If m_CapWnd = 0 Then Exit Sub 
    23.   
  
  
  
  23.      m_Subclassed = True 
    24.   
  
  
  
  24.      Subclass Me, m_CapWnd  
    25.   
  
  
  
  25. End Sub 
    26.   
  
  
  
  26.  
    27.   
  
  
  
  27. Friend Property Get hWnd() As Long 
    28.   
  
  
  
  28.      hWnd = UserControl.hWnd  
    29.   
  
  
  
  29. End Property 
    30.   
  
  
  
  30.  
    31.   
  
  
  
  31. Public Property Get hWndCapture() As Long 
    32.   
  
  
  
  32.      hWndCapture = m_CapWnd  
    33.   
  
  
  
  33. End Property 
    34.   
  
  
  
  34. Public Property Let hWndCapture(ByVal vNewValue As Long)  
    35.   
  
  
  
  35.      m_CapWnd = vNewValue  
    36.   
  
  
  
  36. End Property 
    37.   
  
  
  
  37.  
    38.   
  
  
  
  38. Friend Sub WndProc(ByVal hWnd As Long, _  
    39.   
  
  
  
  39. ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)  
    40.   
  
  
  
  40.      Dim wShift As Integer 
    41.   
  
  
  
  41.      Dim wzDelta As Integer 
    42.   
  
  
  
  42.      Dim wX As Single, wY As Single     
    43.   
  
  
  
  43.      wzDelta = HIWORD(wParam)  
    44.   
  
  
  
  44.      
    45.   
  
  
  
  45.      wY = HIWORD(lParam)  
    46.   
  
  
  
  46.  
    47.   
  
  
  
  47.      RaiseEvent WheelScroll(wShift, wzDelta, wX, wY)  
    48.   
  
  
  
  48. End Sub 
    49.

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

主窗体（Form1）代码

 
 
 
 
      
  
  
  
  1. Option Explicit  
    2.   
  
  
  
  2. Dim KAs As Long 
    3.   
  
  
  
  3. Dim KA1 As Long 
    4.   
  
  
  
  4. Dim KA2 As Long 
    5.   
  
  
  
  5. Private Sub Picture1_Click()  
    6.   
  
  
  
  6. MWheel1.hWndCapture = Picture1.hWnd  
    7.   
  
  
  
  7. MWheel1.EnableWheel  
    8.   
  
  
  
  8. End Sub 
    9.   
  
  
  
  9. Private Sub List1_Click()  
    10.   
  
  
  
  10. MWheel2.hWndCapture = List1.hWnd  
    11.   
  
  
  
  11. MWheel2.EnableWheel  
    12.   
  
  
  
  12. KA1 = List1.ListCount  
    13.   
  
  
  
  13. End Sub 
    14.   
  
  
  
  14. Private Sub File1_Click()  
    15.   
  
  
  
  15. MWheel3.hWndCapture = File1.hWnd  
    16.   
  
  
  
  16. MWheel3.EnableWheel  
    17.   
  
  
  
  17. KA1 = File1.ListCount  
    18.   
  
  
  
  18. End Sub 
    19.   
  
  
  
  19. Private Sub MWheel2_WheelScroll(Shift As Integer, zDelta As Integer, X As Single, Y As Single)  
    20.   
  
  
  
  20.  
    21.   
  
  
  
  21. If KAs > 0 Then 
    22.   
  
  
  
  22. If zDelta = 120 Then 
    23.   
  
  
  
  23. KAs = KAs - 1  
    24.   
  
  
  
  24. List1.ListIndex = KAs  
    25.   
  
  
  
  25. End If 
    26.   
  
  
  
  26. End If 
    27.   
  
  
  
  27. If KAs < KA1 - 1 Then 
    28.   
  
  
  
  28. If zDelta = -120 Then 
    29.   
  
  
  
  29. KAs = KAs + 1  
    30.   
  
  
  
  30. List1.ListIndex = KAs  
    31.   
  
  
  
  31. End If 
    32.   
  
  
  
  32. End If 
    33.   
  
  
  
  33. End Sub 
    34.   
  
  
  
  34. Private Sub MWheel1_WheelScroll(Shift As Integer, zDelta As Integer, X As Single, Y As Single)  
    35.   
  
  
  
  35.  
    36.   
  
  
  
  36. If zDelta = 120 Then 
    37.   
  
  
  
  37. KA2 = KA2 - 5  
    38.   
  
  
  
  38. Line1.Y1 = KA2  
    39.   
  
  
  
  39. Line1.Y2 = KA2  
    40.   
  
  
  
  40. End If 
    41.   
  
  
  
  41. If zDelta = -120 Then 
    42.   
  
  
  
  42. KA2 = KA2 + 5  
    43.   
  
  
  
  43. Line1.Y1 = KA2  
    44.   
  
  
  
  44. Line1.Y2 = KA2  
    45.   
  
  
  
  45.  
    46.   
  
  
  
  46. End If 
    47.   
  
  
  
  47. End Sub 
    48.   
  
  
  
  48. Private Sub MWheel3_WheelScroll(Shift As Integer, zDelta As Integer, X As Single, Y As Single)  
    49.   
  
  
  
  49.  
    50.   
  
  
  
  50. If KAs > 0 Then 
    51.   
  
  
  
  51. If zDelta = 120 Then 
    52.   
  
  
  
  52. KAs = KAs - 1  
    53.   
  
  
  
  53. File1.ListIndex = KAs  
    54.   
  
  
  
  54. End If 
    55.   
  
  
  
  55. End If 
    56.   
  
  
  
  56. If KAs < KA1 - 1 Then 
    57.   
  
  
  
  57. If zDelta = -120 Then 
    58.   
  
  
  
  58. KAs = KAs + 1  
    59.   
  
  
  
  59. File1.ListIndex = KAs  
    60.   
  
  
  
  60. End If 
    61.   
  
  
  
  61. End If 
    62.   
  
  
  
  62. End Sub 
    63.

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

【编辑推荐】

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

标题名称：详解VB.NET中鼠标滚轮的实际应用
网页网址：http://www.csdahua.cn/qtweb/news6/504256.html

网站建设、网络推广公司-快上网，是专注品牌与效果的网站制作，网络营销seo公司；服务项目有等

广告

声明：本网站发布的内容（图片、视频和文字）以用户投稿、用户转载内容为主，如果涉及侵权请尽快告知，我们将会在第一时间删除。文章观点不代表本网站立场，如需处理请联系客服。电话：028-86922220；邮箱：631063699@qq.com。内容未经允许不得转载，或转载时需注明来源： 快上网

成都快上网为您推荐相关内容

电子商务知识

行业网站建设

成都做网站　　 　成都做网站　　 　建站公司　　 　西部信息中心　　 　雅安主机托管　　 　联通机柜租用　　 　高端网站策划　　 　成都富士康招工　　 　主机租用　　 　成都主机托管　　 　响应式网站设计方案　　 　泽君科技　　 　盐亭网站建设　　 　彩乐斯　　 　绵竹做网站　　 　四川佑馨产后护理　　 　全网整合营销　　 　消防工程　　 　名片印刷厂　　 　网络推广公司