VBA 访问 - 测量显示单元

Question

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

但是，当我使用 GetDeviceCaps 函数时，它 returns 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://docs.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://docs.microsoft.com/en-us/windows/win32/learnwin32/dpi-and-device-independent-pixels

如果你想计算出你的 PPI，那么你可以使用这个计算：

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

制造商告诉您对角线是 28"，但您可以使用 HORZSIZE (4) 和 VERTSIZE (6) 使用 GetDeviceCaps 检查。这将以毫米为单位，因此要转换为英寸，您需要除以 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 类型在 VBA 7 之前的版本上会出错，您需要进行条件编译。我没有包括它，因为它应该适用于 2010+，并且已经有大量资源支持旧版本。

VBA 访问 - 测量显示单元

VBA Access - Measure Display Unit

ms-access

vba

dpi