Solved: API call to do a Mouse click in VB6

Actually, I'll post the entire thread so you don't have to buy it...

From: raya70 Title: "API for mouseclick?"
Points: 10 Date: Wednesday, December 08 1999 - 04:35AM EST
I want to do a 'real' mouseclick using code (API or whatever that works) and with 'real' I mean that it should do a left mouseclick where the mousepointer is located (even if it is outside the program and clicking on the desktop or other apps).
This is going to be like an autofire function for the mouse.

Is it possible? I haven't found any API that will do this.

Accepted Answer
From: waty
Date: Wednesday, December 08 1999 - 04:45AM EST

Text below...

Question History
Accepted Answer
From: waty
Date: Wednesday, December 08 1999 - 04:45AM EST
' #VBIDEUtils#************************************************************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 6/05/99
' * Time : 09:30
' **********************************************************************
' * Comments : Sending a mouse event
' *
' *
' **********************************************************************

Dim pt As POINTAPI

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_ABSOLUTE = &H8000 ' absolute move
Public Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Public Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20 ' middle button down
Public Const MOUSEEVENTF_MIDDLEUP = &H40 ' middle button up
Public Const MOUSEEVENTF_MOVE = &H1 ' mouse move
Public Const MOUSEEVENTF_RIGHTDOWN = &H8 ' right button down
Public Const MOUSEEVENTF_RIGHTUP = &H10 ' right button up

Type POINTAPI
X As Long
Y As Long
End Type

Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Public Enum CurAct
MouseMove = 1
MouseClick = 2
MouseRClick = 3
MouseDblClick = 4
End Enum

Public Sub CursorAction(Ctl As Control, Optional ByVal CAct As CurAct)

Dim OldSMode As Integer
Dim Sw As Long, Sh As Long
Dim AB As Long
Dim CX As Long, CY As Long
Dim Ax As Long, Ay As Long
Dim Nx As Long, Ny As Long
Dim A As Long

Sw = Screen.TwipsPerPixelX
Sh = Screen.TwipsPerPixelY

'Save the current Scalemode
OldSMode = Ctl.Parent.ScaleMode

'set the Scalemode to pixel
Ctl.Parent.ScaleMode = 3 'Pixel

'Move to Center of Control
CX = Ctl.Left + (Ctl.Width / 2)
CY = Ctl.Top + (Ctl.Height / 2)

pt.X = CX
pt.Y = CY

ClientToScreen Ctl.Parent.hwnd, pt

AB = 65535
Ax = AB / (Screen.Width / Sw)
Ay = AB / (Screen.Height / Sh)

Nx = Ax * pt.X
Ny = Ay * pt.Y

Call mouse_event(MOUSEEVENTF_ABSOLUTE +MOUSEEVENTF_MOVE, Nx, Ny, 0, 0)

'the "Action"
Select Case CAct
Case 2 'Click
Call mouse_event(MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTDOWN, Nx, Ny, 0, 0)
Call mouse_event(MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTUP, Nx, Ny, 0, 0)
Case 3 'Right Click
Call mouse_event(MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_RIGHTDOWN, Nx, Ny, 0, 0)
Call mouse_event(MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_RIGHTUP, Nx, Ny, 0, 0)
Case 4 'Double Click
Call mouse_event(MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTDOWN, Nx, Ny, 0, 0)
Call mouse_event(MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTDOWN, Nx, Ny, 0, 0)
Call mouse_event(MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_LEFTUP, Nx, Ny, 0, 0)
End Select

'restore the scalemode
ctl.parent.scalemode = OldSmode
End Sub

Comment
From: waty
Date: Wednesday, December 08 1999 - 04:45AM EST
This is an even more complete source :)

' #VBIDEUtils#************************************************************
' * Programmer Name : Martin Cooper
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : martin.cooper@panmuregordon.com
' * Date : 26/04/99
' * Time : 11:52
' **********************************************************************
' * Comments : Control every aspect of the mouse
' *
' *
' **********************************************************************

