[RESOLVED] Get actual monitor DPI scaling factor

[fafalone]

I need a method that finds the DPI scaling regardless of whether DPI awareness is on or off in the app.

Previously I had been using this solution from LaVolpe:

    Dim tDC As LongPtr, lRez As Long, lDPI As Long
    tDC = GetDC(0)
    lRez = GetDeviceCaps(tDC, DESKTOPHORZRES)
    ReleaseDC 0, tDC
    lDPI = 96! * lRez / (Screen.Width / Screen.TwipsPerPixelX)
    mActualZoom = CSng(lDPI) / 96!

Ironically, this works when dpi awareness is off, but not when it's on. When it's off, it returns 1.5 (correct) but when it's on, it gives 1.0 (wrong).

A number of other solutions I've found by searching fail in one or the other. I'd take the larger value, but what if it's less than 100%? I'd use GetProcessDpiAwareness or GetScaleFactorForMonitor to determine if I'm scaled, but I don't want to lose Windows 7 compatibility and those are 8.1+.

[VanGoghGaming]

I got this generic "Init" function:

Public Sub InitPublicVariables()
Dim hDC As Long
    hDC = GetDC(0): lRES_X = GetDeviceCaps(hDC, HORZRES): lRES_Y = GetDeviceCaps(hDC, VERTRES)
    lDPI_X = GetDeviceCaps(hDC, LOGPIXELSX): lDPI_Y = GetDeviceCaps(hDC, LOGPIXELSY): sngTPP_X = 1440 / lDPI_X: sngTPP_Y = 1440 / lDPI_Y
    hDC = ReleaseDC(0, hDC)
End Sub

[AAraya]

This is what I use in my DPI-aware app and it works great at detecting different DPIs. I've not tested it using an app which is not DPI aware however as that is not a need I have.

    
    Dim hDC As Long
    Dim dpi as Long
    Dim dpiScaleFactor as Single
    hDC = GetDC(0&)
    dpi = GetDeviceCaps(hDC, LOGPIXELSY)
    dpiScaleFactor = (hDC / 96)
    ReleaseDC 0&, hDC

[VanGoghGaming]

And also this custom scale function:

Public Function MyScale(sngValue As Single, ScaleFrom As ScaleModeConstants, ScaleTo As ScaleModeConstants) As Single
Const HimetricPerPixel As Single = 26.45834
    Select Case True
        Case ScaleFrom = ScaleTo
            MyScale = sngValue
        Case (ScaleFrom = vbTwips) And (ScaleTo = vbPixels)
            MyScale = sngValue / sngTPP_X
        Case (ScaleFrom = vbPixels) And (ScaleTo = vbTwips)
            MyScale = sngValue * sngTPP_X
        Case (ScaleFrom = vbTwips) And (ScaleTo = vbPoints)
            MyScale = sngValue / 20
        Case (ScaleFrom = vbPoints) And (ScaleTo = vbTwips)
            MyScale = sngValue * 20
        Case (ScaleFrom = vbPixels) And (ScaleTo = vbPoints)
            MyScale = sngValue * sngTPP_X / 20
        Case (ScaleFrom = vbPoints) And (ScaleTo = vbPixels)
            MyScale = sngValue * 20 / sngTPP_X
        Case (ScaleFrom = vbPixels) And (ScaleTo = vbHimetric)
            MyScale = sngValue * HimetricPerPixel
        Case (ScaleFrom = vbHimetric) And (ScaleTo = vbPixels)
            MyScale = sngValue / HimetricPerPixel
    End Select
End Function

All to avoid using the "Screen" object which is dependent on DPI awareness (or lack thereof).

[baka]

what about:

- Get the physical screen dimensions using HORZSIZE/VERTSIZE

- Get the logical screen dimensions using HORZRES/VERTRES

after that:

dpiX = (logicalScreenWidth * 254) / physicalScreenWidthMM;
dpiY = (logicalScreenHeight * 254) / physicalScreenHeightMM;

[Elroy]

Independent of your manifest, I'm not sure there's a way to do this "per monitor".

I can do it globally, but not per monitor.

---

I have jumped into this rabbit-hole at least twice. The MSDN says you can make a link between monitor numbers and the actual hMonitor, but I've never been able to make it work, and that's what you need to do for this.

