Method: Autosize & Centered Text in a Graphics Object Area (X,Y,Width,Height)

For a Label Printer, i am trying to achieve the following Method:

  1. Define an Area with Left, Top, Width and Height.
  2. Draw a centered (possible Multiline) String into this Area
  3. If the String is to wide to fit into the Width, write it on multiple Lines, but do not exceed the Height.
  4. If the Text would need to be smaller than 9 Points to be able to fit it even on multiple Lines into Width & Height, instead write as much as possible on multiple Lines and condense (…) the rest of the text. But it should still be centered.

Here is an example of the results I’m hoping for:

I need it for an macOS App and the use of MBS or Einhugur Plugins would be ok.

BTW: After 2 days of trying it by myself, I have not even achieved any code I could offer as a starting point. I think this Graphics Stuff is not my “thing” and Font Baselines & Co. are just confusing me… :frowning:

// Paint event of a Canvas For i As Integer = 96 DownTo 6 // max font size down to min font size g.TextSize = i Dim height As Integer = g.StringHeight(zText, g.Width) If height <= g.Height Then g.TextSize = i g.DrawString(zText, 0, g.TextAscent, g.width) // Left aligned Exit End Next

Thank you @Eli Ott :slight_smile:

The hardest part is the centering.

But maybe it’s possible to create a properly dimensioned Xojo Label Object in Memory once we know the FontSize and write the String into it and then somehow draw this Label into the Graphics Object? Would something like this be possible?

One way to accomplish this…

Reduce font size (this could use some optimization)

g.fontsize = 100 While g.stringheight(txt, width) > g.height G.fontsize = g.fontsize - 1 Wend

Now you can split the text for wrapping.

dim lines() as string Dim words() as string = split(txt, “ “) While ubound(words) > -1 Dim currentTxt as string While ubound(words)>-1 and g.stringwidth(currentTxt + “ “ + words(0)) < g.width CurrentTxt = currentTxt + “ “ + words(0) Words.remove(0) Wend Lines.append currentTxt

Now you just have to draw each line centered

