[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 266
  • Last Modified:

Moving the Cursor

I need VB to move the cursor on the screen and do a left mouse click.
0
matthewkwp
Asked:
matthewkwp
  • 6
  • 5
  • 3
1 Solution
 
PiNCommented:
I have a code module that can do that...
I'd like to email it to you as i get server errors when pasting it in here.

Just tell me where to.

PiN
0
 
PiNCommented:
Another try:


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 Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal y As Long) As Long

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
   
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_MOVE = &H1

Public Type POINTAPI
    X As Long
    y As Long
End Type
                         
Public Function mouseX() As Long
    Dim n As POINTAPI
    GetCursorPos n
    GetX = n.X
End Function

Public Function mouseY() As Long
    Dim n As POINTAPI
    GetCursorPos n
    GetY = n.y
End Function

Public Sub mouseLeftClick()
    mouseLeftDown
    mouseLeftUp
End Sub

Public Sub mouseLeftDown()
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
End Sub

Public Sub mouseLeftUp()
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Public Sub mouseMiddleClick()
    mouseMiddleDown
    mouseMiddleUp
End Sub

Public Sub mouseMiddleDown()
    mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
End Sub

Public Sub mouseMiddleUp()
    mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
End Sub

Public Sub mouseMove(xMove As Long, yMove As Long)
    mouse_event MOUSEEVENTF_MOVE, xMove, yMove, 0, 0
End Sub

Public Sub mouseRightClick()
    mouseRightDown
    mouseRightUp
End Sub

Public Sub mouseRightDown()
    mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
End Sub

Public Sub mouseRightUp()
    mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub

Public Sub mouseSetPos(xPos As Long, yPos As Long)
    SetCursorPos xPos, yPos
End Sub

0
 
PiNCommented:
OK...it worked this way now...check it out ;-)
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
Erick37Commented:
Please do not lock a question without an answer.


Module level code:
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Option Explicit

Public Const MOUSEEVENTF_ABSOLUTE = &H8000
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_MOVE = &H1
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const KEYEVENTF_KEYUP = &H2

Public Type POINTAPI
    x As Long
    y As Long
End Type

Public Declare Sub Sleep Lib "kernel32" _
    (ByVal dwMilliseconds 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 Declare Function SetCursorPos Lib "user32" _
    (ByVal x As Long, ByVal y As Long) As Long
Public Declare Function GetCursorPos Lib "user32" _
    (lpPoint As POINTAPI) As Long

Public Sub MouseMove(ByVal vlX As Long, ByVal vlY As Long)
    'Move to point vlX, vlY
    Dim pt As POINTAPI
    Dim dX As Double
    Dim dY As Double
    Dim nI As Integer

    Call GetCursorPos(pt)

    dX = (vlX - pt.x) / 100
    dY = (vlY - pt.y) / 100

    For nI = 1 To 100
        Call SetCursorPos(pt.x + nI * dX, pt.y + nI * dY)
        Sleep 10
    Next

End Sub

Public Sub MouseDown(Optional ByVal Button As Integer)
    Dim nEvent As Integer
    Select Case Button
    Case 2
        nEvent = MOUSEEVENTF_RIGHTDOWN
    Case 3
        nEvent = MOUSEEVENTF_MIDDLEDOWN
    Case Else
        nEvent = MOUSEEVENTF_LEFTDOWN
    End Select
    mouse_event nEvent, 0&, 0&, 0, 0
    DoEvents
    Sleep 100
End Sub

Public Sub MouseUp(Optional ByVal Button As Integer)
    Dim nEvent As Integer
    Select Case Button
    Case 2
        nEvent = MOUSEEVENTF_RIGHTUP
    Case 3
        nEvent = MOUSEEVENTF_MIDDLEUP
    Case Else
        nEvent = MOUSEEVENTF_LEFTUP
    End Select
    mouse_event nEvent, 0&, 0&, 0, 0
    DoEvents
    Sleep 100
End Sub

Public Sub MouseClick()
    MouseDown
    MouseUp
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~

Form example of usage:

Private Sub Command1_Click()
    MouseMove 10, 10
    MouseClick
End Sub
0
 
matthewkwpAuthor Commented:
Thanks, looks great!!!!!!!
0
 
Erick37Commented:
Sorry PiN, glad you posted the code.
0
 
PiNCommented:
Sorry, i did paste the code a minute later...
I checked the wrong button by mistake as I was trying to paste the whole module first which didn't work...
Sorry again...didn't do it on purpose...

PiN
0
 
PiNCommented:
Hey Erick37,
want half the points for my unpolite behaviour ?
0
 
Erick37Commented:
No PiN, you posted an answer in good time.  Thanks.
0
 
matthewkwpAuthor Commented:
Erik37, Yours seemed to work except for a few problems. Number 1. it doesn't like the 'Optional' word. Number 2 is that I am getting an error message  for
'Public Sub MouseClick()
    MouseDown
    MouseUp
End Sub'  "Argument not Optional'.  How can I get you some points?
0
 
PiNCommented:
If theres a problem with mine or you want to split the points, just tell me and I'll make a gift-question for erik37. You shouldn't pay twice...

PiN
0
 
matthewkwpAuthor Commented:
Pin, I couldn't get yours to work, so I tried erik37's.  It worked except for the two errors above.  I really don't care about paying twice if it works. Thanks.

0
 
Erick37Commented:
It workes fine in VB5. I'm not sure when the Optional keyword was introduced. What version are you using?

If you remove Optional, then you must supply a parameter.

Public Sub MouseClick(ByVal Button As Integer)
    MouseDown(Button)
    MouseUp(Button)
End Sub

And call it like:

MouseClick(0)
0
 
Erick37Commented:
That should have been:

Public Sub MouseClick(ByVal Button As Integer)
     MouseDown Button
     MouseUp Button  
End Sub

And call it like:

MouseClick 0 'Defaults to left button
0

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

  • 6
  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now