Another way is to explore the monitor's registry EDID information, but that's also highly unreliable, especially if the computer often has different monitors plugged into it and/or you're using a somewhat older monitors. Older monitors don't broadcast their EDID information.

---

I haven't looked at this lately, and maybe the API is fixed on later versions of Win10 and maybe Win11. It'd be super nice if it were.

[Elroy]

About as close as I can get, but requires manifest (see comments).

Option Explicit

Private Declare Function GetScaleFactorForMonitor Lib "shcore.dll" (ByVal hMonitor As Long, ByRef pScale As Long) As Long
Private Declare Function GetModuleHandleW Lib "kernel32.dll" (ByVal lpModuleName As Long) As Long
Private Declare Function LoadLibraryExW Lib "kernel32.dll" (ByVal lpFileName As Long, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Boolean
Private Declare Function MonitorFromWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal dwFlags As Long) As Long


Private Sub Form_Activate()
    MsgBox "Move this form to another monitor then click it to check it." & vbCrLf & _
           "Scaling: " & MonitorScaleFactor(hMonitorForForm(Me))
End Sub

Private Sub Form_Click()
    MsgBox "Move this form to another monitor then click it to check it." & vbCrLf & _
           "Scaling: " & MonitorScaleFactor(hMonitorForForm(Me))
End Sub



Public Function hMonitorForForm(frm As Form) As Long
    ' The monitor that the window is MOSTLY on.
    Const MONITOR_DEFAULTTONULL = &H0
    hMonitorForForm = MonitorFromWindow(frm.hWnd, MONITOR_DEFAULTTONULL)
End Function


Public Function MonitorScaleFactor(hMonitor As Long) As Single
    ' If we don't have the GetScaleFactorForMonitor call, just return 1, as it's probably an old version of Windows.
    '
    ' For this to be correctly used, the application should be manifested with gdiScaling=True.
    ' This is different from either the dpiAwareness or dpiAware settings.  For MAPS, DPI should always be 96.
    ' The following is a manifest for doing that:
    '
    '<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3" >
    ' ...
    '  <asmv3:application>
    '    <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2017/WindowsSettings">
    '      <gdiScaling>true</gdiScaling>
    '    </asmv3:windowsSettings>
    '  </asmv3:application>
    ' ...
    '</assembly>
    '
    Dim iScale As Long
    Dim iRet As Long
    '
    If Not DllFunctionExists("shcore.dll", "GetScaleFactorForMonitor") Then
        MonitorScaleFactor = 1!
        Exit Function
    End If
    '
    iRet = GetScaleFactorForMonitor(hMonitor, iScale)
    If iRet <> 0 Then
        MonitorScaleFactor = 1!
        Exit Function
    End If
    '
    ' If we got to here, we've got a good scale factor.
    MonitorScaleFactor = CSng(iScale) / 100!
End Function


Public Function DllFunctionExists(ByVal sModule As String, ByVal sFunction As String) As Boolean
    ' This is for STANDARD DLLs.
    ' DllExists <--- just so we can find it.
    ' This can test for the existence of any DLL's function, no API declaration required.
    ' The caller may want to set a static for this test so that it's not called repeatedly.
    ' Finding DLLs is discussed here: https://msdn.microsoft.com/en-us/library/windows/desktop/ms682586(v=vs.85).aspx
    Dim hHandle As Long
    '
    hHandle = GetModuleHandleW(StrPtr(sModule))
    If hHandle = 0& Then
        hHandle = LoadLibraryExW(StrPtr(sModule), 0&, 0&)
        If hHandle <> 0& Then
            If GetProcAddress(hHandle, sFunction) <> 0& Then DllFunctionExists = True
        End If
    Else
        If GetProcAddress(hHandle, sFunction) <> 0& Then DllFunctionExists = True
    End If
    FreeLibrary hHandle
End Function

[fafalone]

@VanGoghGaming, that's pretty much what I had been using but it's for dpi-unaware only

@AAraya, I use that for the virtualized zoom; it doesn't tell you actual zoom.

