VBA Draw on userform

I have a life of suffering whenever I tried to draw “accurately” on an Excel Userform. The thing is that the management of units and sizes/position of the userform it’s a real pain “in that part”.
When you call GetCursorPos API function, the mouse position is retrieved in pixels, but if you want to set the size on the userform the units are Twips. Worse is that you need a reference point, and even with everything properly tunned, you find that the dimensions are close but they do not match 100%.
In every userform there is a caption/tittle bar and surrounding the userform there is a “border” (even if the userform is set to fmBorderStyleNone = 0), you can see a fading shadow that is included in the GetWindowRect API… 
For a long time my best guess was that the mouse position was not on the tip but on some intermediate position… until I decided to take a photo of the screen with the mobile and count the pixels. WTF!
Following code will output sizes and cursor positions to several labels (Label1, Label2, Label3). Label3 should match the Userform.InteriorWidth and UserForm.InteriorHeight value. Label1 reflects the UserForm_MouseDown X,Y values (in Twips), and should match the computed values from GetCursorPos in Label2:

Option Explicit

'API Declares
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As tPointAPI) As Long
Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal wOptions As Long, ByVal lpRect As Any, ByVal lpString As String, ByVal nCount As Long, lpDX As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, ByRef lpRect As RectAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RectAPI) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long

