高DPI下界面错乱的解决方法和原理[源代码]

Dpi_Ratio.BAS
---------------------------------------------

Option Explicit
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Public DpiRatio As Single

Public Sub DpiRatioIni()
    Dim DPI As Long
    DPI = GetDeviceCaps(GetDC(0), 88)
    DpiRatio = 1440 / DPI / 15
End Sub

FORM
--------------------------------------

Private Sub Form_Initialize()
    On Error Resume Next
    Call DpiRatioIni
    If DpiRatio <> 1 Then
        With Me
            .Left = .Left * DpiRatio
            .Width = .Width * DpiRatio
            .Top = .Top * DpiRatio
            .Height = .Height * DpiRatio
            .FontSize = .FontSize * DpiRatio
        End With

        Dim obj
        For Each obj In Controls
            With obj
                .Left = .Left * DpiRatio
                .Width = .Width * DpiRatio
                .Top = .Top * DpiRatio
                .Height = .Height * DpiRatio
                .FontSize = .FontSize * DpiRatio
            End With
        Next
    End If
End Sub

下面是另一段代码:

Option Explicit
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Sub Form_Initialize()
    On Error Resume Next
    Dim DC0 As Long, DPI As Long, DpiRatio As Single
    DC0 = CreateDC("DISPLAY", vbNullString, vbNullString, 0)
    DPI = GetDeviceCaps(DC0, 88)
    If DPI <> 0 Then
        DpiRatio = 1440 / DPI / 15
        If DpiRatio <> 1 Then
            With Me
                .Left = .Left * DpiRatio
                .Width = .Width * DpiRatio
                .Top = .Top * DpiRatio
                .Height = .Height * DpiRatio
                .FontSize = .FontSize * DpiRatio
            End With

            Dim obj
            For Each obj In Controls
                With obj
                    .Left = .Left * DpiRatio
                    .Width = .Width * DpiRatio
                    .Top = .Top * DpiRatio
                    .Height = .Height * DpiRatio
                    .FontSize = .FontSize * DpiRatio
                End With
            Next
        End If
    End If
End Sub