2015-11-01 2 views
0

Я не являюсь профессионалом, использующим Visual Studio-Visual Basic. Мне нужен был крючок для мыши, и он нашел это в сети и адаптировал его. Он работает очень хорошо, но через некоторое время он падает. Я не получаю никаких сообщений, хотя использовал «Try-Catch». Нужно ли мне чистить нить или что-то в этом роде?Mousehook работает, но сработает через некоторое время

Imports System.Runtime.InteropServices 
Imports System.Reflection 
Imports System.Windows.Forms 
Imports System.Diagnostics 


Public Class Fare 
Public Event MouseLeftButtonClick(ByVal sender As Object, ByVal e As MouseEventArgs) 
Public Event MouseRightButtonClick(ByVal sender As Object, ByVal e As MouseEventArgs) 
Private Delegate Function MouseHookCallback(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer 
Private MouseHookCallbackDelegate As MouseHookCallback 
Private MouseHookID As Integer 
<DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _ 
Public Shared Function GetModuleHandle(ByVal lpModuleName As String) As IntPtr 
End Function 


Public Sub New() 
    If MouseHookID = 0 Then 
     MouseHookCallbackDelegate = AddressOf MouseHookProc 
     MouseHookID = SetWindowsHookEx(CInt(14), MouseHookCallbackDelegate, GetModuleHandle(Process.GetCurrentProcess().MainModule.ModuleName), 0) 
     If MouseHookID = 0 Then 
      'error 
      'MsgBox("yok") 
     End If 
    End If 
End Sub 
Public Sub Dispose() 
    If Not MouseHookID = -1 Then 
     UnhookWindowsHookEx(MouseHookID) 
     MouseHookCallbackDelegate = Nothing 
    End If 
    MouseHookID = -1 

End Sub 

<StructLayout(LayoutKind.Sequential)> _ 
Private Structure Point 
    Public x As Integer 
    Public y As Integer 
End Structure 
<StructLayout(LayoutKind.Sequential)> _ 
Private Structure MouseHookStruct 
    Public pt As Point 
    Public hwnd As Integer 
    Public wHitTestCode As Integer 
    Public dwExtraInfo As Integer 
End Structure 
<DllImport("user32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _ 
Private Shared Function CallNextHookEx(_ 
    ByVal idHook As Integer, _ 
    ByVal nCode As Integer, _ 
    ByVal wParam As IntPtr, _ 
     ByVal lParam As IntPtr) As Integer 
End Function 
<DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall, SetLastError:=True)> _ 
Private Shared Function SetWindowsHookEx _ 
     (ByVal idHook As Integer, ByVal HookProc As MouseHookCallback, _ 
     ByVal hInstance As IntPtr, ByVal wParam As Integer) As Integer 
End Function 
<DllImport("user32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall, SetLastError:=True)> _ 
Private Shared Function UnhookWindowsHookEx(ByVal idHook As Integer) As Integer 
End Function 
Private Function MouseHookProc(ByVal nCode As Integer, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer 
    Dim aa, bb, cc, dd As Integer 

    Try 
     If nCode < 0 Then 
      Return CallNextHookEx(MouseHookID, nCode, wParam, lParam) 
     End If 

     Dim MouseData As MouseHookStruct = Marshal.PtrToStructure(lParam, GetType(MouseHookStruct)) 
     Select Case wParam 
      Case 514 

        Globals.ThisAddIn.dort() 

      Case 522 

        Globals.ThisAddIn.dort() 


       'Case 516 
       'RaiseEvent MouseRightButtonClick(Nothing, New MouseEventArgs(MouseButtons.Right, 1, MouseData.pt.x, MouseData.pt.y, 0)) 
       'Globals.ThisAddIn.Application.Cells(1, 1) = "right" 
       'MsgBox(Globals.ThisAddIn.Application.WindowState.ToString) 
     End Select 

     Return CallNextHookEx(MouseHookID, nCode, wParam, lParam) 
    Catch ex As Exception 
     MsgBox("mousehata") 
    End Try 

ответ

1

Кажется, что вы просто пытаетесь найти пример, который работает вместо того, чтобы научиться понимать понятия, чтобы развивать свой собственный с нуля, то я поделюсь мыши крюк решение, которое я написанное время назад.

Обратите внимание, что я удалил большую (неосуществимую) документацию из исходного кода, потому что ограничение на символ для публикации кода.

Что касается примечания, я разработал приложение, в котором я использовал этот код, приложение продолжает работать весь день на моем ПК, и оно никогда не разбилось.

Пожалуйста, попробуйте.

Пример использования

Private WithEvents mouseEvents As New MouseHook(Install:=False) With 
    { 
     .WorkingArea = SystemInformation.VirtualScreen, 
     .SuppressMouseUpEventWhenDoubleClick = False 
    } 

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load 

    ' Install Mouse Hook on the System. 
    Me.MouseEvents.Install() 

    ' Start processing mouse events. 
    Me.MouseEvents.Enable() 

End Sub 

Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) _ 
Handles MyBase.FormClosing 

    ' Stop processing mouse events. 
    Me.MouseEvents.Disable() 

    ' Uninstall the mouse hook from system. 
    Me.MouseEvents.Uninstall() 

End Sub 

Private Sub MouseEvents_MouseMove(ByVal sender As Object, ByVal MouseLocation As Point) _ 
Handles MouseEvents.MouseMove 

    Debug.WriteLine(String.Format("Mouse Moved To: x={0}, y={1}", 
            CStr(MouseLocation.X), CStr(MouseLocation.Y))) 

End Sub 

Private Sub MouseEvents_MouseLeftDown(ByVal sender As Object, ByVal MouseLocation As Point) _ 
Handles MouseEvents.MouseLeftDown 

    Debug.WriteLine(String.Format("Mouse Left Down At: x={0}, y={1}", 
            CStr(MouseLocation.X), CStr(MouseLocation.Y))) 

End Sub 

Private Sub MouseEvents_MouseLeftUp(ByVal sender As Object, ByVal MouseLocation As Point) _ 
Handles MouseEvents.MouseLeftUp 

    Debug.WriteLine(String.Format("Mouse Left Up At: x={0}, y={1}", 
            CStr(MouseLocation.X), CStr(MouseLocation.Y))) 

End Sub 

Private Sub MouseEvents_MouseRightDown(ByVal sender As Object, ByVal MouseLocation As Point) _ 
Handles MouseEvents.MouseRightDown 

    Debug.WriteLine(String.Format("Mouse Right Down At: x={0}, y={1}", 
            CStr(MouseLocation.X), CStr(MouseLocation.Y))) 

End Sub 

Private Sub MouseEvents_MouseRightUp(ByVal sender As Object, ByVal MouseLocation As Point) _ 
Handles MouseEvents.MouseRightUp 

    Debug.WriteLine(String.Format("Mouse Right Up At: x={0}, y={1}", 
            CStr(MouseLocation.X), CStr(MouseLocation.Y))) 

End Sub 

Источник-код

#Region " Option Statements " 

Option Strict On 
Option Explicit On 
Option Infer Off 

#End Region 

#Region " Imports " 

Imports System.ComponentModel 
Imports System.Reflection 
Imports System.Runtime.InteropServices 

#End Region 

#Region " MouseHook " 

''' <summary> 
''' A low level mouse hook that processes mouse input events. 
''' </summary> 
Friend NotInheritable Class MouseHook : Implements IDisposable 

#Region " P/Invoke " 

    Protected NotInheritable Class NativeMethods 

#Region " Methods " 

     <DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)> 
     Public Shared Function CallNextHookEx(
       ByVal idHook As IntPtr, 
       ByVal nCode As Integer, 
       ByVal wParam As IntPtr, 
       ByVal lParam As IntPtr 
     ) As IntPtr 
     End Function 

     <DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)> 
     Public Shared Function SetWindowsHookEx(
       ByVal idHook As HookType, 
       ByVal lpfn As LowLevelMouseProcDelegate, 
       ByVal hInstance As IntPtr, 
       ByVal threadId As UInteger 
     ) As IntPtr 
     End Function 

     <DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)> 
     Public Shared Function UnhookWindowsHookEx(
       ByVal idHook As IntPtr 
     ) As Boolean 
     End Function 

     <DllImport("user32.dll", CharSet:=CharSet.Auto)> 
     Public Shared Function GetDoubleClickTime() As Integer 
     End Function 

#End Region 

#Region " Enumerations " 

     Public Enum WindowsMessages As UInteger 

      WM_MOUSEMOVE = &H200UI 
      WM_LBUTTONDOWN = &H201UI 
      WM_LBUTTONUP = &H202UI 
      WM_RBUTTONDOWN = &H204UI 
      WM_RBUTTONUP = &H205UI 
      WM_MBUTTONDOWN = &H207UI 
      WM_MBUTTONUP = &H208UI 
      WM_MOUSEWHEEL = &H20AUI 

     End Enum 

     Public Enum HookType As UInteger 

      ' ************************************** 
      ' This enumeration is partially defined. 
      ' ************************************** 

      ''' <summary> 
      ''' Installs a hook procedure that monitors low-level mouse input events. 
      ''' For more information, see the LowLevelMouseProc hook procedure. 
      ''' </summary> 
      WH_MOUSE_LL = 14UI 

     End Enum 

     <Flags()> 
     Public Enum MsllHookStructFlags As Integer 

      ''' <summary> 
      ''' Test the event-injected (from any process) flag. 
      ''' </summary> 
      LLMHF_INJECTED = 1I 

      ''' <summary> 
      ''' Test the event-injected (from a process running at lower integrity level) flag. 
      ''' </summary> 
      LLMHF_LOWER_IL_INJECTED = 2I 

     End Enum 

#End Region 

#Region " Structures " 

     ''' <summary> 
     ''' The POINT structure defines the x- and y- coordinates of a point. 
     ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/dd162805%28v=vs.85%29.aspx 
     ''' </summary> 
     <StructLayout(LayoutKind.Sequential)> 
     Public Structure Point 

      Public X As Integer 
      Public Y As Integer 

     End Structure 

     Public Structure MsllHookStruct 

      ''' <summary> 
      ''' The ptThe x- and y-coordinates of the cursor, in screen coordinates. 
      ''' </summary> 
      Public Pt As NativeMethods.Point 

      ''' <summary> 
      ''' If the message is 'WM_MOUSEWHEEL', the high-order word of this member is the wheel delta. 
      ''' The low-order word is reserved. 
      ''' A positive value indicates that the wheel was rotated forward, away from the user; 
      ''' a negative value indicates that the wheel was rotated backward, toward the user. 
      ''' One wheel click is defined as 'WHEEL_DELTA', which is '120'. 
      ''' </summary> 
      Public MouseData As Integer 

      ''' <summary> 
      ''' The event-injected flag. 
      ''' </summary> 
      Public Flags As MsllHookStructFlags 

      ''' <summary> 
      ''' The time stamp for this message. 
      ''' </summary> 
      Public Time As UInteger 

      ''' <summary> 
      ''' Additional information associated with the message. 
      ''' </summary> 
      Public DwExtraInfo As IntPtr 

     End Structure 

#End Region 

#Region " Delegates " 

     ''' <summary> 
     ''' Delegate LowLevelMouseProc 
     ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644986%28v=vs.85%29.aspx 
     ''' </summary> 
     ''' <returns> 
     ''' If nCode is less than zero, the hook procedure must return the value returned by CallNextHookEx. 
     ''' If nCode is greater than or equal to zero, and the hook procedure did not process the message, 
     ''' it is highly recommended that you call CallNextHookEx and return the value it returns; 
     ''' otherwise, other applications that have installed WH_MOUSE_LL hooks will not receive hook notifications 
     ''' and may behave incorrectly as a result. 
     ''' If the hook procedure processed the message, 
     ''' it may return a nonzero value to prevent the system from passing the message to the rest of the hook chain or the target window procedure. 
     ''' </returns> 
     Public Delegate Function LowLevelMouseProcDelegate(
       ByVal nCode As Integer, 
       ByVal wParam As NativeMethods.WindowsMessages, 
       ByVal lParam As IntPtr 
     ) As Integer 

#End Region 

    End Class 

#End Region 

#Region " Properties " 

    ''' <summary> 
    ''' Handle to the hook procedure. 
    ''' </summary> 
    Private Property MouseHook As IntPtr 

    ''' <summary> 
    ''' The mouse hook delegate. 
    ''' </summary> 
    Private Property MouseHookDelegate As NativeMethods.LowLevelMouseProcDelegate 

    ''' <summary> 
    ''' Determines whether the Hook is installed. 
    ''' </summary> 
    Public Property IsInstalled As Boolean 

    ''' <summary> 
    ''' Determines whether the Hook is enabled. 
    ''' </summary> 
    Public Property IsEnabled As Boolean = False 

    ''' <summary> 
    ''' ** ONLY FOR TESTING PURPOSES ** 
    ''' Gets or sets a value indicating whether to suppress the last MouseUp event of 
    ''' the specified clicked button when a double-click fires. 
    ''' 
    ''' If this value is set to <c>true</c>, the application will send the events in this order for a Double-Click: 
    ''' MouseDown, MouseUp, MouseDown, MouseDoubleClick 
    ''' 
    ''' If this value is set to <c>false</c>, the application will send the events in this order for a Double-Click: 
    ''' MouseDown, MouseUp, MouseDown, MouseUp, MouseDoubleClick 
    ''' 
    ''' </summary> 
    ''' <value><c>true</c> if MouseUp event is suppressed; otherwise <c>false</c>.</value> 
    Public Property SuppressMouseUpEventWhenDoubleClick As Boolean = False 

    ''' <summary> 
    ''' Gets or sets the screen's working area. 
    ''' The events fired by this <see cref="MouseHook"/> instance will be restricted to the bounds of the specified rectangle. 
    ''' </summary> 
    ''' <value>The screen's working area.</value> 
    Public Property WorkingArea As Rectangle 
     Get 
      Return Me.workingarea1 
     End Get 
     Set(ByVal value As Rectangle) 
      Me.workingarea1 = value 
     End Set 
    End Property 

    ''' <summary> 
    ''' The screen's working area 
    ''' </summary> 
    Private workingarea1 As Rectangle = SystemInformation.VirtualScreen 

#End Region 

#Region " Enumerations " 

    ''' <summary> 
    ''' Indicates the whell direction of the mouse. 
    ''' </summary> 
    Public Enum WheelDirection As Integer 

     ''' <summary> 
     ''' The wheel is moved up. 
     ''' </summary> 
     WheelUp = 1I 

     ''' <summary> 
     ''' The wheel is moved down. 
     ''' </summary> 
     WheelDown = 2I 

    End Enum 

#End Region 

#Region " Events " 

    Public Event MouseMove(ByVal sender As Object, 
          ByVal mouseLocation As Point) 

    Public Event MouseLeftDown(ByVal sender As Object, 
           ByVal mouseLocation As Point) 

    Public Event MouseLeftUp(ByVal sender As Object, 
          ByVal mouseLocation As Point) 

    Public Event MouseLeftDoubleClick(ByVal sender As Object, 
             ByVal mouseLocation As Point) 

    Public Event MouseRightDown(ByVal sender As Object, 
           ByVal mouseLocation As Point) 

    Public Event MouseRightUp(ByVal sender As Object, 
           ByVal mouseLocation As Point) 

    Public Event MouseRightDoubleClick(ByVal sender As Object, 
             ByVal mouseLocation As Point) 

    Public Event MouseMiddleDown(ByVal sender As Object, 
           ByVal mouseLocation As Point) 

    Public Event MouseMiddleUp(ByVal sender As Object, 
           ByVal mouseLocation As Point) 

    Public Event MouseMiddleDoubleClick(ByVal sender As Object, 
             ByVal mouseLocation As Point) 

    Public Event MouseWheel(ByVal sender As Object, 
          ByVal mouseLocation As Point, 
          ByVal wheelDirection As WheelDirection) 

#End Region 

#Region " Exceptions " 

    ''' <summary> 
    ''' Exception that is thrown when trying to enable or uninstall a mouse hook that is not installed. 
    ''' </summary> 
    <Serializable> 
    Friend NotInheritable Class MouseHookNotInstalledException : Inherits Exception 

     Friend Sub New() 
      MyBase.New("MouseHook is not installed.") 
     End Sub 

     Friend Sub New(message As String) 
      MyBase.New(message) 
     End Sub 

     Friend Sub New(message As String, inner As Exception) 
      MyBase.New(message, inner) 
     End Sub 

    End Class 

    ''' <summary> 
    ''' Exception that is thrown when trying to disable a mouse hook that is not enabled. 
    ''' </summary> 
    <Serializable> 
    Friend NotInheritable Class MouseHookNotEnabledException : Inherits Exception 

     Friend Sub New() 
      MyBase.New("MouseHook is not enabled.") 
     End Sub 

     Friend Sub New(message As String) 
      MyBase.New(message) 
     End Sub 

     Friend Sub New(message As String, inner As Exception) 
      MyBase.New(message, inner) 
     End Sub 

    End Class 

    ''' <summary> 
    ''' Exception that is thrown when trying to enable a mouse hook that is already enabled. 
    ''' </summary> 
    <Serializable> 
    Friend NotInheritable Class MouseHookEnabledException : Inherits Exception 

     Friend Sub New() 
      MyBase.New("MouseHook is already enabled.") 
     End Sub 

     Friend Sub New(message As String) 
      MyBase.New(message) 
     End Sub 

     Friend Sub New(message As String, inner As Exception) 
      MyBase.New(message, inner) 
     End Sub 

    End Class 

#End Region 

#Region " Constructors " 

    Private Sub New() 
    End Sub 

    ''' <summary> 
    ''' Initializes a new instance of the <see cref="MouseHook"/> class. 
    ''' </summary> 
    ''' <param name="Install"> 
    ''' If set to <c>true</c>, the Hook starts initialized for this <see cref="MouseHook"/> instance. 
    ''' </param> 
    Public Sub New(Optional ByVal install As Boolean = False) 

     If install Then 
      Me.Install() 
     End If 

    End Sub 

#End Region 

#Region " Public Methods " 

    ''' <summary> 
    ''' Installs the Mouse Hook, then start processing messages to fire events. 
    ''' </summary> 
    Public Sub Install() 

     If Me.IsVisualStudioHostingProcessEnabled() Then 
      Throw New Exception("Visual Studio Hosting Process should be deactivated.") 
      Exit Sub 
     End If 

     Me.MouseHookDelegate = New NativeMethods.LowLevelMouseProcDelegate(AddressOf LowLevelMouseProc) 

     Try 
      Me.MouseHook = NativeMethods.SetWindowsHookEx(NativeMethods.HookType.WH_MOUSE_LL, 
                  Me.MouseHookDelegate, 
                  New IntPtr(Marshal.GetHINSTANCE(Assembly.GetExecutingAssembly.GetModules()(0)).ToInt32), 0) 

      Me.IsInstalled = True 

     Catch ex As Exception 
      Throw 

     End Try 

    End Sub 

    ''' <summary> 
    ''' Uninstalls the Mouse Hook and free all resources, then stop processing messages to fire events. 
    ''' </summary> 
    Public Sub Uninstall() 

     If Not Me.IsInstalled Then 
      Throw New MouseHookNotInstalledException 

     Else 
      Me.IsEnabled = False 
      Me.IsInstalled = False 
      Me.Finalize() 

     End If 

    End Sub 

    ''' <summary> 
    ''' Temporally disables the Mouse Hook events. 
    ''' To Re-enable the events, call the <see cref="Enable"/> method. 
    ''' </summary> 
    Public Sub Disable() 

     If Not Me.IsInstalled Then 
      Throw New MouseHookNotInstalledException 

     ElseIf Not Me.IsEnabled Then 
      Throw New MouseHookNotEnabledException 

     Else 
      Me.IsEnabled = False 

     End If 

    End Sub 

    ''' <summary> 
    ''' Re-enables the Mouse Hook events. 
    ''' </summary> 
    Public Sub Enable() 

     If Not Me.IsInstalled Then 
      Throw New MouseHookNotInstalledException 

     ElseIf Me.IsEnabled Then 
      Throw New MouseHookEnabledException 

     Else 
      Me.IsEnabled = True 

     End If 

    End Sub 

#End Region 

#Region " Private Methods " 

    ''' <summary> 
    ''' Determines whether the Visual Studio Hosting Process is enabled on the current application. 
    ''' </summary> 
    ''' <returns><c>true</c> if Visual Studio Hosting Process is enabled; otherwise, <c>false</c>.</returns> 
    Private Function IsVisualStudioHostingProcessEnabled() As Boolean 
     Return AppDomain.CurrentDomain.FriendlyName.EndsWith("vshost.exe", StringComparison.OrdinalIgnoreCase) 
    End Function 

    Private Function LowLevelMouseProc(ByVal nCode As Integer, 
             ByVal wParam As NativeMethods.WindowsMessages, 
             ByVal lParam As IntPtr) As Integer 

     If Not Me.IsEnabled Then 
      Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam)) 
     End If 

     Static leftClickTime As Integer = 0I ' Determines a left button double-click. 
     Static rightClickTime As Integer = 0I ' Determines a right button double-click. 
     Static middleClickTime As Integer = 0I ' Determines a middle button double-click. 

     If nCode = 0I Then 

      Dim x As Integer 
      Dim y As Integer 

      Dim mouseStruct As NativeMethods.MsllHookStruct 
      mouseStruct = CType(Marshal.PtrToStructure(lParam, mouseStruct.GetType()), 
           NativeMethods.MsllHookStruct) 

      ' Fix X coordinate. 
      Select Case mouseStruct.Pt.X 

       Case Is <= 0I 
        If mouseStruct.Pt.X >= Me.WorkingArea.Location.X Then 
         x = mouseStruct.Pt.X 

        ElseIf mouseStruct.Pt.X <= Me.WorkingArea.Location.X Then 

         If mouseStruct.Pt.X <= (Me.WorkingArea.Location.X - Me.WorkingArea.Width) Then 
          x = (Me.WorkingArea.Location.X - Me.WorkingArea.Width) 
         Else 
          x = mouseStruct.Pt.X 

         End If 

        End If 

       Case Is >= Me.WorkingArea.Width 
        x = Me.WorkingArea.Width 

       Case Else 
        x = mouseStruct.Pt.X 

      End Select 

      ' Fix Y coordinate. 
      Select Case mouseStruct.Pt.Y 

       Case Is >= Me.WorkingArea.Height 
        y = Me.WorkingArea.Height 

       Case Is <= 0I 
        y = 0I 

       Case Else 
        y = mouseStruct.Pt.Y 

      End Select 

      If x <= Me.WorkingArea.Width AndAlso 
       y < Me.WorkingArea.Height AndAlso 
       mouseStruct.Pt.X > Me.WorkingArea.Width Then 
       Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam)) 

      ElseIf x <= Me.WorkingArea.Width AndAlso 
        y < Me.WorkingArea.Height AndAlso 
        mouseStruct.Pt.X < Me.WorkingArea.X Then 
       Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam)) 

      ElseIf x = Me.WorkingArea.Width AndAlso 
        y < Me.WorkingArea.Height Then 

       If Not Me.WorkingArea.Contains(x - 1, y) Then 
        Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam)) 
       End If 

      ElseIf x < Me.WorkingArea.Width AndAlso 
        y = Me.WorkingArea.Height Then 

       If Not Me.WorkingArea.Contains(x, y - 1) Then 
        Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam)) 
       End If 

      End If 

      Select Case wParam 

       Case NativeMethods.WindowsMessages.WM_MOUSEMOVE 
        RaiseEvent MouseMove(Me, New Point(x, y)) 

       Case NativeMethods.WindowsMessages.WM_LBUTTONDOWN 
        RaiseEvent MouseLeftDown(Me, New Point(x, y)) 

       Case NativeMethods.WindowsMessages.WM_LBUTTONUP 
        If leftClickTime <> 0 Then 
         leftClickTime = Environment.TickCount() - leftClickTime 
        End If 

        If (leftClickTime <> 0I) AndAlso (leftClickTime < NativeMethods.GetDoubleClickTime()) Then 
         leftClickTime = 0I 
         If Not Me.SuppressMouseUpEventWhenDoubleClick Then 
          RaiseEvent MouseLeftUp(Me, New Point(x, y)) 
         End If 
         RaiseEvent MouseLeftDoubleClick(Me, New Point(x, y)) 

        Else 
         leftClickTime = Environment.TickCount() 
         RaiseEvent MouseLeftUp(Me, New Point(x, y)) 

        End If 

       Case NativeMethods.WindowsMessages.WM_RBUTTONDOWN 
        RaiseEvent MouseRightDown(Me, New Point(x, y)) 

       Case NativeMethods.WindowsMessages.WM_RBUTTONUP 
        If rightClickTime <> 0I Then 
         rightClickTime = Environment.TickCount() - rightClickTime 
        End If 

        If (rightClickTime <> 0I) AndAlso (rightClickTime < NativeMethods.GetDoubleClickTime()) Then 
         rightClickTime = 0I 
         If Not Me.SuppressMouseUpEventWhenDoubleClick Then 
          RaiseEvent MouseRightUp(Me, New Point(x, y)) 
         End If 
         RaiseEvent MouseRightDoubleClick(Me, New Point(x, y)) 

        Else 
         rightClickTime = Environment.TickCount() 
         RaiseEvent MouseRightUp(Me, New Point(x, y)) 

        End If 

       Case NativeMethods.WindowsMessages.WM_MBUTTONDOWN 
        RaiseEvent MouseMiddleDown(Me, New Point(x, y)) 

       Case NativeMethods.WindowsMessages.WM_MBUTTONUP 
        If middleClickTime <> 0I Then 
         middleClickTime = Environment.TickCount() - middleClickTime 
        End If 

        If (middleClickTime <> 0I) AndAlso (middleClickTime < NativeMethods.GetDoubleClickTime()) Then 
         middleClickTime = 0I 
         If Not Me.SuppressMouseUpEventWhenDoubleClick Then 
          RaiseEvent MouseMiddleUp(Me, New Point(x, y)) 
         End If 
         RaiseEvent MouseMiddleDoubleClick(Me, New Point(x, y)) 

        Else 
         middleClickTime = Environment.TickCount() 
         RaiseEvent MouseMiddleUp(Me, New Point(x, y)) 

        End If 

       Case NativeMethods.WindowsMessages.WM_MOUSEWHEEL 
        RaiseEvent MouseWheel(Me, New Point(x, y), If(mouseStruct.MouseData < 0I, 
                   WheelDirection.WheelDown, 
                   WheelDirection.WheelUp)) 

       Case Else 
        ' Do Nothing 
        Exit Select 

      End Select 

      Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam)) 

     ElseIf nCode < 0I Then 
      Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam)) 

     Else ' nCode > 0 
      Return CInt(NativeMethods.CallNextHookEx(MouseHook, nCode, New IntPtr(wParam), lParam)) 

     End If 

    End Function 

#End Region 

#Region "IDisposable Support" 

    ''' <summary> 
    ''' Flag to detect redundant calls at <see cref="Dispose"/> method. 
    ''' </summary> 
    Private disposedValue As Boolean 

    Protected Sub Dispose(ByVal disposing As Boolean) 

     Me.IsEnabled = False 

     If Not Me.disposedValue Then 

      If disposing Then ' Dispose managed state (managed objects). 

      Else ' Free unmanaged resources (unmanaged objects). 
       NativeMethods.UnhookWindowsHookEx(Me.MouseHook) 

      End If 

     End If 

     Me.disposedValue = True 

    End Sub 

    Protected Overrides Sub Finalize() 

     ' Do not change this code. Put cleanup code in method: Dispose(ByVal disposing As Boolean) 

     Me.Dispose(disposing:=False) 
     MyBase.Finalize() 

    End Sub 

    Private Sub Dispose() Implements IDisposable.Dispose 

     ' Do not change this code. Put cleanup code in method: Dispose(ByVal disposing As Boolean) 

     Me.Dispose(disposing:=True) 
     GC.SuppressFinalize(obj:=Me) 

    End Sub 

#End Region 

End Class 

#End Region 
+0

вы не понравилось 'AA, BB, CC, dd' ?? – Plutonix

+1

Просто было смешно видеть, что: P – ElektroStudios

+0

:) Ок, люди, мой код еще не закончен, я избавлюсь от целых чисел позже. Но большое спасибо за ответ, сейчас здесь 6:30, я проведу его после некоторого сна. Это было бы огромным шагом для моего приложения, если бы это было так, так что еще раз спасибо. –

 Смежные вопросы

  • Нет связанных вопросов^_^