dim y as integer = g.TextAscent for I as integer = 0 to ubound(lines) Dim x as integer = (g.width - g.stringwidth(lines(0))/2 G.drawstring, lines(0), x, y Y = y + g.TextHeight Next I

Typed this from memory on my phone, but it looks right…

Draw the text into a picture and slice it into lines, crop each line and center them. Slow because of RGBSurface.Pixel(col, row) test:

[code]Dim pic As New Picture(g.Width, g.Height)

pic.Graphics.ForeColor = RGB(255, 255, 255)
pic.Graphics.FillRect(0, 0, pic.Graphics.Width, pic.Graphics.Height)

pic.Graphics.ForeColor = RGB(0, 0, 0)

For i As Integer = 96 DownTo 6
pic.Graphics.TextSize = i
Dim height As Integer = pic.Graphics.StringHeight(zText, pic.Graphics.Width)
If height <= pic.Graphics.Height Then
pic.Graphics.DrawString(zText, 0, pic.Graphics.TextAscent, pic.Graphics.Width)
Exit
End
Next

g.ForeColor = RGB(255, 255, 255)
g.FillRect(0, 0, g.Width, g.Height)

Dim lines As Integer = Ceil(pic.Graphics.Height / pic.Graphics.TextHeight)

For i As Integer = 0 To lines - 1
Dim y As Single = i * pic.Graphics.TextHeight
Dim pix As New Picture(pic.Graphics.Width, pic.Graphics.TextHeight)
pix.Graphics.DrawPicture(pic, 0, 0, pic.Graphics.Width, pic.Graphics.TextHeight, 0, y, pic.Graphics.Width, pic.Graphics.TextHeight)
Dim column As Integer
For col As Integer = pic.Graphics.Width - 1 DownTo 0
For row As Integer = 0 To pic.Graphics.TextHeight - 1
If pix.RGBSurface.Pixel(col, row) <> RGB(255, 255, 255) Then
column = col + 1
Exit For col
End
Next
Next
Dim x As Integer = (g.Width - column) / 2
g.DrawPicture(pix, x, y)
Next[/code]

Thank you @Greg O’Lone & @Eli Ott

Base on what you both posted, I wrote the following Method, which works like a charm for me :slight_smile:

[code]Public Sub WriteString(Extends g As Graphics, StringToDraw As String, Left As Integer, Top As Integer, Width As Integer, Height As Integer, Optional TextSizeMinimum As Integer = 9, Optional BaseLine As Integer = 0)
// Find best TextSize
For i As Integer = 120 DownTo TextSizeMinimum // max font size down to min font size
g.TextSize = i
If g.StringHeight(StringToDraw, Width) <= Height Then
Exit For i
End
Next

If BaseLine = 0 Then BaseLine = g.TextSize/3*2

// Split StringToDraw into seperate Lines for centering
Dim Lines(-1) As String
Dim Words(-1) As String
Words = StringToDraw.Split

If UBound(Words) > 0 Then

While UBound(Words) > -1
  
  Dim currentTxt As String
  
  While UBound(Words)>-1 And g.StringWidth(currentTxt + " " + Words(0)) < Width
    
    currentTxt = currentTxt + " " + Words(0)
    Words.Remove(0)
    
  Wend
  
  Lines.Append currentTxt 
  
Wend

Else

Lines.Append Words(0)

End If

// Draw each Line centered
Dim tempX As Integer
Dim tempY As Integer = Top + BaseLine

For currentLine As Integer = 0 To UBound(Lines)

tempX = Width/2 - g.StringWidth(Lines(currentLine))/2

If tempY <= Height Then
  
  g.DrawString(Lines(currentLine), Left + tempX, tempY)
  tempY = tempY + g.TextSize
  
Else
  
  g.DrawString(Lines(currentLine), Left + tempX, tempY, Width, True)
  Exit For currentLine
  
End If

Next currentLine

End Sub
[/code]

Edit: Tried to workaround the Baseline “Issue” by adding a 3rd of the TextSize to the Top Value
Edit: Added exit point for text which exceeds Height even with the smallest Font Size

1 Like

Replace

 If tempY <= Height Then

with

 If tempY <= Height-Top Then

please.

And as a tiny optimization

[code]tempX = Width/2 - g.StringWidth( Lines(currentLine) )/2[/code]

with

[code]tempX = (  Width - g.StringWidth( Lines(currentLine) )  )/2[/code]

Made with the Help of @Greg O’Lone , @Eli Ott and @Markus Winter. Thank you. :slight_smile:

[code]Public Sub WriteString(Extends g As Graphics, StringToDraw As String, Left As Integer, Top As Integer, Width As Integer, Height As Integer, Optional TextSizeMinimum As Integer = 9, Optional BaseLine As Integer = 0)
// Find best TextSize
For i As Integer = 120 DownTo TextSizeMinimum // max font size down to min font size
g.TextSize = i
If g.StringHeight(StringToDraw, Width) <= Height Then
Exit For i
End
Next

If BaseLine = 0 Then BaseLine = g.TextSize/3*2

// Split StringToDraw into seperate Lines for centering
Dim Lines(-1) As String
Dim Words(-1) As String
Words = StringToDraw.Split

If UBound(Words) > 0 Then

While UBound(Words) > -1
  
  Dim currentTxt As String
  
  While UBound(Words)>-1 And g.StringWidth(currentTxt + " " + Words(0)) < Width
    
    currentTxt = currentTxt + " " + Words(0)
    Words.Remove(0)
    
  Wend
  
  Lines.Append currentTxt 
  
Wend

Else

Lines.Append Words(0)

End If

// Draw each Line centered
Dim tempX As Integer
Dim tempY As Integer = Top + BaseLine

For currentLine As Integer = 0 To UBound(Lines)

tempX = (  Width - g.StringWidth( Lines(currentLine) )  )/2

If tempY <= Height-Top Then

  g.DrawString(Lines(currentLine), Left + tempX, tempY)
  tempY = tempY + g.TextSize
  
Else
  
  g.DrawString(Lines(currentLine), Left + tempX, tempY, Width, True)
  Exit For currentLine
  
End If

Next currentLine

End Sub[/code]

It’s working now good enough for my needs, but I’ve made a Feature Request for a DrawParagraph Method: <https://xojo.com/issue/49364>

There is a problem with this solution if you have an end of line without text. It will skipped (btw stringHeight has the same bug, it’s easy to bypass but we need another method)

For the alignment you can add a parameter alignment as integer (0-left 1-Center 2-Right) and change:

tempX = (  Width - g.StringWidth( Lines(currentLine) )  )/2

with:

 tempX = (  Width - g.StringWidth( Lines(currentLine) )  )* (alignment/2)

I am guessing this was mostly tested with Top being 0, or nearly 0. But if you are drawing text further down, you’ll see that

If tempY <= Height-Top Then

should be changed to

If tempY <= Height+Top Then