使用 VBA 获取屏幕分辨率和 PPI

屏幕分辨率

是指屏幕水平和垂直方向上的像素点数，单位是像素（px），分辨率 800 × 600 的意思是水平方向含有像素数为 800 个，垂直方向像素数 600 个。在屏幕尺寸一样的情况下，分辨率越高，显示效果就越精细和细腻。我们把一张图片用看图软件一直放大，最后就会发现图片由一个个正方形小方格组成，一个小方格就是1像素。

屏幕尺寸

是指屏幕对角线的长度，单位是英寸（inch），比如说32寸的显示器，指的是屏幕对角线的长度是32英寸。

屏幕像素密度

指每英寸屏幕所拥有的像素数（PPI，Pixels Per Inch），注意，这里的每英寸也是指对角线长度，即在一个对角线长度为1英寸的正方形内所拥有的像素数。

用公式来表示屏幕像素密度，屏幕分辨率，屏幕尺寸的关系就是：

知道了这三者之间的关系我们用公式都能计算出 PPI 的值。在 VBA 中可以用 API 函数获取屏幕的分辨率。

使用 GetSystemMetrics 函数获取屏幕分辨率

GetSystemMetrics 函数可以检索指定的系统指标或系统配置设置。检索的所有维度都以像素为单位。

GetSystemMetrics 函数语法如下：

int GetSystemMetrics(
  [in] int nIndex
);

其中参数 nIndex 为要获取的对应信息，这里需要获取屏幕分辨率的参数如下：

使用 GetSystemMetrics 函数获取屏幕分辨率代码如下：

#If VBA7 And Win64 Then
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#End If

Sub GetResolution()
    Dim x, y
    '屏幕水平宽度（像素）
    x = GetSystemMetrics(0)
    '屏幕垂直高度（像素）
    y = GetSystemMetrics(1)
    MsgBox "当前系统的屏幕分辨率为 " & x & " * " & y
End Sub

使用 GetDeviceCaps 函数获取屏幕分辨率和 PPI

GetDeviceCaps 函数可以检索指定设备的特定信息。前面讲的 GetSystemMetrics 函数也是通过调用 GetDeviceCaps 函数来获取屏幕分辨率的。

GetDeviceCaps 函数语法如下：

int GetDeviceCaps(
  [in] HDC hdc,
  [in] int index
);

其中参数 hdc 为要获取的设备的句柄，index 参数为要获取的设备的信息。

可以使用 GetDC 函数获取指定设备的句柄。例如使用 GetDC(0) 获取主显示设备的句柄。

所用到的 index 参数常量如下：

使用 GetDeviceCaps 函数获取物理屏幕尺寸、屏幕分辨率和 PPI 代码如下：

#If VBA7 And Win64 Then
    Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As Long
    Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As Long) As Long
    Declare PtrSafe Function GetDeviceCaps Lib "Gdi32" (ByVal hDC As LongPtr, ByVal index As Long) As Long
#Else
    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
    Declare Function GetDeviceCaps Lib "Gdi32" (ByVal hDC As Long, ByVal index As Long) As Long
#End If

Sub GetPPI()
    ' 定义常量
    Const HORZSIZE = 4
    Const VERTSIZE = 6
    Const HORZRES = 8
    Const VERTRES = 10
    Const LOGPIXELSX = 88
    Const LOGPIXELSY = 90
    
    Dim hDC As Long
    ' 主屏幕句柄
    hDC = GetDC(0)
    
    Dim h, v
    ' 物理屏幕宽度（毫米）
    h = GetDeviceCaps(hDC, HORZSIZE)
    ' 物理屏幕的高度（毫米）
    v = GetDeviceCaps(hDC, VERTSIZE)
    MsgBox "当前物理屏幕宽高为 " & h & " x " & v
    
    Dim x, y
    '屏幕水平宽度（像素）
    x = GetDeviceCaps(hDC, HORZRES)
    '屏幕垂直高度（像素））
    y = GetDeviceCaps(hDC, VERTRES)
    MsgBox "当前系统的屏幕分辨率为 " & x & " x " & y
    
    Dim PPIX, PPIY
    '屏幕水平PPI
    PPIX = GetDeviceCaps(hDC, LOGPIXELSX)
    '屏幕垂直PPI
    PPIY = GetDeviceCaps(hDC, LOGPIXELSY)
    MsgBox "当前显示器的PPI为 " & PPIX & " x " & PPIY
    
    '释放句柄
    ReleaseDC 0, hDC
End Sub