Inzample Inzample - 1 year ago 52 Question

Not sure what is causing this

So I have this all inside a timer that runs every 80 ms and for some reason when this function activates, it SOMETIMES get stuck and keeps going even though I'm not holding down left click. I also tried adding a second check (clickdone) but it's still doing it. What's causing it here I think is the delay but I kind of need that delay so if anyone here could help me by adding another check or something that fixes this, it would be appreciated! Here is my code:

Sub MyDelay()
Dim randomlul As New Random
Dim ezdelay As Integer
ezdelay = randomlul.Next(private delay, private delay)

Dim iCount As Integer = 1
For iCount = 1 To ezdelay
iCount = iCount + 1
End Sub

Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
If CheckBox2.Checked = True Then
hotkey = GetAsyncKeyState(Keys.LButton)
If CBool(hotkey) Then
If (clickdone = True) Then
mouse_event(mouse_downclick, 0, 0, 0, 0)
clickdone = False
clickdone = True
mouse_event(mouse_upclick, 0, 0, 0, 0)
End If
End If
End If
End Sub

This is not a duplicate of that post that was linked, I tried that other solution but it messed up my other functions so now I have to make a counting delay which doesnt mess up the other functions but now the problem is that the getasynckeystate keeps looping sometimes

Answer Source

The reason it gets stuck is because GetAsyncKeyState() reads the virtual mouse and keyboard input stream, not the state of the physical key. Thus the code will keep executing since it notices more clicks in the input stream.

As stated in a previous answer of mine you must send the mouse clicks as window messages instead since they won't get noticed by GetAsyncKeyState().

Here is a modified version of my code that uses PostMessage instead of SendMessage in order to decrease code interruption. I also modified the SendMouseClick() method so that you can choose to send DOWN or UP on your own.

Imports System.Runtime.InteropServices

Public NotInheritable Class MouseInputHelper
    Private Sub New()
    End Sub

#Region "Methods"
#Region "SendMouseClick()"
    ''' <summary>
    ''' Sends a Window Message-based mouse click to the specified coordinates of the screen.
    ''' </summary>
    ''' <param name="Button">The button to press.</param>
    ''' <param name="Location">The position where to send the click (in screen coordinates).</param>
    ''' <param name="MouseDown">Whether to send a BUTTONDOWN or BUTTONUP message.</param>
    ''' <remarks></remarks>
    Public Shared Sub SendMouseClick(ByVal Button As MouseButtons, ByVal Location As Point, ByVal MouseDown As Boolean)
        Dim hWnd As IntPtr = NativeMethods.WindowFromPoint(New NativeMethods.NATIVEPOINT(Location.X, Location.Y)) 'Get the window at the specified click point.
        Dim ButtonMessage As NativeMethods.MouseButtonMessages = NativeMethods.MouseButtonMessages.None 'A variable holding which Window Message to use.

        Select Case Button 'Set the appropriate mouse button Window Message.
            Case MouseButtons.Left : ButtonMessage = NativeMethods.MouseButtonMessages.WM_LBUTTONDOWN
            Case MouseButtons.Right : ButtonMessage = NativeMethods.MouseButtonMessages.WM_RBUTTONDOWN
            Case MouseButtons.Middle : ButtonMessage = NativeMethods.MouseButtonMessages.WM_MBUTTONDOWN
            Case MouseButtons.XButton1, MouseButtons.XButton2
                ButtonMessage = NativeMethods.MouseButtonMessages.WM_XBUTTONDOWN
            Case Else
                Throw New InvalidOperationException("Invalid mouse button " & Button.ToString())
        End Select

        Dim ClickPoint As New NativeMethods.NATIVEPOINT(Location.X, Location.Y) 'Create a native point.

        If NativeMethods.ScreenToClient(hWnd, ClickPoint) = False Then 'Convert the click point to client coordinates relative to the window.
            Throw New Exception("Unable to convert screen coordinates to client coordinates! Win32Err: " & _
        End If

        Dim wParam As IntPtr = IntPtr.Zero 'Used to specify which X button was clicked (if any).
        Dim lParam As IntPtr = NativeMethods.CreateLWParam(ClickPoint.X, ClickPoint.Y) 'Click point.

        If Button = MouseButtons.XButton1 OrElse _
            Button = MouseButtons.XButton2 Then
            wParam = NativeMethods.CreateLWParam(0, Button / MouseButtons.XButton1) 'Set the correct XButton.
        End If

        NativeMethods.PostMessage(hWnd, ButtonMessage + If(MouseDown, 0, 1), wParam, lParam)
    End Sub
#End Region
#End Region

#Region "NativeMethods"
    Private NotInheritable Class NativeMethods
        Private Sub New()
        End Sub

        <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
        Public Shared Function PostMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
        End Function

        <DllImport("user32.dll", SetLastError:=True)> _
        Public Shared Function WindowFromPoint(ByVal p As NATIVEPOINT) As IntPtr
        End Function

        <DllImport("user32.dll", SetLastError:=True)> _
        Public Shared Function ScreenToClient(ByVal hWnd As IntPtr, ByRef lpPoint As NATIVEPOINT) As Boolean
        End Function

        <StructLayout(Runtime.InteropServices.LayoutKind.Sequential)> _
        Public Structure NATIVEPOINT
            Public X As Integer
            Public Y As Integer

            Public Sub New(ByVal X As Integer, ByVal Y As Integer)
                Me.X = X
                Me.Y = Y
            End Sub
        End Structure

        Public Shared Function CreateLWParam(LoWord As Integer, HiWord As Integer) As IntPtr
            Return New IntPtr((HiWord << 16) Or (LoWord And &HFFFF))
        End Function

#Region "Enumerations"
        Public Enum MouseButtonMessages As Integer
            None = 0
            WM_LBUTTONDOWN = &H201
            WM_LBUTTONUP = &H202
            WM_MBUTTONDOWN = &H207
            WM_MBUTTONUP = &H208
            WM_RBUTTONDOWN = &H204
            WM_RBUTTONUP = &H205
            WM_XBUTTONDOWN = &H20B
            WM_XBUTTONUP = &H20C
            XBUTTON1 = &H1
            XBUTTON2 = &H2
        End Enum
#End Region
    End Class
#End Region
End Class

Now you should be able to use this like:

Const KeyDownBit As Integer = &H8000

Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
    If (GetAsyncKeyState(Keys.LButton) And KeyDownBit) = KeyDownBit Then
        MouseInputHelper.SendMouseClick(Windows.Forms.MouseButtons.Left, Cursor.Position, True) 'True = Mouse down.

        'Do stuff here...

        MouseInputHelper.SendMouseClick(Windows.Forms.MouseButtons.Left, Cursor.Position, False) 'False = Mouse up.
    End If
End Sub
Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download