Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ' ***********************************************************************
- ' Author : Elektro
- ' Last Modified On : 16-February-2015
- ' ***********************************************************************
- ' <copyright file="MouseHook.vb" company="Elektro Studios">
- ' Copyright (c) Elektro Studios. All rights reserved.
- ' </copyright>
- ' ***********************************************************************
- #Region " Option Statements "
- Option Strict On
- Option Explicit On
- Option Infer Off
- #End Region
- #Region " Instructions "
- ' Go to page:
- ' Project > Properties > Debug
- '
- ' Then uncheck the option:
- ' "Enable the Visual Studio Hosting Process"
- #End Region
- #Region " Usage Examples "
- ' ''' <summary>
- ' ''' A low level mouse hook that intercepts mouse events.
- ' ''' </summary>
- 'Private WithEvents mouseEvents As New MouseHook(Install:=False) With
- ' {
- ' .WorkingArea = SystemInformation.VirtualScreen,
- ' .SuppressMouseUpEventWhenDoubleClick = False
- ' }
- ' ''' <summary>
- ' ''' Handles the Load event of the Form1.
- ' ''' </summary>
- ' ''' <param name="sender">The source of the event.</param>
- ' ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
- '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
- ' ''' <summary>
- ' ''' Handles the FormClosing event of the Form1.
- ' ''' </summary>
- ' ''' <param name="sender">The source of the event.</param>
- ' ''' <param name="e">The <see cref="FormClosingEventArgs"/> instance containing the event data.</param>
- '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
- ' ''' <summary>
- ' ''' Handles the 'MouseMove' event of the Mouse Hook.
- ' ''' </summary>
- ' ''' <param name="sender">The source of the event.</param>
- ' ''' <param name="MouseLocation">Contains the mouse [X,Y] coordinates where the event fired.</param>
- '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
- ' ''' <summary>
- ' ''' Handles the 'MouseLeftDown' event of the MouseHook.
- ' ''' </summary>
- ' ''' <param name="sender">The source of the event.</param>
- ' ''' <param name="MouseLocation">Contains the mouse [X,Y] coordinates where the event fired.</param>
- '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
- ' ''' <summary>
- ' ''' Handles the 'MouseLeftUp' event of the Mouse Hook.
- ' ''' </summary>
- ' ''' <param name="sender">The source of the event.</param>
- ' ''' <param name="MouseLocation">Contains the mouse [X,Y] coordinates where the event fired.</param>
- '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
- ' ''' <summary>
- ' ''' Handles the 'MouseRightDown' event of the MouseHook.
- ' ''' </summary>
- ' ''' <param name="sender">The source of the event.</param>
- ' ''' <param name="MouseLocation">Contains the mouse [X,Y] coordinates where the event fired.</param>
- '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
- ' ''' <summary>
- ' ''' Handles the 'MouseRightUp' event of the Mouse Hook.
- ' ''' </summary>
- ' ''' <param name="sender">The source of the event.</param>
- ' ''' <param name="MouseLocation">Contains the mouse [X,Y] coordinates where the event fired.</param>
- '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
- ' ''' <summary>
- ' ''' Handles the 'MouseMiddleDown' event of the MouseHook.
- ' ''' </summary>
- ' ''' <param name="sender">The source of the event.</param>
- ' ''' <param name="MouseLocation">Contains the mouse [X,Y] coordinates where the event fired.</param>
- 'Private Sub MouseEvents_MouseMiddleDown(ByVal sender As Object, ByVal MouseLocation As Point) _
- 'Handles MouseEvents.MouseMiddleDown
- ' Debug.WriteLine(String.Format("Mouse Middle Down At: x={0}, y={1}",
- ' CStr(MouseLocation.X), CStr(MouseLocation.Y)))
- 'End Sub
- ' ''' <summary>
- ' ''' Handles the 'MouseMiddleUp' event of the Mouse Hook.
- ' ''' </summary>
- ' ''' <param name="sender">The source of the event.</param>
- ' ''' <param name="MouseLocation">Contains the mouse [X,Y] coordinates where the event fired.</param>
- 'Private Sub MouseEvents_MouseMiddleUp(ByVal sender As Object, ByVal MouseLocation As Point) _
- 'Handles MouseEvents.MouseMiddleUp
- ' Debug.WriteLine(String.Format("Mouse Middle Up At: x={0}, y={1}",
- ' CStr(MouseLocation.X), CStr(MouseLocation.Y)))
- 'End Sub
- ' ''' <summary>
- ' ''' Handles the 'MouseLeftDoubleClick' event of the Mouse Hook.
- ' ''' </summary>
- ' ''' <param name="sender">The source of the event.</param>
- ' ''' <param name="MouseLocation">Contains the mouse [X,Y] coordinates where the event fired.</param>
- 'Private Sub MouseEvents_MouseLeftDoubleClick(ByVal sender As Object, ByVal MouseLocation As Point) _
- 'Handles MouseEvents.MouseLeftDoubleClick
- ' Debug.WriteLine(String.Format("Mouse Left Double-Click At: x={0}, y={1}",
- ' CStr(MouseLocation.X), CStr(MouseLocation.Y)))
- 'End Sub
- ' ''' <summary>
- ' ''' Handles the 'MouseRightDoubleClick' event of the Mouse Hook.
- ' ''' </summary>
- ' ''' <param name="sender">The source of the event.</param>
- ' ''' <param name="MouseLocation">Contains the mouse [X,Y] coordinates where the event fired.</param>
- 'Private Sub MouseEvents_MouseRightDoubleClick(ByVal sender As Object, ByVal MouseLocation As Point) _
- 'Handles MouseEvents.MouseRightDoubleClick
- ' Debug.WriteLine(String.Format("Mouse Right Double-Click At: x={0}, y={1}",
- ' CStr(MouseLocation.X), CStr(MouseLocation.Y)))
- 'End Sub
- ' ''' <summary>
- ' ''' Handles the 'MouseMiddleDoubleClick' event of the Mouse Hook.
- ' ''' </summary>
- ' ''' <param name="sender">The source of the event.</param>
- ' ''' <param name="MouseLocation">Contains the mouse [X,Y] coordinates where the event fired.</param>
- 'Private Sub MouseEvents_MouseMiddleDoubleClick(ByVal sender As Object, ByVal MouseLocation As Point) _
- 'Handles MouseEvents.MouseMiddleDoubleClick
- ' Debug.WriteLine(String.Format("Mouse Middle Double-Click At: x={0}, y={1}",
- ' CStr(MouseLocation.X), CStr(MouseLocation.Y)))
- 'End Sub
- ' ''' <summary>
- ' ''' Handles the 'MouseWheel' event of the Mouse Hook.
- ' ''' </summary>
- ' ''' <param name="sender">The source of the event.</param>
- ' ''' <param name="MouseLocation">Contains the mouse [X,Y] coordinates where the event fired.</param>
- ' ''' <param name="WheelDirection">Contains the wheel direction (WheelUp or WheelDown).</param>
- 'Private Sub MouseEvents_MouseWheel(ByVal sender As Object,
- ' ByVal MouseLocation As Point,
- ' ByVal WheelDirection As MouseHook.WheelDirection) _
- 'Handles MouseEvents.MouseWheel
- ' Debug.WriteLine(String.Format("Mouse Whell ({0}) At: x={1}, y={2}",
- ' WheelDirection.ToString, CStr(MouseLocation.X), CStr(MouseLocation.Y)))
- 'End Sub
- #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 "
- ''' <summary>
- ''' Platform Invocation methods (P/Invoke), access unmanaged code.
- ''' This class does not suppress stack walks for unmanaged code permission.
- ''' <see cref="System.Security.SuppressUnmanagedCodeSecurityAttribute"/> must not be applied to this class.
- ''' This class is for methods that can be used anywhere because a stack walk will be performed.
- ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/ms182161.aspx
- ''' </summary>
- Protected NotInheritable Class NativeMethods
- #Region " Methods "
- ''' <summary>
- ''' Passes the hook information to the next hook procedure in the current hook chain.
- ''' A hook procedure can call this function either before or after processing the hook information.
- ''' For more info see here:
- ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms644974%28v=vs.85%29.aspx
- ''' </summary>
- ''' <param name="idHook">
- ''' This parameter is ignored.
- ''' </param>
- ''' <param name="nCode">
- ''' The hook code passed to the current hook procedure.
- ''' The next hook procedure uses this code to determine how to process the hook information.
- ''' </param>
- ''' <param name="wParam">
- ''' The wParam value passed to the current hook procedure.
- ''' The meaning of this parameter depends on the type of hook associated with the current hook chain.
- ''' </param>
- ''' <param name="lParam">
- ''' The lParam value passed to the current hook procedure.
- ''' The meaning of this parameter depends on the type of hook associated with the current hook chain.
- ''' </param>
- ''' <returns>
- ''' This value is returned by the next hook procedure in the chain.
- ''' The current hook procedure must also return this value.
- ''' The meaning of the return value depends on the hook type.
- ''' For more information, see the descriptions of the individual hook procedures.
- ''' </returns>
- <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
- ''' <summary>
- ''' Installs an application-defined hook procedure into a hook chain.
- ''' You would install a hook procedure to monitor the system for certain types of events.
- ''' These events are associated either with a specific thread
- ''' or with all threads in the same desktop as the calling thread.
- ''' For more info see here:
- ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms644990%28v=vs.85%29.aspx
- ''' </summary>
- ''' <param name="idHook">
- ''' The type of hook procedure to be installed.
- ''' </param>
- ''' <param name="lpfn">
- ''' A pointer to the hook procedure.
- ''' If the dwThreadId parameter is zero or specifies the identifier of a thread created by a different process,
- ''' the lpfn parameter must point to a hook procedure in a DLL.
- ''' Otherwise, lpfn can point to a hook procedure in the code associated with the current process.
- ''' </param>
- ''' <param name="hInstance">
- ''' A handle to the DLL containing the hook procedure pointed to by the lpfn parameter.
- ''' The hMod parameter must be set to NULL if the dwThreadId parameter specifies a thread created by
- ''' the current process and if the hook procedure is within the code associated with the current process.
- ''' </param>
- ''' <param name="threadId">
- ''' The identifier of the thread with which the hook procedure is to be associated.
- ''' For desktop apps, if this parameter is zero, the hook procedure is associated
- ''' with all existing threads running in the same desktop as the calling thread.
- ''' </param>
- ''' <returns>
- ''' If the function succeeds, the return value is the handle to the hook procedure.
- ''' If the function fails, the return value is NULL.
- ''' </returns>
- <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
- ''' <summary>
- ''' Removes a hook procedure installed in a hook chain by the 'SetWindowsHookEx' function.
- ''' For more info see here:
- ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms644993%28v=vs.85%29.aspx
- ''' </summary>
- ''' <param name="idHook">
- ''' A handle to the hook to be removed.
- ''' This parameter is a hook handle obtained by a previous call to SetWindowsHookEx.
- ''' </param>
- ''' <returns>
- ''' If the function succeeds, the return value is nonzero.
- ''' If the function fails, the return value is zero.
- ''' </returns>
- <DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto)>
- Public Shared Function UnhookWindowsHookEx(
- ByVal idHook As IntPtr
- ) As Boolean
- End Function
- ''' <summary>
- ''' Retrieves the current double-click time for the mouse.
- ''' A double-click is a series of two clicks of the mouse button,
- ''' the second occurring within a specified time after the first.
- ''' The double-click time is the maximum number of milliseconds that may occur
- ''' between the first and second click of a double-click.
- ''' The maximum double-click time is 5000 milliseconds.
- ''' </summary>
- ''' <returns>
- ''' The return value specifies the current double-click time, in milliseconds.
- ''' The maximum return value is 5000 milliseconds.
- ''' </returns>
- <DllImport("user32.dll", CharSet:=CharSet.Auto)>
- Public Shared Function GetDoubleClickTime() As Integer
- End Function
- #End Region
- #Region " Enumerations "
- ''' <summary>
- ''' Specifies a System-Defined Message.
- ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644927%28v=vs.85%29.aspx#system_defined
- ''' </summary>
- Public Enum WindowsMessages As UInteger
- ''' <summary>
- ''' Posted to a window when the cursor moves.
- ''' If the mouse is not captured, the message is posted to the window that contains the cursor.
- ''' Otherwise, the message is posted to the window that has captured the mouse
- ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ff468877%28v=vs.85%29.aspx
- ''' </summary>
- WM_MOUSEMOVE = &H200UI
- ''' <summary>
- ''' Posted when the user presses the left mouse button while the cursor is in the client area of a window.
- ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
- ''' Otherwise, the message is posted to the window that has captured the mouse
- ''' </summary>
- WM_LBUTTONDOWN = &H201UI
- ''' <summary>
- ''' Posted when the user releases the left mouse button while the cursor is in the client area of a window.
- ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
- ''' Otherwise, the message is posted to the window that has captured the mouse
- ''' </summary>
- WM_LBUTTONUP = &H202UI
- ''' <summary>
- ''' Posted when the user presses the right mouse button while the cursor is in the client area of a window.
- ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
- ''' Otherwise, the message is posted to the window that has captured the mouse
- ''' </summary>
- WM_RBUTTONDOWN = &H204UI
- ''' <summary>
- ''' Posted when the user releases the right mouse button while the cursor is in the client area of a window.
- ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
- ''' Otherwise, the message is posted to the window that has captured the mouse
- ''' </summary>
- WM_RBUTTONUP = &H205UI
- ''' <summary>
- ''' Posted when the user presses the middle mouse button while the cursor is in the client area of a window.
- ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
- ''' Otherwise, the message is posted to the window that has captured the mouse
- ''' </summary>
- WM_MBUTTONDOWN = &H207UI
- ''' <summary>
- ''' Posted when the user releases the middle mouse button while the cursor is in the client area of a window.
- ''' If the mouse is not captured, the message is posted to the window beneath the cursor.
- ''' Otherwise, the message is posted to the window that has captured the mouse
- ''' </summary>
- WM_MBUTTONUP = &H208UI
- ''' <summary>
- ''' Sent to the active window when the mouse's horizontal scroll wheel is tilted or rotated.
- ''' The DefWindowProc function propagates the message to the window's parent.
- ''' There should be no internal forwarding of the message,
- ''' since DefWindowProc propagates it up the parent chain until it finds a window that processes it.
- ''' </summary>
- WM_MOUSEWHEEL = &H20AUI
- End Enum
- ''' <summary>
- ''' Indicates a type of Hook procedure to be installed.
- ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644990%28v=vs.85%29.aspx
- ''' </summary>
- 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
- ''' <summary>
- ''' The event-injected flags.
- ''' An application can use the following values to test the flags.
- ''' Testing LLMHF_INJECTED (bit 0) will tell you whether the event was injected.
- ''' If it was, then testing LLMHF_LOWER_IL_INJECTED (bit 1) will tell you
- ''' whether or not the event was injected from a process running at lower integrity level.
- ''' </summary>
- <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
- ''' <summary>
- ''' The x-coordinate of the point.
- ''' </summary>
- Public X As Integer
- ''' <summary>
- ''' The y-coordinate of the point.
- ''' </summary>
- Public Y As Integer
- End Structure
- ''' <summary>
- ''' Contains information about a low-level mouse input event.
- ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644970%28v=vs.85%29.aspx
- ''' </summary>
- 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
- #Region " Hidden Methods "
- ''' <summary>
- ''' Determines whether the specified System.Object instances are considered equal.
- ''' </summary>
- <EditorBrowsable(EditorBrowsableState.Never)>
- Public Shadows Sub Equals()
- End Sub
- ''' <summary>
- ''' Determines whether the specified System.Object instances are the same instance.
- ''' </summary>
- <EditorBrowsable(EditorBrowsableState.Never)>
- Private Shadows Sub ReferenceEquals()
- End Sub
- #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 "
- ''' <summary>
- ''' Occurs when the mouse moves.
- ''' </summary>
- Public Event MouseMove(ByVal sender As Object,
- ByVal mouseLocation As Point)
- ''' <summary>
- ''' Occurs when the mouse left button is pressed.
- ''' </summary>
- Public Event MouseLeftDown(ByVal sender As Object,
- ByVal mouseLocation As Point)
- ''' <summary>
- ''' Occurs when the mouse left button is released.
- ''' </summary>
- Public Event MouseLeftUp(ByVal sender As Object,
- ByVal mouseLocation As Point)
- ''' <summary>
- ''' Occurs when the mouse left button performs a double-click.
- ''' A double click is considered as: (MouseLeftDown + MouseLeftUp) * 2
- ''' </summary>
- Public Event MouseLeftDoubleClick(ByVal sender As Object,
- ByVal mouseLocation As Point)
- ''' <summary>
- ''' Occurs when the mouse right button is pressed.
- ''' </summary>
- Public Event MouseRightDown(ByVal sender As Object,
- ByVal mouseLocation As Point)
- ''' <summary>
- ''' Occurs when the mouse right button is released.
- ''' </summary>
- Public Event MouseRightUp(ByVal sender As Object,
- ByVal mouseLocation As Point)
- ''' <summary>
- ''' Occurs when the mouse right button performs a double-click.
- ''' A double click is considered as: (MouseLeftDown + MouseLeftUp) * 2
- ''' </summary>
- Public Event MouseRightDoubleClick(ByVal sender As Object,
- ByVal mouseLocation As Point)
- ''' <summary>
- ''' Occurs when the mouse middle button is pressed.
- ''' </summary>
- Public Event MouseMiddleDown(ByVal sender As Object,
- ByVal mouseLocation As Point)
- ''' <summary>
- ''' Occurs when the mouse middle button is released.
- ''' </summary>
- Public Event MouseMiddleUp(ByVal sender As Object,
- ByVal mouseLocation As Point)
- ''' <summary>
- ''' Occurs when the mouse middle button performs a double-click.
- ''' A double click is considered as: (MouseLeftDown + MouseLeftUp) * 2
- ''' </summary>
- Public Event MouseMiddleDoubleClick(ByVal sender As Object,
- ByVal mouseLocation As Point)
- ''' <summary>
- ''' Occurs when the mouse wheel is moved up or down.
- ''' </summary>
- 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
- ''' <summary>
- ''' Initializes a new instance of the <see cref="MouseHookNotInstalledException"/> class.
- ''' </summary>
- Friend Sub New()
- MyBase.New("MouseHook is not installed.")
- End Sub
- ''' <summary>
- ''' Initializes a new instance of the <see cref="MouseHookNotInstalledException" /> class with a specified error message.
- ''' </summary>
- ''' <param name="message">The message that describes the error.</param>
- Friend Sub New(message As String)
- MyBase.New(message)
- End Sub
- ''' <summary>
- ''' Initializes a new instance of the <see cref="MouseHookNotInstalledException"/> class.
- ''' </summary>
- ''' <param name="message">The message that describes the error.</param>
- ''' <param name="inner">The inner exception.</param>
- 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
- ''' <summary>
- ''' Initializes a new instance of the <see cref="MouseHookNotEnabledException"/> class.
- ''' </summary>
- Friend Sub New()
- MyBase.New("MouseHook is not enabled.")
- End Sub
- ''' <summary>
- ''' Initializes a new instance of the <see cref="MouseHookNotEnabledException" /> class with a specified error message.
- ''' </summary>
- ''' <param name="message">The message that describes the error.</param>
- Friend Sub New(message As String)
- MyBase.New(message)
- End Sub
- ''' <summary>
- ''' Initializes a new instance of the <see cref="MouseHookNotEnabledException"/> class.
- ''' </summary>
- ''' <param name="message">The message that describes the error.</param>
- ''' <param name="inner">The inner exception.</param>
- 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
- ''' <summary>
- ''' Initializes a new instance of the <see cref="MouseHookEnabledException"/> class.
- ''' </summary>
- Friend Sub New()
- MyBase.New("MouseHook is already enabled.")
- End Sub
- ''' <summary>
- ''' Initializes a new instance of the <see cref="MouseHookEnabledException" /> class with a specified error message.
- ''' </summary>
- ''' <param name="message">The message that describes the error.</param>
- Friend Sub New(message As String)
- MyBase.New(message)
- End Sub
- ''' <summary>
- ''' Initializes a new instance of the <see cref="MouseHookEnabledException"/> class.
- ''' </summary>
- ''' <param name="message">The message that describes the error.</param>
- ''' <param name="inner">The inner exception.</param>
- Friend Sub New(message As String, inner As Exception)
- MyBase.New(message, inner)
- End Sub
- End Class
- #End Region
- #Region " Constructors "
- ''' <summary>
- ''' Prevents a default instance of the <see cref="MouseHook"/> class from being created.
- ''' </summary>
- 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
- ''' <summary>
- ''' Processes the mouse windows messages and raises it's corresponding events.
- ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644986%28v=vs.85%29.aspx
- ''' </summary>
- ''' <param name="nCode">
- ''' A code the hook procedure uses to determine how to process the message.
- ''' If nCode is less than zero, the hook procedure must pass the message to the CallNextHookEx function
- ''' without further processing and should return the value returned by CallNextHookEx.
- ''' </param>
- ''' <param name="wParam">The identifier of the mouse message.</param>
- ''' <param name="lParam"> A pointer to an <see cref="NativeMethods.MSLLHOOKSTRUCT"/> structure.</param>
- ''' <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>
- 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 " Hidden Methods "
- ''' <summary>
- ''' Serves as a hash function for a particular type.
- ''' </summary>
- <EditorBrowsable(EditorBrowsableState.Never)>
- Public Shadows Sub GetHashCode()
- End Sub
- ''' <summary>
- ''' Gets the System.Type of the current instance.
- ''' </summary>
- ''' <returns>The exact runtime type of the current instance.</returns>
- <EditorBrowsable(EditorBrowsableState.Never)>
- Public Shadows Function [GetType]() As Type
- Return Me.GetType
- End Function
- ''' <summary>
- ''' Determines whether the specified System.Object instances are considered equal.
- ''' </summary>
- <EditorBrowsable(EditorBrowsableState.Never)>
- Public Shadows Sub Equals()
- End Sub
- ''' <summary>
- ''' Determines whether the specified System.Object instances are the same instance.
- ''' </summary>
- <EditorBrowsable(EditorBrowsableState.Never)>
- Private Shadows Sub ReferenceEquals()
- End Sub
- ''' <summary>
- ''' Returns a String that represents the current object.
- ''' </summary>
- <EditorBrowsable(EditorBrowsableState.Never)>
- Public Shadows Sub ToString()
- End Sub
- #End Region
- #Region "IDisposable Support"
- ''' <summary>
- ''' Flag to detect redundant calls at <see cref="Dispose"/> method.
- ''' </summary>
- Private disposedValue As Boolean
- ''' <summary>
- ''' Releases unmanaged and optionally managed resources.
- ''' </summary>
- ''' <param name="disposing">
- ''' <c>true</c> to release both managed and unmanaged resources;
- ''' <c>false</c> to release only unmanaged resources.
- ''' </param>
- 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
- ''' <summary>
- ''' Allows an object to try to free resources
- ''' and perform other cleanup operations before it is reclaimed by garbage collection.
- ''' </summary>
- 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
- ''' <summary>
- ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
- ''' </summary>
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement