VB.NET鼠标手势实现技巧分享

VB.NET可以帮助我们实现许多以前比较难已实现的功能。比如在鼠标手势的实现方面,就可以使用这一语言轻松的实现。下面就为大家详细介绍一下这方面的应用技巧,希望能给大家带来一些帮助。

创新互联公司坚持“要么做到,要么别承诺”的工作理念,服务领域包括:网站设计制作、成都网站制作、企业官网、英文网站、手机端网站、网站推广等服务,满足客户于互联网时代的钟山网站设计、移动媒体设计的需求,帮助企业找到有效的互联网解决方案。努力成为您成熟可靠的网络建设合作伙伴!

1.什么是鼠标手势:

我的理解,按着鼠标某键(一般是右键)移动鼠标,然后放开某键,程序会识别你的移动轨迹,做出相应的响应.

 2.VB.NET鼠标手势实现原理:

首先说明一下,我在网上没有找到相关的文档,我的方法未必与其他人是一致的,实际效果感觉还可以.
鼠标移动的轨迹我们可以将其看成是许多小段直线组成的,然后这些直线的方向就是鼠标在这段轨迹中的方向了.

 3.VB.NET鼠标手势实现代码:

还要说明一下,

a)要捕获鼠标的移动事件,可以使用vb中的mousemove事件,但这个会受到一些限制(例如,在webbrowser控件上就没有这个事件).于是这个例子中,我用win api,在程序中安装个鼠标钩子,这样就能够捕获整个程序的鼠标事件了.

b)这个里只是个能捕获鼠标向上,下,左,右的移动的例子.(呵呵,其实这四方向一般也足够了:))

新建Standrad EXE,添加一个Module

form1的代码如下

 
 
  1. Option Explicit   
  2. Private Sub Form_Load()   
  3. Call InstallMouseHook   
  4. End Sub   
  5. Private Sub Form_QueryUnload
    (Cancel As Integer, 
    UnloadMode As Integer)   
  6. Call UninstallMouseHook   
  7. End Sub  

#p#