'**************************************************************************************************
'* MightyMouse Ver 1.0 ActiveX Control *
'* Written 03-Aug-1998 by Martin Cooper (martin.cooper@panmuregordon.com) *
'*------------------------------------------------------------------------------------------------*
'* This ActiveX control shows how the mouse can be manipulated to do almost anything you may need.*
'* It also shows how you can create an ActiveX control keeping all related routines together for *
'* easy reuse and distribution to other developers. If you have any comments or questions then *
'* E-Mail me. Future versions include Subclassing and Message Hooking to allow the recording and *
'* playback of mouse movements and button clicks to record tutorials or help for a program... *
'**************************************************************************************************
'* Copyright - This code is free to use in whatever way you like, although if anyone finds out *
'* anything VB mouse related that would go nicely in this control which is currently missing then *
'* let me know and I might just send you the latest version. *
'**************************************************************************************************

Option Explicit
' ----------------------------------------------
' * Private Variables *
' ----------------------------------------------
Private lOrigCursor As Long 'Original Cursor
' ----------------------------------------------
' * Mouse Related Structure Definitions *
' ----------------------------------------------
'Structure to pass mouse pointer info to and from DLLs
Private Type POINTAPI
X As Long
Y As Long
End Type

'Structure to pass rectangle info to and from DLLs
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'***********************************************

' ----------------------------------------------
' * Mouse Related API Declarations *
' ----------------------------------------------
'The API Functions to get and set the mouse cursors
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

'An API Mouse event which triggers button presses and releases
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)

'This swaps the users mouse buttons around
Private Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long

'Limits the cursor to the attributes in the RECT structure
Private Declare Sub ClipCursor Lib "user32" (lpRect As RECT)

'Pass an X & Y coord and get the handle of the window/control that it's over
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

'Gets the rectangle of a window given the handle
Private Declare Sub GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)

'Gets the full window desktop window handle
Private Declare Function GetDesktopWindow Lib "user32" () As Long

'Returns/Sets the mouse doubleclick time in milliseconds
Private Declare Function GetDoubleClickTime Lib "user32" () As Long
Private Declare Function SetDoubleClickTime Lib "user32" (ByVal wCount As Long) As Long

'Gets information about the current computer setup
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

'Finds a window given the Classname and Caption
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'Use to add mouse trails onto the cursor (Not available in NT)
Private Declare Function Escape Lib "GDI32" _
(ByVal hDC As Long, ByVal nEscape As Long, _
ByVal nCount As Long, lpInData As Any, lpOutData As Any) As Long

'Hides and shows the mouse cursor
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

'API functions to manipulate the mouse cursor picture
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" _
(ByVal lpFileName As String) As Long

Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" _
(ByVal hInstance As Long, ByVal lpCursorName As String) As Long

Private Declare Function SetSystemCursor Lib "user32" _
(ByVal hcur As Long, ByVal id As Long) As Long

Private Declare Function GetCursor Lib "user32" () As Long

Private Declare Function CopyIcon Lib "user32" (ByVal hIcon As Long) As Long

' ----------------------------------------------
' * Bezier Curve Declares *
' ----------------------------------------------
'This section using Bezier curves is not strictly useful but
'It shows what you can do with the mouse API functions and
'Makes a nice ScreenSaver.
'Using Bezier curves for the MouseCurve Property
Private Type BZPoint
X As Long
Y As Long
End Type

Private Const BEZ_DEPTH = 11 'How many levels deep to recurse
Private Const NUM_BEZPTS = 2049 ' = (2^BEZ_DEPTH) + 1

'Array to store the beziers calculated points
Private BZArray(1 To NUM_BEZPTS) As BZPoint

'Counter of the current array entry to store calculated point in
Private iCounter As Long

'Mouse moving toggle
Private bStop As Boolean