#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
    Private Declare PtrSafe Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
    Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    'Private Declare PtrSafe Function CreateFontIndirect Lib "gdi32.dll" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
    'Private Declare PtrSafe Function CreateFont Lib "gdi32.dll" Alias "CreateFontA" (ByVal nHeight As Integer, ByVal nWidth As Integer, ByVal nEscapement As Integer, ByVal nOrientation As Integer, ByVal fnWeight As Integer, ByVal fdwItalic As Long, ByVal fdwUnderline As Long, ByVal fdwStrikeOut As Long, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long
    Private Declare PtrSafe Function SelectObject Lib "gdi32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
    Private Declare PtrSafe Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
    Private Declare PtrSafe Function GetTextExtentPoint32 Lib "gdi32.dll" Alias "GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As tPointAPI) As Long
    Private Declare PtrSafe Function MulDiv Lib "kernel32.dll" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
    Private Declare PtrSafe Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
    Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32.dll" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWndForm As LongPtr, ByVal hDCForm As LongPtr) As Long

    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    
    Private Declare PtrSafe Function GdiplusStartup Lib "gdiplus" (ByRef Token As LongPtr, ByRef lpInput As GDIPlusStartupInput, Optional ByVal lpOutputBuf As LongPtr = 0) As Long
    Private Declare PtrSafe Function GdiplusShutdown Lib "gdiplus" (ByVal Token As LongPtr) As Long
    
    Private Declare PtrSafe Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As LongPtr, ByRef graphics As LongPtr) As Long
    Private Declare PtrSafe Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As LongPtr) As Long
    Private Declare PtrSafe Function GdipSetSmoothingMode Lib "GdiPlus.dll" (ByVal mGraphics As LongPtr, ByVal mSmoothingMode As Long) As Long
    
    Private Declare PtrSafe Function GdipCreatePen1 Lib "GdiPlus.dll" (ByVal mColor As Long, ByVal mWidth As Single, ByVal mUnit As GpUnit, ByRef mPen As LongPtr) As Long
    Private Declare PtrSafe Function GdipDeletePen Lib "GdiPlus.dll" (ByVal mPen As LongPtr) As Long
    Private Declare PtrSafe Function GdipCreateSolidFill Lib "GdiPlus.dll" (ByVal mColor As Long, ByRef mBrush As LongPtr) As Long
    Private Declare PtrSafe Function GdipDeleteBrush Lib "GdiPlus.dll" (ByVal mBrush As LongPtr) As Long
    
    Private Declare PtrSafe Function GdipFillRectangleI Lib "GdiPlus.dll" (ByVal mGraphics As LongPtr, ByVal mBrush As LongPtr, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long
    Private Declare PtrSafe Function GdipFillEllipseI Lib "GdiPlus.dll" (ByVal mGraphics As LongPtr, ByVal mBrush As LongPtr, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long
    
    Private Declare PtrSafe Function GdipDrawLineI Lib "gdiplus" (ByVal mGraphics As LongPtr, ByVal mPen As LongPtr, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare PtrSafe Function GdipDrawRectangleI Lib "GdiPlus.dll" (ByVal mGraphics As LongPtr, ByVal mPen As LongPtr, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long
    Private Declare PtrSafe Function GdipDrawEllipseI Lib "GdiPlus.dll" (ByVal mGraphics As LongPtr, ByVal mPen As LongPtr, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long
    Private Declare PtrSafe Function GdipDrawBezierI Lib "gdiplus" (ByVal mGraphics As LongPtr, ByVal mPen As LongPtr, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
    Private Declare PtrSafe Function Polyline Lib "gdi32" (ByVal hDC As Long, lpPoint As tPointAPI, ByVal nCount As Long) As Long
    
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

    Private Type GDIPlusStartupInput
      GdiPlusVersion                      As Long
      DebugEventCallback                  As LongPtr
      SuppressBackgroundThread            As Boolean
      SuppressExternalCodecs              As Boolean
    End Type

#Else
    Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
    Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    'Private Declare Function CreateFontIndirect Lib "gdi32.dll" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
    'Private Declare Function CreateFont Lib "gdi32.dll" Alias "CreateFontA" (ByVal nHeight As Integer, ByVal nWidth As Integer, ByVal nEscapement As Integer, ByVal nOrientation As Integer, ByVal fnWeight As Integer, ByVal fdwItalic As Long, ByVal fdwUnderline As Long, ByVal fdwStrikeOut As Long, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long
    Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
    Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
    Private Declare Function GetTextExtentPoint32 Lib "gdi32.dll" Alias "GetTextExtentPoint32A" (ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As tPointAPI) As Long
    Private Declare Function MulDiv Lib "kernel32.dll" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
    Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hDC As Long, ByVal nIndex As Long) As Long
    Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" (ByVal hWndForm As LongPtr, ByVal hDCForm As LongPtr) As Long

    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

    Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef Token As LongPtr, ByRef lpInput As GDIPlusStartupInput, Optional ByVal lpOutputBuf As LongPtr = 0) As Long
    Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal Token As LongPtr) As Long
    
    Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As LongPtr, ByRef graphics As LongPtr) As Long
    Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Long
    Private Declare Function GdipSetSmoothingMode Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mSmoothingMode As Long) As Long
    
    Private Declare Function GdipCreatePen1 Lib "GdiPlus.dll" (ByVal mColor As Long, ByVal mWidth As Single, ByVal mUnit As GpUnit, ByRef mPen As Long) As Long
    Private Declare Function GdipDeletePen Lib "GdiPlus.dll" (ByVal mPen As Long) As Long
    Private Declare Function GdipCreateSolidFill Lib "GdiPlus.dll" (ByVal mColor As Long, ByRef mBrush As Long) As Long
    Private Declare Function GdipDeleteBrush Lib "GdiPlus.dll" (ByVal mBrush As Long) As Long
    
    Private Declare Function GdipFillRectangleI Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mBrush As Long, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long
    Private Declare Function GdipFillEllipseI Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mBrush As Long, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long
    
    Private Declare Function GdipDrawLineI Lib "gdiplus" (ByVal mGraphics As Long, ByVal mPen As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
    Private Declare Function GdipDrawRectangleI Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mPen As Long, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long
    Private Declare Function GdipDrawEllipseI Lib "GdiPlus.dll" (ByVal mGraphics As Long, ByVal mPen As Long, ByVal mX As Long, ByVal mY As Long, ByVal mWidth As Long, ByVal mHeight As Long) As Long
    Private Declare Function GdipDrawBezierI Lib "gdiplus" (ByVal mGraphics As Long, ByVal mPen As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
    Private Declare Function Polyline Lib "gdi32" (ByVal hDC As Long, lpPoint As tPointAPI, ByVal nCount As Long) As Long
    
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

    Private Type GDIPlusStartupInput
      GdiPlusVersion                      As Long
      DebugEventCallback                  As Long
      SuppressBackgroundThread            As Boolean
      SuppressExternalCodecs              As Boolean
    End Type
#End If

Private Enum GpUnit
  UnitWorld = 0&
  UnitDisplay = 1&
  UnitPixel = 2&
  UnitPoint = 3&
  UnitInch = 4&
  UnitDocument = 5&
  UnitMillimeter = 6&
End Enum


' CONSTANTS
Private Const TWIPSPERINCH As Long = 1440
' Used to ask System for the Logical pixels/inch in X & Y axis
Private Const LOGPIXELSY As Long = 90
Private Const LOGPIXELSX As Long = 88

'.....................
Private Type tPointAPI
    X As Long
    Y As Long
End Type

Private Type RectAPI
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
'.....................

Private oPoint As tPointAPI
Private oFormRect As RectAPI
Private oClientRect As RectAPI
Private lgParentBorderTop As Long
Private lgParentBorder As Long

Private ppiH As Integer
Private ppiV As Integer
Private dpiH As Integer
Private dpiV As Integer
Private FactorX_pixelToDot As Double
Private FactorY_pixelToDot As Double

Private hDC_Display As Long
Private hWndForm As Long
Private hDCForm As Long

Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Private Const SM_CXSCREEN As Long = 0
Private Const SM_CYSCREEN As Long = 1
Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17

Private Function ConvertPixelsToPoints(ByRef X As Single, ByRef Y As Single)
    X = X * FactorX_pixelToDot
    Y = Y * FactorY_pixelToDot
End Function

Private Sub UserForm_Initialize()
' Total size of monitor in pixels:
    Dim X As Long
    Dim Y As Long

    X = GetSystemMetrics32(SM_CXFULLSCREEN) ' SM_CXSCREEN)
    Y = GetSystemMetrics32(SM_CYFULLSCREEN) ' SM_CYSCREEN)
    
    Dim lgRetVal As Long
    
    'Start Userform Centered inside Excel Screen (for dual monitors)
    Me.StartUpPosition = 0
    Me.Left = Application.Left + (0.5 * Application.Width) - (0.5 * Me.Width)
    Me.Top = Application.Top + (0.5 * Application.Height) - (0.5 * Me.Height)
    
    ' Get hWnd and DC for userform
    hWndForm = FindWindow(vbNullString, Me.Caption)
    hDCForm = GetDC(hWndForm)
    
    ' The window rect includes the non-client area, i.e. the title bar, borders, scroll bars, status bar... The client rect does not (only the size of the area that you can render to), but is a rectangle that is relative to itself.
    Call GetWindowRect(hWndForm, oFormRect)
    Call GetClientRect(hWndForm, oClientRect)
    lgParentBorder = ((oFormRect.Right - oFormRect.Left) - oClientRect.Right) \ 2
    lgParentBorderTop = ((oFormRect.Bottom - oFormRect.Top) - oClientRect.Bottom) - lgParentBorder
    
    hDC_Display = CreateDC("DISPLAY", "", "", 0)
    ppiH = GetDeviceCaps(hDC_Display, LOGPIXELSX) ' pixels per inch
    ppiV = GetDeviceCaps(hDC_Display, LOGPIXELSY) ' pixels per inch
    dpiH = 72                                     ' dots per inch
    dpiV = 72                                     ' dots per inch
    FactorX_pixelToDot = dpiH / ppiH
    FactorY_pixelToDot = dpiH / ppiH
    DeleteDC hDC_Display   ' free memory
    
    Label1.Caption = Me.InsideWidth & " " & Me.InsideHeight ' the inside is the client area // Me.Width & " " & Me.Height
    'Label2.Caption = MulDiv(oRect.Left, dpiH, ppiH) & " " & MulDiv(oRect.Top, dpiV, ppiV)
End Sub

Private Sub UserForm_Click()
    Call GetCursorPos(oPoint)
    Dim oPointDot As tPointAPI
    
    With oPoint
        Call GetWindowRect(hWndForm, oFormRect)
        Label3.Caption = ((oFormRect.Right - oFormRect.Left) - 2 * lgParentBorder) * FactorX_pixelToDot & " " & ((oFormRect.Bottom - oFormRect.Top) - lgParentBorderTop - lgParentBorder) * FactorY_pixelToDot
        
        oPointDot.X = (.X - oFormRect.Left - lgParentBorder) * FactorX_pixelToDot
        oPointDot.Y = (.Y - oFormRect.Top - lgParentBorderTop) * FactorY_pixelToDot
        Label2.Caption = oPointDot.X & " " & oPointDot.Y
    End With
End Sub

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Caption = X & " " & Y
End Sub

Private Sub UserForm_Terminate()
  'Call TerminateGDI
  ReleaseDC hWndForm, hDCForm
End Sub

And that’s all, I can now draw with high acurate in the userform.