Thanks Strongm.. (simulate mouse)

[SkennyR]

I have found the code (below) that you posted (nearly 2 years ago) very useful in a program I'm working on.
The original thread was closed so I couldnt comment on it in that thread.
But since I used it, I feel I should thank you for it, so...
Thank you!
(For other's info, this piece of code originally posted by Strongm simulates mouse movements and clicks)..


Option Explicit

' The mouse_event declarations
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 Enum MOUSEEVENTS
MOUSEEVENTF_ABSOLUTE = &H8000 ' absolute move
MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
MOUSEEVENTF_LEFTUP = &H4 ' left button up
MOUSEEVENTF_MIDDLEDOWN = &H20 ' middle button down
MOUSEEVENTF_MIDDLEUP = &H40 ' middle button up
MOUSEEVENTF_MOVE = &H1 ' mouse move
MOUSEEVENTF_RIGHTDOWN = &H8 ' right button down
MOUSEEVENTF_RIGHTUP = &H10 ' right button up
End Enum


' Other stuff for the example
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type






' Pass in X and y coords in twips
Private Sub vbMouseMove(ByVal X As Long, ByVal Y As Long, Optional ByVal RelativeMove As Boolean = False)
Dim Flags As MOUSEEVENTS
Flags = MOUSEEVENTF_MOVE
X = X * 65535# / Screen.Width ' Normalized value for mouse_event
Y = Y * 65535# / Screen.Height ' Normalized value for mouse_event
If Not RelativeMove Then Flags = Flags Or MOUSEEVENTF_ABSOLUTE
mouse_event Flags, X, Y, 0, 0

End Sub

' Clicks mouse at current mouse position
Private Sub vbMouseClick()
Dim Flags As MOUSEEVENTS

' Do a button down and up to give a mouse-click
Flags = MOUSEEVENTF_LEFTDOWN
mouse_event Flags, 0, 0, 0, 0
Pause 500 ' This just gives us a chance to see the button actually being depressed
Flags = MOUSEEVENTF_LEFTUP
mouse_event Flags, 0, 0, 0, 0
End Sub

Private Sub Pause(ByVal Delay As Long)
Dim Start As Long
Start = GetTickCount
Do Until GetTickCount - Start > Delay
DoEvents
Loop
End Sub

Private Sub Command1_Click()
Dim TargetRect As RECT
Dim dx As Long
Dim dy As Long
Dim deltax As Single
Dim deltay As Single
Dim lp As Long
Dim CurrentXY As POINTAPI

GetCursorPos CurrentXY
' Result is in pixels, so convert to twips
CurrentXY.X = CurrentXY.X * Screen.TwipsPerPixelX
CurrentXY.Y = CurrentXY.Y * Screen.TwipsPerPixelY
'Beep

' We want to click in Command2, so calculate screen coords of middle of Command2
' (However, our target could be anywhere on screen that we liked)
GetWindowRect Command2.hwnd, TargetRect
' Result is in pixels, so convert to twips
dx = (TargetRect.Left + (TargetRect.Right - TargetRect.Left) / 2) * Screen.TwipsPerPixelX
dy = (TargetRect.Top + (TargetRect.Bottom - TargetRect.Top) / 2) * Screen.TwipsPerPixelY

deltax = (dx - CurrentXY.X) / 100
deltay = (dy - CurrentXY.Y) / 100

' Visibly move mouse to Command2
For lp = 0 To 100

vbMouseMove CurrentXY.X + deltax * lp, CurrentXY.Y + deltay * lp, False
Pause 10
Next
' ...and click it
vbMouseClick
End Sub

Private Sub Command2_Click()
MsgBox "Ooh - I've been clicked by an automated mouse..."
End Sub


' X and Y are in pixels
Private Sub ClickAt(X As Long, Y As Long)
' Move the mouse straight there...
X = X * Screen.TwipsPerPixelX
Y = Y * Screen.TwipsPerPixelY
vbMouseMove X, Y, False
' ...and click it
vbMouseClick
End Sub

 

[strongm]

Glad it proved useful to you