How to position a userform on the mouse

Working with cursor position in Excel/VBA

Occasionally you might need to know the mouse position, for example if you need to position a form there. An example of a project using this technique is here jSon and Dynamic Forms.

Positioning

To be able to find out the mouse position, we have to use calls to the Windows API. Luckily talking to Windows API is rather straightforward. The first step is to declare the functions we are going to use, and which windows library to find them.


Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Declare Function GetDeviceCaps Lib "Gdi32" (ByVal hdc As Long, _
     ByVal nIndex As Long) As Long

Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
     ByVal hdc As Long) As Long

GetDC and ReleaseDC return and release a handle that can be used to handle the 'device context', and GetDeviceCaps returns device specific parameters for that context. 

Pixels versus points
We are going to use this to return 2 device specific parameters which are identified by these constants.  This will give us the pixels per inch on the monitor. We need this because mouse position is expressed in pixels, but form positioning is expressed in points/inch. So to be able to translate one to the other we need to know the currently selected  resolution.

Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
Public Function pointsPerPixelX() As Double
    Dim hDC As Long
    hDC = GetDC(0)
    pointsPerPixelX = 72 / GetDeviceCaps(hDC, LOGPIXELSX)
    ReleaseDC 0, hDC
End Function

Public Function pointsPerPixelY() As Double
    Dim hDC As Long
    hDC = GetDC(0)
    pointsPerPixelY = 72 / GetDeviceCaps(hDC, LOGPIXELSY)
    ReleaseDC 0, hDC
End Function

Mouse position

Now that we know how to convert between pixels and points, the next step is get the cursor position in pixels. This is returned as a composite Type that includes the X and Y (or left and top) co-ordinates of the mouse, using the  GetCursorPos Windows API call

Public Type tCursor
    left As Long
    top As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (p As tCursor) As Long

Public Function WhereIsTheMouseAt() As tCursor
    Dim mPos As tCursor
    GetCursorPos mPos
    WhereIsTheMouseAt = mPos
End Function

Converting pixels to points
 Putting all that together we can now return the mouse position coverted to points so that we can position a userform where the mouse it positioned.  Here is the complete code, where convertmousetoform() will return a tCursor pair that can be used as the top and left property of a userform.

Option Explicit
' these are special function to get device specific things

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Declare Function GetDeviceCaps Lib "Gdi32" (ByVal hDC As Long, _
     ByVal nIndex As Long) As Long

Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
     ByVal hDC As Long) As Long

Const LOGPIXELSX = 88
Const LOGPIXELSY = 90

' we need to be able to find cursor position where mouse was clicked
Public Type tCursor
    left As Long
    top As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (p As tCursor) As Long

Public Function pointsPerPixelX() As Double
    Dim hDC As Long
    hDC = GetDC(0)
    pointsPerPixelX = 72 / GetDeviceCaps(hDC, LOGPIXELSX)
    ReleaseDC 0, hDC
End Function

Public Function pointsPerPixelY() As Double
    Dim hDC As Long
    hDC = GetDC(0)
    pointsPerPixelY = 72 / GetDeviceCaps(hDC, LOGPIXELSY)
    ReleaseDC 0, hDC
End Function

Public Function WhereIsTheMouseAt() As tCursor
    Dim mPos As tCursor
    GetCursorPos mPos
    WhereIsTheMouseAt = mPos
End Function
Public Function convertMouseToForm() As tCursor
    Dim mPos As tCursor
    mPos = WhereIsTheMouseAt
    mPos.left = pointsPerPixelY * mPos.left
    mPos.top = pointsPerPixelX * mPos.top
    convertMouseToForm = mPos
End Function

 

Comments