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