Module1的代码如下

 
 
  1. Option Explicit   
  2. Public Const HTCLIENT As Long = 1   
  3. Private hMouseHook As Long   
  4. Private Const KF_UP As Long = &H80000000   
  5. Public Declare Sub CopyMemory Lib "kernel32"
     Alias "RtlMoveMemory" (hpvDest As Any,
     hpvSource As Any, ByVal cbCopy As Long)   
  6. Private Type POINTAPI   
  7. X As Long   
  8. Y As Long   
  9. End Type   
  10. Public Type MOUSEHOOKSTRUCT   
  11. pt As POINTAPI   
  12. hwnd As Long   
  13. wHitTestCode As Long   
  14. dwExtraInfo As Long   
  15. End Type   
  16. Public Declare Function CallNextHookEx
     Lib "user32" _   
  17. (ByVal hHook As Long, _   
  18. ByVal ncode As Long, _   
  19. ByVal wParam As Long, _   
  20. ByVal lParam As Long) As Long   
  21. Public Declare Function 
    SetWindowsHookEx Lib "user32" _   
  22. Alias "SetWindowsHookExA" _   
  23. (ByVal idHook As Long, _   
  24. ByVal lpfn As Long, _   
  25. ByVal hmod As Long, _   
  26. ByVal dwThreadId As Long) As Long   
  27. Public Declare Function UnhookWindows
    HookEx Lib "user32" _   
  28. (ByVal hHook As Long) As Long   
  29. Public Const WH_KEYBOARD As Long = 2   
  30. Public Const WH_MOUSE As Long = 7   
  31. Public Const HC_SYSMODALOFF = 5   
  32. Public Const HC_SYSMODALON = 4   
  33. Public Const HC_SKIP = 2   
  34. Public Const HC_GETNEXT = 1   
  35. Public Const HC_ACTION = 0   
  36. Public Const HC_NOREMOVE As Long = 3   
  37. Public Const WM_LBUTTONDBLCLK As Long = &H203   
  38. Public Const WM_LBUTTONDOWN As Long = &H201   
  39. Public Const WM_LBUTTONUP As Long = &H202   
  40. Public Const WM_MBUTTONDBLCLK As Long = &H209   
  41. Public Const WM_MBUTTONDOWN As Long = &H207   
  42. Public Const WM_MBUTTONUP As Long = &H208   
  43. Public Const WM_RBUTTONDBLCLK As Long = &H206   
  44. Public Const WM_RBUTTONDOWN As Long = &H204   
  45. Public Const WM_RBUTTONUP As Long = &H205   
  46. Public Const WM_MOUSEMOVE As Long = &H200   
  47. Public Const WM_MOUSEWHEEL As Long = &H20A   
  48. Public Declare Function PostMessage Lib 
    "user32" Alias "PostMessageA" (ByVal hwnd 
    As Long, ByVal wMsg As Long, ByVal wParam 
    As Long, ByVal lParam As Long) As Long   
  49. Public Const MK_RBUTTON As Long = &H2   
  50. Public Declare Function ScreenToClient 
    Lib "user32" (ByVal hwnd As Long, lpPoint
     As POINTAPI) As Long   
  51. Public Declare Function GetAsyncKeyState 
    Lib "user32" (ByVal vKey As Long) As Integer   
  52. Public Const VK_LBUTTON As Long = &H1   
  53. Public Const VK_RBUTTON As Long = &H2   
  54. Public Const VK_MBUTTON As Long = &H4   
  55. Dim mPt As POINTAPI   
  56. Const ptGap As Single = 5 * 5   
  57. Dim preDir As Long   
  58. Dim mouseEventDsp As String   
  59. Dim eventLength As Long   
  60. '######### mouse hook #############   
  61. Public Sub InstallMouseHook()   
  62. hMouseHook = SetWindowsHookEx(WH_MOUSE, 
    AddressOf MouseHookProc, _   
  63. App.hInstance, App.ThreadID)   
  64. End Sub   
  65. Public Function MouseHookProc(ByVal iCode 
    As Long, ByVal wParam As Long, ByVal 
    lParam As Long) As Long   
  66. Dim Cancel As Boolean   
  67. Cancel = False   
  68. On Error GoTo due   
  69. Dim i&   
  70. Dim nMouseInfo As MOUSEHOOKSTRUCT   
  71. Dim tHWindowFromPoint As Long   
  72. Dim tpt As POINTAPI   
  73. If iCode = HC_ACTION Then   
  74. CopyMemory nMouseInfo, ByVal lParam, 
    Len(nMouseInfo)   
  75. tpt = nMouseInfo.pt   
  76. ScreenToClient nMouseInfo.hwnd, tpt   
  77. 'Debug.Print tpt.X, tpt.Y   
  78. If nMouseInfo.wHitTestCode = 1 Then   
  79. Select Case wParam   
  80. Case WM_RBUTTONDOWN   
  81. mPt = nMouseInfo.pt   
  82. preDir = -1   
  83. mouseEventDsp = ""   
  84. Cancel = True   
  85. Case WM_RBUTTONUP   
  86. Debug.Print mouseEventDsp   
  87. Cancel = True   
  88. Case WM_MOUSEMOVE   
  89. If vkPress(VK_RBUTTON) Then   
  90. Call GetMouseEvent(nMouseInfo.pt)   
  91. End If   
  92. End Select   
  93. End If   
  94. End If   
  95. If Cancel Then   
  96. MouseHookProc = 1   
  97. Else   
  98. MouseHookProc = CallNextHookEx(hMouseHook,
     iCode, wParam, lParam)   
  99. End If   
  100. Exit Function   
  101. due:   
  102. End Function   
  103. Public Sub UninstallMouseHook()   
  104. If hMouseHook <> 0 Then   
  105. Call UnhookWindowsHookEx(hMouseHook)   
  106. End If   
  107. hMouseHook = 0   
  108. End Sub   
  109. Public Function vkPress(vkcode As Long) As Boolean   
  110. If (GetAsyncKeyState(vkcode) And &H8000) <> 0 Then   
  111. vkPress = True   
  112. Else   
  113. vkPress = False   
  114. End If   
  115. End Function   
  116. Public Function GetMouseEvent(nPt As POINTAPI) As Long   
  117. Dim cx&, cy&   
  118. Dim rtn&   
  119. rtn = -1   
  120. cx = nPt.X - mPt.X: cy = -(nPt.Y - mPt.Y)   
  121. If cx * cx + cy * cy > ptGap Then   
  122. If cx > 0 And Abs(cy) <= cx Then   
  123. rtn = 0   
  124. ElseIf cy > 0 And Abs(cx) <= cy Then   
  125. rtn = 1   
  126. ElseIf cx < 0 And Abs(cy) <= Abs(cx) Then   
  127. rtn = 2   
  128. ElseIf cy < 0 And Abs(cx) <= Abs(cy) Then   
  129. rtn = 3   
  130. End If   
  131. mPt = nPt   
  132. If preDir <> rtn Then   
  133. mouseEventDspmouseEventDsp = mouseEventDsp
     & DebugDir(rtn)   
  134. preDir = rtn   
  135. End If   
  136. End If   
  137. GetMouseEvent = rtn   
  138. End Function   
  139. Public Function DebugDir(nDir&) As String   
  140. Dim tStr$   
  141. Select Case nDir   
  142. Case 0   
  143. tStr = "右"   
  144. Case 1   
  145. tStr = "上"   
  146. Case 2   
  147. tStr = "左"   
  148. Case 3   
  149. tStr = "下"   
  150. Case Else   
  151. tStr = "无"   
  152. End Select   
  153. Debug.Print Timer, tStr   
  154. DebugDir = tStr   
  155. End Function  

运行VB.NET鼠标手势的程序后,在程序窗口上,按着右键移动鼠标,Immediate Window就会显示出鼠标移动的轨迹了.

网站标题:VB.NET鼠标手势实现技巧分享
当前链接:http://www.mswzjz.cn/qtweb/news13/503163.html

攀枝花网站建设、攀枝花网站运维推广公司-贝锐智能,是专注品牌与效果的网络营销公司;服务项目有等

广告

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