@baka, if DPI awareness is enabled, logical and physical will be the same; I had tried that too:

    Dim miex As MONITORINFOEX
    miex.info.cbSize = LenB(miex)
    GetMonitorInfo hMonitor, miex
    Dim cxLogical As Long
    cxLogical = (miex.info.rcMonitor.Right - miex.info.rcMonitor.Left)
    Dim cyLogical As Long
    cyLogical = (miex.info.rcMonitor.Bottom - miex.info.rcMonitor.Top)

    'Get the physical width And height of the monitor.
    Dim dm As DEVMODEW
    dm.dmSize = LenB(dm)
    dm.dmDriverExtra = 0
    EnumDisplaySettingsW VarPtr(miex.szDevice(0)), ENUM_CURRENT_SETTINGS, dm 
 
    Dim cxPhysical As Long
    cxPhysical = dm.dmPelsWidth
    Dim cyPhysical As Long
    cyPhysical = dm.dmPelsHeight

    ' Calculate the scaling factor.
    mActualZoom = CSng(cxPhysical) / CSng(cxLogical)

@Elroy, isn't the index of the monitor determined from the order it's received in EnumDisplayMonitors?

[fafalone]

About as close as I can get, but requires manifest (see comments).

Option Explicit

Private Declare Function GetScaleFactorForMonitor Lib "shcore.dll" (ByVal hMonitor As Long, ByRef pScale As Long) As Long
Private Declare Function GetModuleHandleW Lib "kernel32.dll" (ByVal lpModuleName As Long) As Long
Private Declare Function LoadLibraryExW Lib "kernel32.dll" (ByVal lpFileName As Long, ByVal hFile As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Boolean
Private Declare Function MonitorFromWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal dwFlags As Long) As Long


Private Sub Form_Activate()
    MsgBox "Move this form to another monitor then click it to check it." & vbCrLf & _
           "Scaling: " & MonitorScaleFactor(hMonitorForForm(Me))
End Sub

Private Sub Form_Click()
    MsgBox "Move this form to another monitor then click it to check it." & vbCrLf & _
           "Scaling: " & MonitorScaleFactor(hMonitorForForm(Me))
End Sub



Public Function hMonitorForForm(frm As Form) As Long
    ' The monitor that the window is MOSTLY on.
    Const MONITOR_DEFAULTTONULL = &H0
    hMonitorForForm = MonitorFromWindow(frm.hWnd, MONITOR_DEFAULTTONULL)
End Function


Public Function MonitorScaleFactor(hMonitor As Long) As Single
    ' If we don't have the GetScaleFactorForMonitor call, just return 1, as it's probably an old version of Windows.
    '
    ' For this to be correctly used, the application should be manifested with gdiScaling=True.
    ' This is different from either the dpiAwareness or dpiAware settings.  For MAPS, DPI should always be 96.
    ' The following is a manifest for doing that:
    '
    '<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3" >
    ' ...
    '  <asmv3:application>
    '    <asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2017/WindowsSettings">
    '      <gdiScaling>true</gdiScaling>
    '    </asmv3:windowsSettings>
    '  </asmv3:application>
    ' ...
    '</assembly>
    '
    Dim iScale As Long
    Dim iRet As Long
    '
    If Not DllFunctionExists("shcore.dll", "GetScaleFactorForMonitor") Then
        MonitorScaleFactor = 1!
        Exit Function
    End If
    '
    iRet = GetScaleFactorForMonitor(hMonitor, iScale)
    If iRet <> 0 Then
        MonitorScaleFactor = 1!
        Exit Function
    End If
    '
    ' If we got to here, we've got a good scale factor.
    MonitorScaleFactor = CSng(iScale) / 100!
End Function


Public Function DllFunctionExists(ByVal sModule As String, ByVal sFunction As String) As Boolean
    ' This is for STANDARD DLLs.
    ' DllExists <--- just so we can find it.
    ' This can test for the existence of any DLL's function, no API declaration required.
    ' The caller may want to set a static for this test so that it's not called repeatedly.
    ' Finding DLLs is discussed here: https://msdn.microsoft.com/en-us/library/windows/desktop/ms682586(v=vs.85).aspx
    Dim hHandle As Long
    '
    hHandle = GetModuleHandleW(StrPtr(sModule))
    If hHandle = 0& Then
        hHandle = LoadLibraryExW(StrPtr(sModule), 0&, 0&)
        If hHandle <> 0& Then
            If GetProcAddress(hHandle, sFunction) <> 0& Then DllFunctionExists = True
        End If
    Else
        If GetProcAddress(hHandle, sFunction) <> 0& Then DllFunctionExists = True
    End If
    FreeLibrary hHandle
End Function

