Creating a Bitmap of monitor that is scaled

Question

Hello,

I do add-in for excel using VBA.

my task is:

to create a screenshot of a active monitor (not window), what is relly important the Taskbar must be visible on this screenshot.
I've got a perfectly working code.

Option Explicit
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As rect) As Long
Private Declare PtrSafe Function MonitorFromPoint Lib "user32" (ByVal x As Long, ByVal y As Long, ByVal dwFlags As Long) As LongPtr
Private Declare PtrSafe Function GetMonitorInfo Lib "user32" Alias "GetMonitorInfoA" (ByVal hMonitor As LongPtr, ByRef lpmi As monitorInfo) As LongPtr
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr
Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
Private Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As LongPtr
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As LongPtr
Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
Private Type rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type monitorInfo
    cbSize As Long
    rcMonitor As rect
    rcWork As rect
    dwFlags As Long
End Type
Private Const MONITOR_DEFAULTTONEAREST As Long = &H2
Private Const CF_BITMAP As Long = 2
Private Const SRCCOPY As Long = &HCC0020 ' Numerical value of vbSrcCopy
Sub CaptureActiveMonitor()
    Dim hWndActive As LongPtr
    Dim rect As rect
    Dim hMonitor As LongPtr
    Dim monitorInfo As monitorInfo
    Dim hdcScreen As LongPtr
    Dim hdcMemDC As LongPtr
    Dim hBitmap As LongPtr
    Dim hOldBitmap As LongPtr
    Dim width As Long
    Dim height As Long
    
    ' Get the handle of the active window
    hWndActive = GetForegroundWindow()
    
    ' Get the window rectangle of the active window
    GetWindowRect hWndActive, rect
    
    ' Get the handle of the monitor containing the active window
    hMonitor = MonitorFromPoint((rect.Left + rect.Right) / 2, (rect.Top + rect.Bottom) / 2, MONITOR_DEFAULTTONEAREST)
    
    ' Get the monitor information
    monitorInfo.cbSize = Len(monitorInfo)
    GetMonitorInfo hMonitor, monitorInfo
    
    ' Calculate the width and height of the monitor
    width = monitorInfo.rcMonitor.Right - monitorInfo.rcMonitor.Left
    height = monitorInfo.rcMonitor.Bottom - monitorInfo.rcMonitor.Top
    
    ' Get the device context of the entire screen
    hdcScreen = GetDC(0)
    
    ' Create a compatible memory device context for the screen and a bitmap
    hdcMemDC = CreateCompatibleDC(hdcScreen)
    hBitmap = CreateCompatibleBitmap(hdcScreen, width, height)
    
    ' Select the bitmap into the compatible memory device context
    hOldBitmap = SelectObject(hdcMemDC, hBitmap)
    
    ' Copy the screen to the compatible memory device context
    BitBlt hdcMemDC, 0, 0, width, height, hdcScreen, monitorInfo.rcMonitor.Left, monitorInfo.rcMonitor.Top, SRCCOPY
    
    ' Open and clear the clipboard
    OpenClipboard 0
    EmptyClipboard
    
    ' Set the bitmap data to the clipboard
    SetClipboardData CF_BITMAP, hBitmap
    
    ' Close the clipboard
    CloseClipboard
    
    ' Cleanup
    SelectObject hdcMemDC, hOldBitmap
    DeleteObject hBitmap
    DeleteDC hdcMemDC
    ReleaseDC 0, hdcScreen
End Sub

The problem appears, when one of the displays is scaled i.e. to 125%. It causes that bitmap is also scaled and is cropped. Could you please advice how to make full monitor screenshot of scaled display?

Screenshots:
1 - non-scaled monitor
2 - scaled monitor to 125%

Thanks in advance!