获取Windows显示缩放值

Question

有没有办法获得Windows的显示缩放值？图中的200％正是我想要的。

这个问题只是达到另一个目的的一半，这个问题在这个问题中提出：Excel Shape position disturbed by Windows Display Zoom settings

Answer 1

您可以使用WIN32-API调用检索此信息

Option Explicit

Private Const LOGPIXELSX As Long = 88

#If VBA7 Then
    Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
#Else
    Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
#End If

Public Function GetDpi() As Long
    #If VBA7 Then
        Dim hdcScreen As LongPtr
    #Else
        Dim hdcScreen As Long
    #End If
    hdcScreen = GetDC(0)

    Dim iDPI As Long
    iDPI = -1

    If (hdcScreen) Then
        iDPI = GetDeviceCaps(hdcScreen, LOGPIXELSX)
        ReleaseDC 0, hdcScreen
    End If

    GetDpi = iDPI
End Function

这将导致192例如200%：

• 96 - 较小的100％
• 120 - 中等125％
• 144 - 更大150％
• 192 - 超大200％
• 240 - 自定义250％
• 288 - 定制300％
• 384 - 自定义400％
• 480 - 自定义500％