Solved

API call to do a Mouse click in VB6

Posted on 2000-03-03
5
574 Views
Last Modified: 2008-02-20
Hi,

I can move the cursor to a specified position in VB6 using something
like this :


Declare Function SetCursorPos& Lib "user32" (ByVal X As Long, ByVal Y As Long)

And then calling this :

t& = SetCursorPos(50,100)


But I also want to make the system do a left mouse button click at
this point.

Can anyone tell me how exactly I should declare the function and call
it so the left mouse button is clicked at it's current position without
touching the mouse.

This is for a simple macro program I'm writing.


Thanks

Neil McAliece



0
Comment
Question by:neilmcaliece
  • 4
5 Comments
 
LVL 14

Accepted Solution

by:
mcrider earned 100 total points
ID: 2580435
See http://www.experts-exchange.com/jsp/qShow.jsp?ta=visualbasic&qid=10244077  

There is a complete example there...


Cheers!®©
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2580448
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!

 
0
 
LVL 28

Expert Comment

by:AzraSound
ID: 2580497
couldnt you just call a click event for whatever object you are over?
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2580536
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!®©
0
 
LVL 14

Expert Comment

by:mcrider
ID: 2590311
Thanks for the points! Glad I could help!


Cheers!®©
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now