' ----------------------------------------------
' * MouseEvent Related Constants *
'--------------Mouse Trails---------------------
Private Const MOUSETRAILS = 39
Private Const SIZE_OF_WORD = 2
' ------------System Metrics--------------------
Private Const SM_CMOUSEBUTTONS = 43
Private Const SM_MOUSEPRESENT = 19
Private Const SM_SWAPBUTTON = 23
Private Const SM_CXCURSOR = 13
Private Const SM_CYCURSOR = 14
'-------------Mouse Events----------------------
Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
'-------------Cursor Change Constants-----------
Private Const OCR_CROSS = 32515
Private Const OCR_IBEAM = 32513
Private Const OCR_ICOCUR = 32647
Private Const OCR_ICON = 32641
Private Const OCR_NO = 32648
Private Const OCR_NORMAL = 32512
Private Const OCR_SIZE = 32640
Private Const OCR_SIZEALL = 32646
Private Const OCR_SIZENESW = 32643
Private Const OCR_SIZENS = 32645
Private Const OCR_SIZENWSE = 32642
Private Const OCR_SIZEWE = 32644
Private Const OCR_UP = 32516
Private Const OCR_WAIT = 32514
'-------------Cursor Icon Constants-------------
Private Const IDC_APPSTARTING = 32650&
Private Const IDC_ARROW = 32512&
Private Const IDC_CROSS = 32515&
Private Const IDC_IBEAM = 32513&
Private Const IDC_ICON = 32641&
Private Const IDC_NO = 32648&
Private Const IDC_SIZE = 32640&
Private Const IDC_SIZEALL = 32646&
Private Const IDC_SIZENESW = 32643&
Private Const IDC_SIZENS = 32645&
Private Const IDC_SIZENWSE = 32642&
Private Const IDC_SIZEWE = 32644&
Private Const IDC_UPARROW = 32516&
Private Const IDC_WAIT = 32514&
'************************************************

' ----------------------------------------------
' * Mouse Enumerated types *
' ----------------------------------------------
'Enumeration for mouse events
Public Enum enMouseEvent
LeftBtnDown = MOUSEEVENTF_LEFTDOWN
LeftBtnUp = MOUSEEVENTF_LEFTUP
MiddleBtnDown = MOUSEEVENTF_MIDDLEDOWN
MiddleBtnUp = MOUSEEVENTF_MIDDLEUP
RightBtnDown = MOUSEEVENTF_RIGHTDOWN
RightBtnUp = MOUSEEVENTF_RIGHTUP
MouseMove = MOUSEEVENTF_MOVE
Absolute = MOUSEEVENTF_ABSOLUTE
End Enum

'Enumerated type of mouse buttons
Public Enum enMouseBtn
btnLeft
btnRight
btnMiddle
End Enum

'Enumerated type of size mode
Public Enum enMode
bTwips
bPixels
End Enum
Private Function BezierCalc(P0 As BZPoint, P1 As BZPoint, P2 As BZPoint, P3 As BZPoint, ByVal iDepth As Integer)
'Recursive algorithm to calculate the bezier curve between 4 points,
'P0 & P3 = Start/End points, P1 & P2 = displacement points
'Used by the MouseCurve property

Dim Q0 As BZPoint, Q1 As BZPoint, Q2 As BZPoint
Dim R0 As BZPoint, R1 As BZPoint
Dim S0 As BZPoint

'If the subdividing is at it's lowest level then store the position into the array
'and exit out of the current recursive loop.
If iDepth = 0 Then
iCounter = iCounter + 1
BZArray(iCounter).X = P3.X
BZArray(iCounter).Y = P3.Y
Exit Function
End If

'Calculate points for the current depth
Q0.X = (P1.X + P0.X) / 2: Q0.Y = (P1.Y + P0.Y) / 2
Q1.X = (P2.X + P1.X) / 2: Q1.Y = (P2.Y + P1.Y) / 2
Q2.X = (P3.X + P2.X) / 2: Q2.Y = (P3.Y + P2.Y) / 2
R0.X = (Q1.X + Q0.X) / 2: R0.Y = (Q1.Y + Q0.Y) / 2
R1.X = (Q2.X + Q1.X) / 2: R1.Y = (Q2.Y + Q1.Y) / 2
S0.X = (R1.X + R0.X) / 2: S0.Y = (R1.Y + R0.Y) / 2

'Subdivide the depth level
iDepth = iDepth - 1

'Recurse the function
Call BezierCalc(P0, Q0, R0, S0, iDepth)
Call BezierCalc(S0, R1, Q2, P3, iDepth)

End Function

Property Get CursorVisible() As Boolean
'Returns if the cursor is visible or not

'NOTE:The only way to get the current visible state of the cursor is by changing it,
'then reading the return value and then setting it back to the previous state

Dim lRetVal As Long
Dim bGetVisible As Boolean

'Set the Cursor to get the First Message
lRetVal = ShowCursor(True)

