是否根据屏幕区域更改字体大小

Question

我正在努力使其在屏幕区域更改时字体也会更改！我已经得到了它来正确计算字体大小，并用断点进行了检查。然而，fontSize并没有适当地更改，例如，我在1300x740上运行程序，fontSize被计算为13，但它不会将字体更改为该大小，即使变量fontSize等于13，相反，字体比13小得多。我尝试制作一个临时变量Dim fontSize As Integer = 13，这将文本框更改为正确的大小。

这是我的代码：

Private Function Resizing()
Dim totalBaseScreenArea As Double = 1936 * 1100
Dim totalCurrentScreenArea As Double = Me.Width * Me.Height
Dim value As Double = totalCurrentScreenArea / totalBaseScreenArea
Dim fontSize As Integer = Math.Ceiling(txtEnterMP.Font.Size * value)
txtEnterMP.Font = New Font(txtEnterMP.Font.FontFamily, fontSize, txtEnterMP.Font.Style)
End Function

如有任何帮助，我们将不胜感激！

Answer 1

此解决方案根据表单的大小/面积计算新的字体大小。在设计器中，向空白表单添加一个名为lblFont的标签，并将其锚定在所有四个角上。

在后面的代码中，添加以下代码：

Public Class Form1
Private OriginalFontSize As Single = Me.Font.Size
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Call Resizing()
End Sub
Private Sub Form1_ResizeEnd(sender As Object, e As EventArgs) Handles MyBase.ResizeEnd
Call Resizing()
End Sub
Private Sub Resizing()
Try
'Get the screen resolution of your monitor (may not be the monitor the program is running on)
Dim iWidth As Integer = SystemInformation.PrimaryMonitorSize.Width
Dim iHeight As Integer = SystemInformation.PrimaryMonitorSize.Height
'Calculate screen area
Dim totalBaseScreenArea As Double = iWidth * iHeight
Dim totalCurrentScreenArea As Double = Me.Width * Me.Height
'Calculate the new font size
Dim value As Single = (totalCurrentScreenArea / totalBaseScreenArea) * 30
Dim NewFontSize As Single = Math.Ceiling(OriginalFontSize * value)
'Stop the font from being super tiny and hard to read
If NewFontSize < 8 Then NewFontSize = 8
'Display the new font size
Me.Text = "Calculated: " & NewFontSize
Me.Font = New Font(Me.Font.FontFamily, NewFontSize, Me.Font.Style)
lblFont.Text = "The font size of this label is " & NewFontSize
Catch Exp As Exception
lblFont.Text = Exp.Message
End Try
End Sub
End Class