如何在按住时以编程方式重复键?

时间:2016-12-20 17:46:05

标签: vb.net

我试图在按住LButton时自动重复它,然后在它被释放时停止,我遇到了一个问题,即使它没有按下它也会不断重复。

这有什么变通方法吗?我还需要它来处理其他应用程序,这就是我使用GetAsyncKeyState

的原因

这是我到目前为止所做的:

Imports System.Threading

Public Class Form1
   Const KeyDownBit As Integer = &H8000
   Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Integer) As Short
   Private Declare Sub mouse_event Lib "user32" (ByVal dwflags As Integer, ByVal dx As Integer, ByVal cbuttons As Integer, ByVal dy As Integer, ByVal dwExtraInfo As Integer)
   Private Const mouseclickup = 4
   Private Const mouseclickdown = 2

   Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        If (GetAsyncKeyState(Keys.LButton) And KeyDownBit) = KeyDownBit Then
            mouse_event(mouseclickup, 0, 0, 0, 0)
            Thread.Sleep(100)
            mouse_event(mouseclickdown, 0, 0, 0, 0)
        End If
  End Sub

使用此代码,当我左键单击时,即使释放Lbutton,代码也会不断自动点击,但这并不是我想要的。我想要它,所以当我按住LButton时,它会不断点击,然后当LButton被释放时,它将停止点击。

我尝试使用BackgroundWorker,但同样的事情发生了。

我还尝试在mouse_event(mouseclickdown, 0, 0, 0, 0)之前使用mouse_event(mouseclickup, 0, 0, 0, 0),但是每次按下它时只需单击一次,然后停止。

2 个答案:

答案 0 :(得分:2)

LMB 持续被点击的原因是因为每次检测到鼠标时都会发送新的鼠标。

由于GetAsyncKeyState()读取键盘/鼠标输入流,因此无法使用任何为流添加点击的方法,因为一切都会像您当前遇到的那样卡住。

为了消除这个问题,我将一个帮助类放在一个方法中,该方法将鼠标点击作为 窗口消息 发送到点击点下方的窗口。通过这样做,我们现在直接将鼠标点击发送到窗口而不是键盘/鼠标输入流,这意味着GetAsyncKeyState()将不会注意到它。

<强> MouseInputHelper.vb

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>
    ''' <remarks></remarks>
    Public Shared Sub SendMouseClick(ByVal Button As MouseButtons, ByVal Location As Point)
        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: " & _
                                    Marshal.GetLastWin32Error())
        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.SendMessage(hWnd, ButtonMessage, wParam, lParam) 'Button down.
        NativeMethods.SendMessage(hWnd, ButtonMessage + 1, wParam, lParam) 'Button up.
    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 SendMessage(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

现在,您可以在计时器中执行以下操作:

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)
    End If
End Sub

希望这有帮助!

答案 1 :(得分:1)

我将采取行动,做出一些假设。

假设1:如果您对按下左键感兴趣,则表单具有焦点。您可以使用标记来跟踪按键

Public Class Form1

    Dim timer As New System.Threading.Timer(AddressOf timer_tick, Nothing,
                                            System.Threading.Timeout.Infinite,
                                            System.Threading.Timeout.Infinite)
    ' keeps track of whether the key is pressed
    Dim lKeyIsPressed As Boolean = False
    ' how fast do you want the action to be performed?
    Dim interval As Integer = 100

    Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
        timer.Change(System.Threading.Timeout.Infinite,
                     System.Threading.Timeout.Infinite)
    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
        ' enable the timer
        timer.Change(interval, System.Threading.Timeout.Infinite)
    End Sub

    Private Sub timer_tick(state As Object)
        If lKeyIsPressed Then
            ' this is where you will perform your action when the key is pressed
        End If
        timer.Change(interval, System.Threading.Timeout.Infinite)
    End Sub

    Private Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
        lKeyIsPressed = (e.KeyCode = Keys.Left)
    End Sub

    Private Sub Form1_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
        If e.KeyCode = Keys.Left Then lKeyIsPressed = False
    End Sub

End Class

更改interval以控制在按下键时执行操作的速度

假设2:如果您对按下鼠标左键 LMB 感兴趣,则应添加以下处理程序:

Private Sub mouseDownHandler(sender As Object, e As MouseEventArgs) Handles Me.MouseDown
    lKeyIsPressed = (e.Button = Windows.Forms.MouseButtons.Left)
End Sub

Private Sub mouseUpHandler(sender As Object, e As MouseEventArgs) Handles Me.MouseUp
    If e.Button = Windows.Forms.MouseButtons.Left Then lKeyIsPressed = False
End Sub

但是你也想跟踪鼠标控件上的鼠标,即Label。所以将它添加到Form_Load

For Each c As Control In Me.Controls
    AddHandler c.MouseDown, AddressOf mouseDownHandler
    AddHandler c.MouseUp, AddressOf mouseUpHandler
Next

最后,你应该在完成任何一次性资源后处置

Protected Overrides Sub Dispose(ByVal disposing As Boolean)
    Try
        If disposing AndAlso components IsNot Nothing Then
            components.Dispose()
        End If
        timer.Dispose()
    Finally
        MyBase.Dispose(disposing)
    End Try
End Sub