If lRetVal > 0 Then
CursorVisible = True
'Set the cursor status back to previous state
lRetVal = ShowCursor(False)
Else
CursorVisible = False
'Set the cursor status back to previous state
lRetVal = ShowCursor(False)
End If

End Property

Property Let CursorVisible(bShow As Boolean)
'This function sets the cursor visible state

'NOTE:If you keep calling the ShowCursor visible with (True) or (False) then instead of toggling the value
'it just keeps building up, E.G If you call ShowCursor(True) 15 times then to hide the cursor you will also
'need to call ShowCursor(False) 15 times. So the extra work here keeps track so it works as a toggle.

Dim lShow As Long

'If the user wants to Hide the cursor
If bShow = False Then
Do
lShow = ShowCursor(False)
Loop Until lShow <= -2

Do
lShow = ShowCursor(True)
Loop Until lShow >= -1
Else
'If the user wants to show the cursor
Do
lShow = ShowCursor(True)
Loop Until lShow >= 1

Do
lShow = ShowCursor(False)
Loop Until lShow <= 0
End If

End Property

Public Function PointToPoint(xStart As Long, yStart As Long, xEnd As Long, yEnd As Long)
'Function to smoothly move the mouse cursor from xStart,yStart to xEnd,yEnd
'The speed/distance to move each point is determined by the distance between the 2 points.

'NOTE: This function is more effective when the start point and end point are further apart,
'When the points are quite close together the number of tween points diminishes and
'there may only be 1-2 pixels between them so you would see very little difference running this function

Dim M_SPEED_X As Double
Dim M_SPEED_Y As Double
Dim M_MAX_LOOP As Double

Dim lLoop As Long
Dim dTweenX As Double
Dim dTweenY As Double

'Set the speed of the horizontal movement
M_SPEED_X = Abs(xEnd - xStart) * 2
If M_SPEED_X = 0 Then M_SPEED_X = 1

'Set the speed of the vertical movement
M_SPEED_Y = Abs(yEnd - yStart) * 2
If M_SPEED_Y = 0 Then M_SPEED_Y = 1

'Calc the distance to move along each axis
dTweenX = (xEnd - xStart) / 1500 'M_SPEED_X
dTweenY = (yEnd - yStart) / 1500 'M_SPEED_Y

'Set the loop to run through the longest axis, X or Y
'If they are equal then it doesn't matter which one we use
If M_SPEED_X > M_SPEED_Y Then
M_MAX_LOOP = M_SPEED_X
Else
M_MAX_LOOP = M_SPEED_Y
End If

For lLoop = 1 To M_MAX_LOOP

'Yield events and slow movement down slightly
If lLoop Mod 4 = 0 Then 'Modify the 4 to alter speed of movement and number of yields
DoEvents
End If

'Set mouse coords
ScreenMousePosX(bPixels) = xStart + (dTweenX * lLoop)
ScreenMousePosY(bPixels) = yStart + (dTweenY * lLoop)

Next lLoop

End Function

Property Let MouseCurve(bToggle As Boolean)
'Starts the random movement of the mouse cursor by creating 4 random points and calculating
'a bezier curve between them for it to follow

Dim P0 As BZPoint
Dim P1 As BZPoint
Dim P2 As BZPoint
Dim P3 As BZPoint

Dim sWidth As Integer 'Width of the screen
Dim sHeight As Integer 'Height of the screen

'If the user calls this property with false then set the stop flag which will activate next time
'around the main loop
If bToggle = False Or bStop = False Then
bStop = True
Exit Property
Else

'Set the start movement flag
bStop = False

Randomize

'The First time round the loop grab the current mouse cursor position
P0.X = ScreenMousePosX(bPixels)
P0.Y = ScreenMousePosY(bPixels)
'and randomise Second points
P1.X = Int((sWidth * Rnd) + 1)
P1.Y = Int((sHeight * Rnd) + 1)

Do
Randomize

'Get the height and width in pixels of the screen dimensions
sWidth = TwipsToPixelsX(Screen.Width)
sHeight = TwipsToPixelsY(Screen.Height)

'Randomise the new points
P2.X = Int((sWidth * Rnd) + 1)
P2.Y = Int((sHeight * Rnd) + 1)
P3.X = Int((sWidth * Rnd) + 1)
P3.Y = Int((sHeight * Rnd) + 1)

