Visual Basic环境下Windows Forms适配不同尺寸显示器的组件缩放问题

核心适配逻辑 #

你需要的全局等比拉伸效果不需要逐个修改控件属性，通过窗体级全局缩放逻辑即可实现，以下两种方案可按需选择： #

方案1：矢量控件缩放（文本清晰度更高） #

完全重写默认缩放逻辑，批量遍历所有控件统一调整位置、尺寸和字体大小，适配任意显示器DPI：

• 第一步：调整App Manifest配置
  确认已在Manifest文件中启用DPI感知，避免系统强行模糊拉伸，配置项如下：

  <application xmlns="urn:schemas-microsoft-com:asm.v3">
    <windowsSettings>
      <dpiAware xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">true/PM</dpiAware>
      <dpiAwareness xmlns="http://schemas.microsoft.com/SMI/2016/WindowsSettings">PerMonitorV2</dpiAwareness>
    </windowsSettings>
  </application>
  

• 第二步：修改窗体基础属性
  将所有窗体的AutoScaleMode设置为None，AutoSize设置为False，保留设计时3840*2160的基础尺寸。
• 第三步：添加全局缩放代码
  把以下代码添加到父窗体或者公共模块中，所有业务窗体直接复用即可：

  ' 设计时基准参数，对应4K 225%缩放下的设计环境
  Private ReadOnly DesignBaseSize As Size = New Size(3840, 2160)
  Private ReadOnly DesignBaseDPI As Integer = 216
  
  Private Sub Form_Load(sender As Object, e As EventArgs) Handles MyBase.Load
      ScaleEntireForm()
  End Sub
  
  Private Sub Form_DpiChanged(sender As Object, e As DpiChangedEventArgs) Handles MyBase.DpiChanged
      ScaleEntireForm()
  End Sub
  
  Private Sub ScaleEntireForm()
      Using g As Graphics = Me.CreateGraphics()
          Dim currentDPI As Integer = CInt(g.DpiX)
          Dim scaleRatio As Single = currentDPI / DesignBaseDPI
          ' 缩放窗体整体尺寸
          Me.Size = New Size(CInt(DesignBaseSize.Width * scaleRatio), CInt(DesignBaseSize.Height * scaleRatio))
          ' 递归缩放所有子控件
          ScaleChildControls(Me.Controls, scaleRatio)
      End Using
  End Sub
  
  Private Sub ScaleChildControls(ctrlList As Control.ControlCollection, ratio As Single)
      For Each ctrl As Control In ctrlList
          ' 缩放控件位置和尺寸
          ctrl.Location = New Point(CInt(ctrl.Location.X * ratio), CInt(ctrl.Location.Y * ratio))
          ctrl.Size = New Size(CInt(ctrl.Width * ratio), CInt(ctrl.Height * ratio))
          ' 缩放字体大小
          ctrl.Font = New Font(ctrl.Font.FontFamily, ctrl.Font.Size * ratio, ctrl.Font.Style)
          ' 递归处理容器类控件的子元素
          If ctrl.HasChildren Then
              ScaleChildControls(ctrl.Controls, ratio)
          End If
      Next
  End Sub
  

方案2：位图拉伸（完全还原设计比例，实现最简单） #

如果对清晰度要求不高，希望完全实现「整个窗体作为图片拉伸」的效果，直接用绘制位图的方式即可，不需要修改任何控件属性：

Protected Overrides Sub OnPaint(e As PaintEventArgs)
    MyBase.OnPaint(e)
    ' 创建设计尺寸的缓冲位图
    Using bufferBmp As New Bitmap(3840, 2160)
        Using bufferG As Graphics = Graphics.FromImage(bufferBmp)
            ' 将所有控件绘制到缓冲位图
            Me.DrawToBitmap(bufferBmp, New Rectangle(0, 0, 3840, 2160))
            ' 高质量拉伸到当前窗体尺寸
            e.Graphics.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
            e.Graphics.DrawImage(bufferBmp, New Rectangle(0, 0, Me.Width, Me.Height))
        End Using
    End Using
End Sub

Protected Overrides Sub OnResize(e As EventArgs)
    MyBase.OnResize(e)
    ' 窗体尺寸变化时重绘
    Me.Invalidate()
End Sub

注意事项 #

• 包含自定义绘制逻辑的特殊控件（如DataGridView、RichTextBox）可单独添加适配逻辑，不需要调整普通标签、按钮等基础控件。
• 方案1默认适配所有DPI的显示器，不需要修改系统缩放设置。

内容的提问来源于stack exchange，提问作者REC