VB.NET Graphics.DrawString Resize font to fit container with word wrap

Question

I took the following example from MSDN and converted it to VB. Then adjusted it to try to take the height of the container into consideration to allow for word wrapping.

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;
}
}

Here's what I have:

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

The ClientRectangle is 456 wide by 48 high. The text i'm trying to print is "This is a test string to see how well the application resizes it's text to fit the control.". The font is being returned as size 28 and all I can see is "This is a test string to see".

I want it to wrap the text and use the largest font which will allow all of the text to be displayed, but I'm struggling to work out how to achieve it.

Answer 1

Thank you for this great Solution!

A little extension: When you only want an oneliner change your "Good Font If-Clause" =>

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

Answer 2

I managed to get it working. Rather than comparing the width and height of the printed string against the container, I checked if MeasureString was able to fit all characters. I had to reduce the height of the drawing rectangle when measuring the string because half of the bottom line was getting clipped with longer strings.

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