'Initialise the array and store the starting array element
iCounter = 1
BZArray(1).X = P0.X
BZArray(1).Y = P0.Y

If bStop = True Then Exit Do 'Check the stop flag and break if set.

'Start the recursive calc function to creat the bezeir curve
Call BezierCalc(P0, P1, P2, P3, BEZ_DEPTH)

'Draw the mouse in the bezier curve loop
Dim iLoop As Integer
For iLoop = 1 To NUM_BEZPTS - 1
Call PointToPoint(BZArray(iLoop).X, BZArray(iLoop).Y, BZArray(iLoop + 1).X, BZArray(iLoop + 1).Y)
DoEvents
If bStop = True Then Exit For 'Check the stop flag and break if set.
Next iLoop

'Each subsequent time round the loop store the last 2 points used to create the start
'of the next curve, swapping the line back to front to get a bounce effect
P0.X = P3.X
P0.Y = P3.Y
P1.X = P2.X
P1.Y = P2.Y
Loop

End If

End Property

Property Get SwapMouseBtn() As Boolean
'Returns True if the buttons are currently swapped

Dim lSwapped As Long

lSwapped = GetSystemMetrics(SM_SWAPBUTTON)

End Property

Public Function NewCursor(Optional sFileName As String) As Boolean
'Currently not working correctly under NT 4.0

' Dim lNewCursor As Long
'
' If sFileName = "" Or Dir(sFileName) = "" Then
' 'Reset the original cursor
'
' lNewCursor = LoadCursor(0, IDC_ARROW)
' lNewCursor = SetSystemCursor(lNewCursor, OCR_NORMAL)
'
' Call SetSystemCursor(IDC_CROSS, OCR_NORMAL)
'
' NewCursor = False
' Exit Function
' Else
' lNewCursor = LoadCursorFromFile("c:.ani")
' Call SetSystemCursor(lNewCursor, OCR_NORMAL)
' End If

End Function

Public Function SetMouseTrails(iNumTrails As Integer)
'Sets mouse trails (Not available in NT)

Dim lRetVal As Long
Dim lGetHdc As Long

'Get the DC(Device Context) of the form this user control is currently sitting on.
lGetHdc = UserControl.Parent.hDC

'If the number of trails input is in the valid range then...
If iNumTrails >= 0 And iNumTrails <= 7 Then
lRetVal = Escape(lGetHdc, MOUSETRAILS, SIZE_OF_WORD, iNumTrails, 0&)
End If

End Function

Property Let DoubleClickSpeed(lSpeed As Long)
'Sets the time delay in milliseconds of the double click speed

Dim lRetVal As Long

lRetVal = SetDoubleClickTime(lSpeed)

End Property

Property Get DoubleClickSpeed() As Long
'Sets the time delay in milliseconds of the double click speed

Dim lRetVal As Long

lRetVal = GetDoubleClickTime()

DoubleClickSpeed = lRetVal

End Property

Public Function LimitCursor(lTop As Long, lLeft As Long, lBottom As Long, lRight As Long, iMode As enMode)
'Pass a set of points as a rectangle and the mouse cursor will be limited to
'movement only in that region

'Note: Using 4 parameters (one for each point) isn't as elegant as passing in a filled RECT structure
'but you can't define Public structures in an ActiveX control.

Dim rctBox As RECT

'Convert mode if needed
If iMode = bTwips Then
rctBox.Top = TwipsToPixelsY(lTop)
rctBox.Bottom = TwipsToPixelsY(lBottom)
rctBox.Left = TwipsToPixelsY(lLeft)
rctBox.Right = TwipsToPixelsY(lRight)
Else
rctBox.Top = lTop
rctBox.Bottom = lBottom
rctBox.Left = lLeft
rctBox.Right = lRight
End If

'Set the Limit of the mouse
ClipCursor rctBox

End Function

Public Function LimitCursorOff()
'Resets the cursor limit back to entire screen

Dim rctBox As RECT
Dim hwndDesktop As Long

'Get the handle to the desktop
hwndDesktop = GetDesktopWindow()

'Get the rectangle of the whole screen
GetWindowRect hwndDesktop, rctBox

