I have the following code which controls the mouse (modified from 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 It works as expected and can draw on paint.
Now what I'm trying to accomplish is drawing in 3D in the game VRChat which centers the mouse to the middle of the screen.
In the game the mouse's down and up events work but trying to change the position of it doesn't move it at all.
The code works outside the game but doesn't work in the game to move the camera which is controlled by the mouse. What I'm looking for is to be able to move the mouse/camera in the game automatically with the code.
3 Answers
Answers 1
Below is the code, you can use to move cursor in a loop
'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 If you need to use current cursor position as well then you can integrate GetCursorPos as well
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: Credits to https://wellsr.com/vba/2015/excel/vba-mouse-move-and-mouse-click-macro/
Answers 2
Use GetCursorPos API to get the current cursor position and then make a relative offset. PosRel(xOffSet As Long, yOffSet As Long) <-- this sub does exactly this.
Below your code now modified to include supporting declarations, the PosRel sub and a sub for testing the cursor does the relative movements
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 Answers 3
I'm not sure if this is what your using, just a different style, but I'm able to put the mouse exactly where I want it on the screen. I'm using dual monitors, so the coords may be a little different.
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 
0 comments:
Post a Comment