我有以下代码控制鼠标(从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,它将鼠标置于屏幕中间。
在游戏中,鼠标的向下和向上事件有效,但试图改变它的位置根本不会移动它。
该代码在游戏外部工作但在游戏中不起作用以移动由鼠标控制的相机。我正在寻找的是能够使用代码自动移动游戏中的鼠标/相机。
答案 0 :(得分:0)
下面是代码,您可以使用它来循环移动光标
'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/
的积分答案 1 :(得分:0)
使用GetCursorPos API获取当前光标位置,然后进行相对偏移。 PosRel(xOffSet As Long, yOffSet As Long)
< - 这个子就是这样做的。
在您的代码下面现在修改为包含支持声明,PosRel子和用于测试光标的子进行相对移动
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
答案 2 :(得分:0)
我不确定这是不是你使用的,只是一种不同的风格,但我能够将鼠标准确地放在屏幕上我想要的位置。我正在使用双显示器,因此可能会有一点不同。
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