'Set the Limit of the mouse to the screen(turning limiting off)
ClipCursor rctBox

End Function
Property Get MouseButtons() As Long
'Returns the number of mouse buttons available

Dim lNumButtons As Long

lNumButtons = GetSystemMetrics(SM_CMOUSEBUTTONS)

MouseButtons = lNumButtons

End Property

Property Get MouseOverHwnd() As Long
'Function which returns the handle of the the current window/control that the mouse is over

Dim lXPos As Long
Dim lYPos As Long
Dim hWndOver As Long

lXPos = ScreenMousePosX(bPixels)
lYPos = ScreenMousePosY(bPixels)

hWndOver = WindowFromPoint(lXPos, lYPos)

MouseOverHwnd = hWndOver

End Property

Public Function MousePresent() As Boolean
'Returns True/False if there is a mouse attached or not

Dim lMousePresent As Long

lMousePresent = GetSystemMetrics(SM_MOUSEPRESENT)

If lMousePresent = 1 Then
MousePresent = True
Else
MousePresent = False
End If

End Function

Property Let ScreenMousePosX(iMode As enMode, xPos As Long)
'This sets the mouse cursor

Dim retValue As Long

Dim lNewXPos As Long
Dim lNewYPos As Long

If iMode = bTwips Then
lNewXPos = TwipsToPixelsX(xPos)
Else
lNewXPos = xPos
End If

lNewYPos = ScreenMousePosY(bPixels)

'This API expects the positions in PIXELS so convert if user inputs twips
retValue = SetCursorPos(lNewXPos, lNewYPos)

End Property

Property Let ScreenMousePosY(iMode As enMode, yPos As Long)
'This sets the mouse cursor

Dim retValue As Long

Dim lNewXPos As Long
Dim lNewYPos As Long

If iMode = bTwips Then
lNewYPos = TwipsToPixelsY(yPos)
Else
lNewYPos = yPos
End If

lNewXPos = ScreenMousePosX(bPixels)

'This API expects the positions in PIXELS so convert if user inputs twips
retValue = SetCursorPos(lNewXPos, lNewYPos)

End Property

Property Get ScreenMousePosX(iMode As enMode) As Long

Dim lMousePos As Long
Dim RetPos As POINTAPI
Dim RetVal As Long

'Get the Cursor position
RetVal = GetCursorPos(RetPos)

'Get the X position
lMousePos = RetPos.X

'Convert the mode if needed
If iMode = bTwips Then
ScreenMousePosX = PixelsToTwipsX(lMousePos)
Else
ScreenMousePosX = lMousePos
End If

End Property

Property Get hWndMousePosX(hWnd As Long, iMode As enMode) As Long
'Gets the mouse cursor position in respect to the window/form that
'has the handle argument hWnd

Dim lMousePos As Long
Dim ScreenPos As POINTAPI
Dim hWndPos As RECT
Dim RetVal As Long

'First get the Get the Cursor position in respect to the screen
RetVal = GetCursorPos(ScreenPos)

'Next get the position of the window
Call GetWindowRect(hWnd, hWndPos)

'Calc the x Position
lMousePos = ScreenPos.X - hWndPos.Left

'Convert the mode if needed
If iMode = bTwips Then
hWndMousePosX = PixelsToTwipsX(lMousePos)
Else
hWndMousePosX = lMousePos
End If

End Property

Property Get hWndMousePosY(hWnd As Long, iMode As enMode) As Long
'Gets the mouse cursor position in respect to the window/form that
'has the handle argument hWnd

Dim lMousePos As Long
Dim ScreenPos As POINTAPI
Dim hWndPos As RECT
Dim RetVal As Long

'First get the Get the Cursor position inrespect to the screen
RetVal = GetCursorPos(ScreenPos)

'Next get the position of the window
Call GetWindowRect(hWnd, hWndPos)

'Calc the y Position
lMousePos = ScreenPos.Y - hWndPos.Top

'Convert the mode if needed
If iMode = bTwips Then
hWndMousePosY = PixelsToTwipsY(lMousePos)
Else
hWndMousePosY = lMousePos
End If

End Property
Property Get ScreenMousePosY(iMode As enMode) As Long

Dim lMousePos As Long
Dim RetPos As POINTAPI
Dim RetVal As Long

