在 3D 游戏中控制居中的鼠标

Question

我有以下控制鼠标的代码（修改自this source）：

Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Control()
  Wait 3000
  Pos 6, 145
  Down
  Pos 6, 149
  Up
  Pos 7, 147
  Down
  Up
  Pos 8, 145
  Down
  Pos 8, 149
  Up
  Pos 10, 145
  Down
  Pos 10, 149
  Up
  Pos 11, 145
  Down
  Pos 12, 145
  Up
  Pos 11, 147
  Down
  Up
  Pos 11, 149
  Down
  Pos 12, 149
  Up
  Pos 14, 145
  Down
  Pos 14, 149
  Up
  Pos 15, 149
  Down
  Pos 16, 149
  Up
  Pos 18, 145
  Down
  Pos 18, 149
  Up
  Pos 19, 145
  Down
  Pos 20, 145
  Up
  Pos 20, 146
  Down
  Pos 20, 146
  Up
  Pos 19, 147
  Down
  Pos 20, 147
  Up
End Sub
Private Function Wait(Optional ByVal milliseconds As Long = 50)
  Sleep milliseconds
End Function
Private Function Pos(ByVal x As Long, ByVal y As Long)
  SetCursorPos x, y
End Function
Private Function Down()
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
End Function
Private Function Up()
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Function

它按预期工作，可以在油漆上绘画。

现在我想要完成的是在游戏 VRChat 中以 3D 绘图，将鼠标置于屏幕中间。

在游戏中，鼠标的向下和向上事件起作用，但试图改变它的位置却根本不会移动它。

该代码在游戏外有效，但在游戏中无法移动由鼠标控制的相机。我正在寻找的是能够使用代码自动在游戏中移动鼠标/相机。

Answer 1

下面是代码，可以用来循环移动光标

'Declare mouse events
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
'Declare sleep
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub CityscapeSkyline()
'Open MS Paint and select Natural pencil Brush with 6px width
For k = 1 To 3
  SetCursorPos 16, 500
  Sleep 50
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  For i = 16 To 600 Step 5
    For j = 500 To 300 Step -Int((180 - 10 + 1) * Rnd + 10)
      SetCursorPos i, j
      Sleep 10
    Next j
  Next i
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Next k
End Sub

如果您还需要使用当前光标位置，那么您也可以集成GetCursorPos

Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
' Create custom variable that holds two integers
Type POINTAPI
   Xcoord As Long
   Ycoord As Long
End Type

Sub GetCursorPosDemo()
Dim llCoord As POINTAPI
' Get the cursor positions
GetCursorPos llCoord
' Display the cursor position coordinates
MsgBox "X Position: " & llCoord.Xcoord & vbNewLine & "Y Position: " & llCoord.Ycoord
End Sub

PS：感谢https://wellsr.com/vba/2015/excel/vba-mouse-move-and-mouse-click-macro/

Answer 2

使用 GetCursorPos API 获取当前光标位置，然后进行相对偏移。 PosRel(xOffSet As Long, yOffSet As Long)

下面的代码现在被修改为包含支持声明，PosRel sub 和一个用于测试光标的 sub 进行相对移动

Option Explicit
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

''ADDED
    Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

    ' GetCursorPos requires a variable declared as a custom data type
    ' that will hold two integers, one for x value and one for y value
    Type POINTAPI
       X_Pos As Long
       Y_Pos As Long
    End Type


    Public Sub Test()
        Dim beforePOS As POINTAPI, afterPOS As POINTAPI

        GetCursorPos beforePOS
        PosRel 500, -500
        GetCursorPos afterPOS

        MsgBox "Before (" & beforePOS.X_Pos & "," & beforePOS.Y_Pos & ") " & vbNewLine & "After (" & afterPOS.X_Pos & "," & afterPOS.Y_Pos & ") "
    End Sub
    Public Sub PosRel(xOffSet As Long, yOffSet As Long)
        Dim currentPOs As POINTAPI
        GetCursorPos currentPOs
        SetCursorPos currentPOs.X_Pos + xOffSet, currentPOs.Y_Pos + yOffSet

    End Sub
''END ADDED

Sub Control()
  Wait 3000
  Pos 6, 145
  Down
  Pos 6, 149
  Up
  Pos 7, 147
  Down
  Up
  Pos 8, 145
  Down
  Pos 8, 149
  Up
  Pos 10, 145
  Down
  Pos 10, 149
  Up
  Pos 11, 145
  Down
  Pos 12, 145
  Up
  Pos 11, 147
  Down
  Up
  Pos 11, 149
  Down
  Pos 12, 149
  Up
  Pos 14, 145
  Down
  Pos 14, 149
  Up
  Pos 15, 149
  Down
  Pos 16, 149
  Up
  Pos 18, 145
  Down
  Pos 18, 149
  Up
  Pos 19, 145
  Down
  Pos 20, 145
  Up
  Pos 20, 146
  Down
  Pos 20, 146
  Up
  Pos 19, 147
  Down
  Pos 20, 147
  Up
End Sub
Private Function Wait(Optional ByVal milliseconds As Long = 50)
  Sleep milliseconds
End Function
Private Function Pos(ByVal x As Long, ByVal y As Long)
  SetCursorPos x, y
  DoEvents
End Function
Private Function Down()
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
End Function
Private Function Up()
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Function

Answer 3

我不确定这是否是您使用的，只是样式不同，但我可以将鼠标准确地放在屏幕上我想要的位置。我使用的是双显示器，所以坐标可能会有些不同。

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
                                          ByVal dx As Long, _
                                          ByVal dy As Long, _
                                          ByVal cButtons As Long, _
                                          ByVal dwExtraInfo As Long)

Private Const MOUSEEVENTF_MOVE = &H1          ' mouse move
Private Const MOUSEEVENTF_LEFTDOWN = &H2      ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4        ' left button up
Private Const MOUSEEVENTF_RIGHTDOWN = &H8     ' right button down
Private Const MOUSEEVENTF_RIGHTUP = &H10      ' right button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20   ' middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &H40     ' middle button up
Private Const MOUSEEVENTF_WHEEL = &H800       ' wheel button rolled
Private Const MOUSEEVENTF_ABSOLUTE = &H8000   ' absolute move

Private Type POINTAPI
    x As Long
    y As Long
End Type


Sub myClick()
    Dim pt As POINTAPI
    Dim x As Long
    Dim y As Long

    '(0,0) = top left
    '(65535,65535) = bottom right
    x = 18800
    y = 11600

    LeftClick x, y
End Sub

Sub LeftClick(x As Long, y As Long)
'Move mouse
mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, x, y, 0, 0

'Press left click
mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0

'Release left click
mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

'Trying a wait here..
Application.Wait (Now + TimeValue("0:00:03"))

'Move to bottom of the screen
mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE, 40000, 47000, 0, 0

'Trying a wait here..
Application.Wait (Now + TimeValue("0:00:02"))

'Try to scroll the page down
mouse_event MOUSEEVENTF_WHEEL, 0, 0, -490, 0

'Trying a wait here..
'Application.Wait (Now + TimeValue("0:00:00"))

'Press left click
mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0

'Release left click
mouse_event MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

End Sub