获取Windows显示缩放值

时间:2019-02-25 07:51:01

标签: excel vba screen-resolution

有什么方法可以获取Windows的显示缩放值吗?图片中的200%正是我想要得到的。
enter image description here

这个问题只是实现另一个目的的手段的一半,该目的是在Excel Shape position disturbed by Windows Display Zoom settings

中提出的。

1 个答案:

答案 0 :(得分:2)

您可以通过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%