Code Example: Automatically resize text to fit textbox

[jwh]

This one drove me crazy for a while, I was used to being able to do this using measuretext when using GDI.

Anyway...
(ONLY suitable for single line textboxes)
Usage:

TextBox1.FontSize = MakeFit(TextBox1,11)

Code:

Function MakeFit(ByVal textbox As TextBox, Optional ByVal MaxFontSize As Double = 22) As Double
        Dim FontSize As Double = MaxFontSize
        textbox.FontSize = FontSize
        Dim TextRectangle As Rect = textbox.GetRectFromCharacterIndex(textbox.Text.Length)
        Dim width As Double = TextRectangle.Right
        Dim height As Double = TextRectangle.Bottom

        Dim MaxWidth As Double = textbox.ActualWidth - (textbox.Padding.Right + textbox.Padding.Left)
        Dim MaxHeight As Double = (textbox.ActualHeight - (textbox.Padding.Top + textbox.Padding.Bottom))
        Do Until width < MaxWidth And height < MaxHeight
            FontSize -= 1
            textbox.FontSize = FontSize
            TextRectangle = textbox.GetRectFromCharacterIndex(textbox.Text.Length)
            width = TextRectangle.Right
            height = TextRectangle.Bottom
        Loop
        Return FontSize
    End Function

 

[RobRelyea]

This has made me curious about this and similar scenarios for font sizing for textboxes. I posted a question about textbox scenarios.