VBA Access - 测量显示单元

Question

我目前使用的是 4K (3840x2160) 28 英寸 (631.93 mm x 359.78 mm) 60Hz IPS 显示器，根据制造商的说法，每英寸像素 (DPI/PPI) 值应为 157.35。

但是，当我使用 GetDeviceCaps 函数时，它返回 144。由于我对这个主题不太熟悉，如果有人可以解释差异的来源，我将非常感激。最后但并非最不重要的一点是，有没有办法正确计算我的 PPI？

Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal Index As Long) As Long

Public Function returnDPI()

Dim hDC As Long
hDC = GetDC(0)

MsgBox GetDeviceCaps(hDC, 88)
MsgBox GetDeviceCaps(hDC, 90)

End Function

Answer 1

TLDR：您测量的并不是您认为正在测量的东西；而是测量的结果。

88 和 90 是每英寸的逻辑像素（请参阅此枚举和 GetDeviceCaps 的文档）：

https://www.pinvoke.net/default.aspx/gdi32.getdevicecaps

https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-getdevicecaps

每英寸逻辑像素与显示器每英寸有多少像素不同。一个点（例如 12 pt 字体）是 1/72 英寸（在现实世界中）。这只是它的物理定义。因此，就您的计算机而言，无论屏幕上的 72 pt 字体大小如何，都是一英寸（逻辑英寸）。您的分辨率设置使情况变得更加复杂。由于字体（或任何内容）在不同的显示器上显示的大小不同，因此您可以将设备设置为缩放系数 DPI。这是 D(ots) P(er) I(nch)，但在这种情况下，英寸是逻辑英寸。因此，如果您将 DPI 设置为 144，则计算机每逻辑英寸使用 144 个点，这就是您将从 LOGPIXELSX 和 LOGPIXELSY 中返回的值。

https://learn.microsoft.com/en-us/windows/win32/learnwin32/dpi-and-device-independent-pixels

如果您想计算出您的 PPI，那么您可以使用以下计算：

https://www.calculatorsoup.com/calculators/technology/ppi-calculator.php

制造商告诉您对角线是 28 英寸，但您可以使用 GetDeviceCaps、使用 HORZSIZE (4) 和 VERTSIZE (6) 进行检查。这将以毫米为单位，因此要转换为英寸，您需要除以 25.4。一旦获得该值，你可以用勾股定理得到对角线。从那里，你可以用 HORZRES (8) 和 VERTRES (10) 得到屏幕的分辨率（以像素为单位），然后再次使用勾股定理得到以像素为单位的对角线。

剩下的就是将像素对角线除以英寸对角线。

代码：

Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal Index As Long) As Long
Option Explicit

Public Function returnPPI() As Double

    Dim hDC As LongPtr
    Dim h As Double, v As Double, di As Double, dpx As Double, ppi As Double
    Dim x As Long, y As Long
    
    hDC = GetDC(0)
    
    h = GetDeviceCaps(hDC, 4) / 25.4 'HORSIZE in mm converted to inches
    v = GetDeviceCaps(hDC, 6) / 25.4 'VERTSIZE in mm converted to inches
    di = (h ^ 2 + v ^ 2) ^ 0.5 ' diagonal in inches, using Pythagoras
    
    x = GetDeviceCaps(hDC, 8) 'HORZRES in pixels
    y = GetDeviceCaps(hDC, 10) 'VERTRES in pixels
    dpx = (x ^ 2 + y ^ 2) ^ 0.5 ' diagonal in pixels, using Pythagoras
    
    ppi = dpx / di
    
    Dim this As Worksheet: Set this = ActiveSheet
    
    this.Cells(1, 1) = "Screen Height, inches"
    this.Cells(1, 2) = v
    this.Cells(2, 1) = "Screen Width, inches"
    this.Cells(2, 2) = h
    this.Cells(3, 1) = "Screen Diagonal, inches"
    this.Cells(3, 2) = di
    
    this.Cells(5, 1) = "Screen Height, pixels"
    this.Cells(5, 2) = y
    this.Cells(6, 1) = "Screen Width, pixels"
    this.Cells(6, 2) = x
    this.Cells(7, 1) = "Screen Diagonal, pixels"
    this.Cells(7, 2) = dpx
    
    this.Cells(9, 1) = "PPI"
    this.Cells(9, 2) = ppi
    
    returnPPI = ppi
    
End Function

请注意，这些 LongPtr 类型在 7 之前的 VBA 版本上会出错，并且您需要进行条件编译。我没有包含它，因为这应该适用于 2010+，并且已经有大量资源用于支持旧版本。