VB.NET Graphics.DrawString调整大小的字体，以适应容器与自动换行

Question

我从MSDN拿下面的例子，并将其转换为VB。然后对其进行调整，以考虑容器的高度以考虑换字。

public Font GetAdjustedFont(Graphics GraphicRef, string GraphicString, Font OriginalFont, int ContainerWidth, int MaxFontSize, int MinFontSize, bool SmallestOnFail) 
{ 
// We utilize MeasureString which we get via a control instance   
for (int AdjustedSize = MaxFontSize; AdjustedSize >= MinFontSize; AdjustedSize--) 
{ 
    Font TestFont = new Font(OriginalFont.Name, AdjustedSize, OriginalFont.Style); 

    // Test the string with the new size 
    SizeF AdjustedSizeNew = GraphicRef.MeasureString(GraphicString, TestFont); 

    if (ContainerWidth > Convert.ToInt32(AdjustedSizeNew.Width)) 
    { 
// Good font, return it 
    return TestFont; 
    } 
} 

// If you get here there was no fontsize that worked 
// return MinimumSize or Original? 
if (SmallestOnFail) 
{ 
    return new Font(OriginalFont.Name,MinFontSize,OriginalFont.Style); 
} 
else 
{ 
    return OriginalFont; 
} 
} 

这是我有：

Protected Overrides Sub OnPaint(e As PaintEventArgs) 
    MyBase.OnPaint(e) 

    Dim drawFont As New System.Drawing.Font(SystemFonts.DefaultFont.Name, 16) 
    Dim drawBrush As New System.Drawing.SolidBrush(Me.ForeColor) 
    Dim drawFormat As New System.Drawing.StringFormat 

    drawFont = GetAdjustedFont(e.Graphics, noticeText, drawFont, RectangleF.op_Implicit(ClientRectangle), 40, 8, True) 

    e.Graphics.DrawString(noticeText, drawFont, drawBrush, RectangleF.op_Implicit(ClientRectangle)) 

    drawFont.Dispose() 
    drawBrush.Dispose() 

End Sub 

Public Function GetAdjustedFont(ByRef GraphicRef As Graphics, ByVal GraphicString As String, ByVal OriginalFont As Font, ByVal ContainerSize As RectangleF, ByVal MaxFontSize As Integer, ByVal MinFontSize As Integer, ByVal SmallestOnFail As Boolean) As Font 

    ' We utilize MeasureString which we get via a control instance   
    For AdjustedSize As Integer = MaxFontSize To MinFontSize Step -1 

     Dim TestFont = New Font(OriginalFont.Name, AdjustedSize, OriginalFont.Style) 

     ' Test the string with the new size 
     Dim AdjustedSizeNew = GraphicRef.MeasureString(GraphicString, TestFont, ContainerSize.Size) 

     If ContainerSize.Width > Convert.ToInt32(AdjustedSizeNew.Width) Then 
      If ContainerSize.Height > Convert.ToInt32(AdjustedSizeNew.Height) Then 
       ' Good font, return it 
       Return TestFont 
      End If 
     End If 
    Next 

    ' If you get here there was no fontsize that worked 
    ' return MinimumSize or Original? 
    If SmallestOnFail Then 
     Return New Font(OriginalFont.Name, MinFontSize, OriginalFont.Style) 
    Else 
     Return OriginalFont 
    End If 
End Function 

的ClientRectangle是456宽48高。我试图打印的文本是“这是一个测试字符串，看看应用程序调整文本的大小以适应控件。”字体被返回为28号大小，我只能看到“这是一个可以看到的测试字符串”。

我希望它能够包装文本并使用最大的字体，这将允许显示所有文本，但我正在努力解决如何实现它。

Answer 1

我设法让它工作。我没有比较打印字符串的宽度和高度与容器的对比，而是检查了MeasureString是否能够适合所有字符。测量字符串时，我不得不减小绘图矩形的高度，因为底线的一半被较长的字符串剪切。

Protected Overrides Sub OnPaint(e As PaintEventArgs) 
    MyBase.OnPaint(e) 

    Dim drawFont As New System.Drawing.Font(SystemFonts.DefaultFont.Name, 16) 
    Dim drawBrush As New System.Drawing.SolidBrush(Me.ForeColor) 
    Dim drawFormat As New System.Drawing.StringFormat 

    Dim drawRect As New RectangleF(e.ClipRectangle.Location, e.ClipRectangle.Size) 
    drawRect = New RectangleF(New Drawing.PointF(0, 0), Me.ClientRectangle.Size) 
    drawRect.Height = drawRect.Height * 0.65 'The bottom line of text was getting partially clipped, so reduced the height of the drawing area to 65% 

    drawFont = GetAdjustedFont(e.Graphics, noticeText, drawFont, drawRect, 40, 4, True) 

    e.Graphics.DrawString(noticeText, drawFont, drawBrush, RectangleF.op_Implicit(ClientRectangle)) 

    drawFont.Dispose() 
    drawBrush.Dispose() 

End Sub 

Public Function GetAdjustedFont(ByRef GraphicRef As Graphics, ByVal GraphicString As String, ByVal OriginalFont As Font, ByVal ContainerSize As RectangleF, ByVal MaxFontSize As Integer, ByVal MinFontSize As Integer, ByVal SmallestOnFail As Boolean) As Font 

    'Loop through font sizes and MeasureString to find the largest font which can be used   
    For AdjustedSize As Integer = MaxFontSize To MinFontSize Step -1 

     Dim TestFont = New Font(OriginalFont.Name, AdjustedSize, OriginalFont.Style) 
     Dim charsFitted As Integer 
     Dim linesFilled As Integer 

     ' Test the string with the new size 
     Dim AdjustedSizeNew = GraphicRef.MeasureString(GraphicString, TestFont, ContainerSize.Size, New StringFormat, charsFitted, linesFilled) 

     If charsFitted = GraphicString.Length Then 'If every characted in the string was printed 
      'Good font, return it 
      Return TestFont 
     End If 

    Next 

    ' If you get here there was no fontsize that worked 
    ' return MinimumSize or Original? 
    If SmallestOnFail Then 
     Return New Font(OriginalFont.Name, MinFontSize, OriginalFont.Style) 
    Else 
     Return OriginalFont 
    End If 
End Function 

Answer 2

谢谢你这个伟大的解决方案！

一点点扩展： 如果你只想一个oneliner改变你的“好字体如果子句” =>

If charsFitted = GraphicString.Length And linesFilled = 1 Then 
    Return TestFont 
End If