'Get the Cursor position
RetVal = GetCursorPos(RetPos)

'Get the X position
lMousePos = RetPos.Y

'Convert the mode if needed
If iMode = bTwips Then
ScreenMousePosY = PixelsToTwipsY(lMousePos)
Else
ScreenMousePosY = lMousePos
End If

End Property
Property Let SwapMouseBtn(bSwap As Boolean)
'Function to swap the left and right mouse buttons around

Dim lRetVal As Long

lRetVal = SwapMouseButton(bSwap)

End Property

Property Get CursorHeight() As Long
'Returns the Height of the Cursor

Dim lHeight As Long

lHeight = GetSystemMetrics(SM_CYCURSOR)

CursorHeight = lHeight

End Property

Property Get CursorWidth() As Long
'Returns the Width of the Cursor

Dim lWidth As Long

lWidth = GetSystemMetrics(SM_CXCURSOR)

CursorWidth = lWidth

End Property

Public Function TwipsToPixelsX(lTwips As Long) As Long
'Converts the input number of Twips into Pixels

TwipsToPixelsX = lTwips / Screen.TwipsPerPixelX

End Function

Public Function PixelsToTwipsX(lPixels As Long) As Long
'Converts the input number of Pixels into Twips

PixelsToTwipsX = lPixels * Screen.TwipsPerPixelX

End Function
Public Function TwipsToPixelsY(lTwips As Long) As Long
'Converts the input number of Twips into Pixels

TwipsToPixelsY = lTwips / Screen.TwipsPerPixelY

End Function
Public Function PixelsToTwipsY(lPixels As Long) As Long
'Converts the input number of Twips into Pixels

PixelsToTwipsY = lPixels * Screen.TwipsPerPixelY

End Function
Public Function ButtonDown(lButton As enMouseBtn)
'This simulates a mouse button down event

Select Case (lButton)

'Left button down
Case btnLeft
Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)

'Middle button down
Case btnMiddle
Call mouse_event(MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0)

'Right button down
Case btnRight
Call mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0)

End Select

End Function

Public Function DoubleClick(lButton As enMouseBtn)
'This simulates a double click mouse button event

Select Case (lButton)

'Left button down
Case btnLeft
Call SingleClick(btnLeft)
Call SingleClick(btnLeft)

'Middle button down
Case btnMiddle
Call SingleClick(btnMiddle)
Call SingleClick(btnMiddle)

'Right button down
Case btnRight
Call SingleClick(btnRight)
Call SingleClick(btnRight)

End Select

End Function

Public Function SingleClick(lButton As enMouseBtn)
'This simulates a Single click mouse button event

Select Case (lButton)

'Left button down
Case btnLeft
Call ButtonDown(btnLeft)
Call ButtonUp(btnLeft)

'Middle button down
Case btnMiddle
Call ButtonDown(btnMiddle)
Call ButtonUp(btnMiddle)

'Right button down
Case btnRight
Call ButtonDown(btnRight)
Call ButtonUp(btnRight)

End Select

End Function
Public Function ButtonUp(lButton As enMouseBtn)
'This simulates a mouse button down event

Select Case (lButton)

'Left button down
Case btnLeft
Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)

'Middle button down
Case btnMiddle
Call mouse_event(MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0)

'Right button down
Case btnRight
Call mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0)

End Select

End Function

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

'Do all the initalisation here as soon as the program goes into run mode
If UserControl.Ambient.UserMode = True Then

'Get the original Cursor pointer
lOrigCursor = GetCursor

'Initialise the bezier move flag to stopped
bStop = True
End If

End Sub

Private Sub UserControl_Resize()

'Keep the user control to a default size
UserControl.Width = 360
UserControl.Height = 560

End Sub

Comment
From: raya70
Date: Wednesday, December 08 1999 - 06:54AM EST
Thanx, that other routine was just what I was looking for. great!

AzraSound

couldnt you just call a click event for whatever object you are over?

mcrider

AzraSound,

Since neilmcaliece is using the SetCursorPos API, the physical mouse is not really being moved... The mouse pointer just "jumps" to the location specified in the API. This works really well in the scenario where you are running a demonstration... a physical mouse may not even be attached to the system, so there is nothing to click...

Cheers!®©

mcrider