"old version of Windows" here would be Windows 7, which doesn't have that API but does support DPI virtualization. Trying to stay compatible with it.

[VanGoghGaming]

@VanGoghGaming, that's pretty much what I had been using but it's for dpi-unaware only

Just tested this and it works fine for a DPI-aware manifested app but only when compiled to EXE. The IDE still reports 96 DPI even though I've manifested it for dpiAwareness...

Correction, it works in the IDE as well but I had to restart it after changing the scaling from 100% to 125%, doh!

[Elroy]

@Elroy, isn't the index of the monitor determined from the order it's received in EnumDisplayMonitors?

It's been a while since I've messed with it, but I have a pretty vivid memory that that's not the case. I've sort of let go of all of this, having been very frustrated by it on numerous instances.

But, if you're wanting to stay compatible with Win7, that's going to be a very tough ask.

[VanGoghGaming]

Maybe I don't understand your requirements exactly but (at least for me) "GetDeviceCaps" is definitely reporting the correct DPI regardless whether the EXE is manifested for dpiAwareness or not. The IDE has to be restarted after changing the DPI.

[VanGoghGaming]

Perhaps things are different for Windows 7, I don't know, I've given up on it a long time ago. Starting with Windows 8.1 you also get the WM_DPICHANGED message which makes it rather trivial...

[fafalone]

Maybe I don't understand your requirements exactly but (at least for me) "GetDeviceCaps" is definitely reporting the correct DPI regardless whether the EXE is manifested for dpiAwareness or not. The IDE has to be restarted after changing the DPI.

It reports 1 when DPI awareness is enabled. Which might be correct from some perspective but not what I need.

WM_DPICHANGED is only raised when it changes. no?

[VanGoghGaming]

Yes, it's only raised when DPI changes or when you move the app window from one monitor to another with a different DPI (which also counts as a change I guess).

With "GetDeviceCaps" I get the correct DPI value for any scaling:

- 96 for 100% scaling (ActualZoom: 96/96=1)
- 120 for 125% scaling (ActualZoom: 120/96=1.25)
- 144 for 150% scaling (ActualZoom: 144/96=1.5)

Isn't that what you wanted?

[Eduardo-]

    Dim tDC As LongPtr, lRez As Long, lDPI As Long
    tDC = GetDC(0)
    lRez = GetDeviceCaps(tDC, DESKTOPHORZRES)
    ReleaseDC 0, tDC
    lDPI = 96! * lRez / (Screen.Width / Screen.TwipsPerPixelX) * 15 / (1440 / GetDeviceCaps(tDC, LOGPIXELSX))
    mActualZoom = CSng(lDPI) / 96!

[fafalone]

Yes, it's only raised when DPI changes or when you move the app window from one monitor to another with a different DPI (which also counts as a change I guess).

With "GetDeviceCaps" I get the correct DPI value for any scaling:

- 96 for 100% scaling (ActualZoom: 96/96=1)
- 120 for 125% scaling (ActualZoom: 120/96=1.25)
- 144 for 150% scaling (ActualZoom: 144/96=1.5)

Isn't that what you wanted?

When dpi awareness is enabled, it gives 100/1.0 regardless of monitor scaling; I was trying to get the scaling applied to the monitor itself, which is always 150% if that's what's enabled in display settings.

[fafalone]

    Dim tDC As LongPtr, lRez As Long, lDPI As Long
    tDC = GetDC(0)
    lRez = GetDeviceCaps(tDC, DESKTOPHORZRES)
    ReleaseDC 0, tDC
    lDPI = 96! * lRez / (Screen.Width / Screen.TwipsPerPixelX) * 15 / (1440 / GetDeviceCaps(tDC, LOGPIXELSX))
    mActualZoom = CSng(lDPI) / 96!

Seems to work! Thanks.

[baka]

another thing.

I don't bother to figure out any DPI, instead I just take the screen-size and resize the form within that size
I just use the GetMonitorInfo/MonitorFromWindow APIs and go from there.
basically its almost the same as to get the DPI since, if the user changed the DPI, the screen-size will also be changed.

example:
I noticed that, if I have 1920x1080 in 96DPI, if I change DPI, it will also change the screensize. I get like 1600x900/1280x720 depending on the DPI factor.
so I just retrieve that and resize the form accordingly. not sure what happens if u try to make the .exe aware or not. I do nothing on my part.