Fit multiline text in a rectangle (centered)

Hi all,

Trying to write a method that takes a width, height and string (along with a few font styles and padding info), then figures out the largest font size that will still fit that string inside a rectangle of the given width and height.

I’ve come up with something that works, but it’s left-justified. Trying to figure out how to center each line when it’s multiline text.

Any tips would be appreciated, here’s what I came up with so far:

Sub FitTextInRect (TheText as string, width as integer, height as integer, FontName as String, C as color, optional Bold as boolean = false, optional Italic as boolean = false, optional LineWrap as boolean = true, optional paddingW as integer = 2, optional paddingH as integer = 2, optional ShadowColor as color = &cffffff, optional ShadowSize as integer = 2)

dim p as new picture (width, height)

if LineWrap then
  TheText = TheText.ReplaceAll("_", " ")
  TheText = TheText.ReplaceAll("-", " ")
end if

if TheText.Trim="" then return p

p.graphics.FontName=FontName
p.graphics.FontUnit=FontUnits.Point
p.graphics.Bold=bold
p.graphics.Italic=italic

dim i as integer = 1, textH as integer

'Increment font size until it gets too big
do until textH > (height - ((2*paddingH)+shadowsize))
  p.graphics.FontSize = p.graphics.fontsize + 1
  textH = p.graphics.TextHeight(TheText, ctype((width-((2*paddingW)+shadowsize)), Double))
loop

p.graphics.fontSize = p.graphics.FontSize-1
'Fontsize is now appropriate to fit into the rectangle with padding.

'Draw the shadow if needed
if shadowsize>0 then
  p.graphics.DrawingColor=ShadowColor
  p.graphics.drawtext TheText, paddingW + ShadowSize, p.graphics.FontAscent+( paddingH + ShadowSize), (width - (paddingW + ShadowSize)), false
end if

'Draw the text
p.graphics.DrawingColor=C
p.graphics.drawtext TheText, paddingw, p.graphics.FontAscent + paddingH, width - paddingw, false

return p

Anyone have any ideas on how to approach ensuring each line is centered instead of left-justified?

Thanks, Cheers.

Measure the size of the line, subtract it from the width of the graphic, and divide by two.

That gives you paddingW.

1 Like

Thanks for the reply, the catch is that DrawText is doing the line breaks so I don’t have access to the line width, only the width of the whole string at its widest point. Is there no way to get DrawText to use a different justification?

Thinking about it, I suppose I could do the line breaks lines myself. Is there a way to calculate how much vertical space DrawText is putting in between lines?

Graphics.TextHeight * 1.2 or something in that vicinity.

1 Like

Thanks! Do I need to take Scale Factor into account with that value?

You don’t seem to do that in your code.

Thanks for the help. Here is the method that seems to work, I’m pleased with it so far.

Sub FitTextInRect (TheText as string, width as integer, height as integer, FontName as String, C as color, optional Bold as boolean = false, optional Italic as boolean = false, optional ReplaceDashes as boolean = true, optional paddingW as integer = 2, optional paddingH as integer = 2, optional ShadowColor as color = &cffffff, optional ShadowSize as integer = 2) as Picture

dim p as new picture (width, height)

if ReplaceDashes then
  TheText = TheText.ReplaceAll("_", " ")
  TheText = TheText.ReplaceAll("-", " ")
end if

if TheText.Trim="" then return p

p.graphics.FontName=FontName
p.graphics.FontUnit=FontUnits.Point
p.graphics.Bold=bold
p.graphics.Italic=italic
p.graphics.DrawingColor = C


dim textH as integer

'Increment font size until it gets too tall
do until textH > (height - ((2*paddingH)+shadowsize))
  p.graphics.FontSize = p.graphics.fontsize + 1
  textH = p.graphics.TextHeight(TheText, ctype((width-((2*paddingW)+shadowsize)), Double))
loop

p.graphics.fontSize = p.graphics.FontSize-1
'Fontsize is now appropriate to fit into the rectangle with padding.

'Now let's split up the string into individual Lines
dim CombinedStr as string, Words() as string = Split(TheText, " ")
dim LineCount as integer = 1
for i as integer = 0 to Words.LastRowIndex
  
  CombinedStr = CombinedStr + If(CombinedStr <> "", " ", "") + Words(i)
  dim CombinedWidth as integer 
  if i < Words.LastRowIndex then CombinedWidth = p.graphics.textwidth(CombinedStr + " "+Words(i+1)) else CombinedWidth = p.graphics.textwidth(CombinedStr)
  
  
  if CombinedWidth >= (width - (2 * paddingW) - ShadowSize) or i = Words.LastRowIndex then 
    'Words(i)=Words(i)+EndOfLine // Only necessary if you want to save the line breaks in the string for later use
    'Draw this text line at the appropriate y position
    dim CenterX as integer = ((width - (2*paddingW) - shadowSize) / 2) - (p.graphics.textwidth(CombinedStr)/2)
    dim YPos as integer = (p.graphics.FontAscent * (LineCount))+ paddingH
    
    'Draw Shadow if needed first
    if ShadowSize > 0 then
      p.graphics.DrawingColor=ShadowColor
      p.graphics.DrawText CombinedStr, CenterX + ShadowSize, Ypos + ShadowSize
      p.graphics.DrawingColor=C
    end if
    'Draw the line's text
    p.graphics.DrawText CombinedStr, CenterX, YPos
    
    CombinedStr=""
    LineCount = LineCount + 1
  end if
  
  
next i

return p

End Sub
2 Likes