Search code examples
vbams-accessdpi

VBA Access - Measure Display Unit


I am currently using a 4K (3840x2160) 28-inch (631.93 mm x 359.78 mm) 60Hz IPS monitor, which according to the manufacturer the pixel per inch (DPI/PPI) value should be 157.35.

However, when I use the GetDeviceCaps function, it returns 144. As I am not very familiar with this topic I would be extremely grateful if someone can explain from where the difference is coming. Last but not least, is there a way to calculate my PPI correctly?

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

Solution

  • TLDR: you're not measuring what you think you're measuring;

    88 and 90 are logical pixels per inch (see this enum and the docs for GetDeviceCaps):

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

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

    Logical pixels per inch isn't the same as how many pixels per inch your monitor has. A point (eg 12 pt font), is 1/72 of an inch (in the real world). That's just the physical definition of it. So as far as your computer is concerned, whatever size a 72 pt font is on the screen is an inch (a logical inch). That's slightly compounded by your resolution settings. Since fonts (or anything) don't display the same size on different monitors, you can set your device to a scaling factor, DPI. This is D(ots) P(er) I(nch), but in this case the inch is a logical inch. So if you have your DPI set to 144, then the computer uses 144 dots per logical inch and that's what you're going to get back from LOGPIXELSX and LOGPIXELSY.

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

    IF you want to figure out your PPI, then you can use this calculation:

    enter image description here

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

    The manufacturer has told you the diagonal is 28", but you can check that with GetDeviceCaps, using HORZSIZE (4) and VERTSIZE (6). This will be in mm, so to convert to inches you divide by 25.4. Once you have that, you can get the diagonal with the pythagorean theorem. From there, you can get the resolution of the screen in pixels with HORZRES (8) and VERTRES (10), then use the pythagorean theorem again to get the diagonal in pixels.

    All that's left is to divide the diagonal in pixels by the diagonal in inches.

    Code:

    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
    

    enter image description here

    Be aware that these LongPtr types will error on VBA versions before 7 and you would need to do conditional compilation. I didn't include that because this should work on 2010+, and there are plenty of resources out there already for supporting older versions.