Share My Creation Automatic Textsize Label

There are various automatic Label text sizing libs in the Forum (custom views), but most of them don't have all the parameters of an ordinary Label. My project below is aimed at automatically sizing the text of ordinary Labels:
B4X:
Sub Process_Globals

End Sub

Sub Globals
    Dim Label1 As Label
End Sub

Sub Activity_Create(FirstTime As Boolean)
    Label1.Initialize("Label1")
    Label1.Color = Colors.RGB(60,60,60)
    Label1.textColor = Colors.RGB(255,70,70)
    Activity.AddView(Label1,15%x,30%y,70%x,40%y)    'Make sure the label is high enough to fully show the shortests (and thus largest) texts!
    MAKE_LABEL_DEMONSTRATION1
End Sub

Sub MAKE_LABEL_DEMONSTRATION1    'Demonstration
    Dim n, m As Long
    Label1.Text=""
    For n=0 To 103
      m=n
      If m>=78 Then m=m-78
      If m>=52 Then m=m-52
      If m>=26 Then m=m-26
      Label1.Text = Label1.Text & Chr(65+m)
      Label1.TextSize = AUTO_LABELSIZE1(Label1,8,200)    'Extreme range (8 to 200): Decrease range for faster performance!
      Sleep(80)
    Next
End Sub

'ATTENTION: This Sub is designed for Single Line labels!!
Sub AUTO_LABELSIZE1(AutoLabel1 As Label, AuMin1 As Int, AuMax1 As Int) As Float
    Dim i, LHeight1, LHeight2, Speed1 As Long
    Dim su As StringUtils
    i=0
    AutoLabel1.TextSize = AuMin1
    Speed1=DateTime.Now
    Do While i <= (AuMax1-AuMin1)
      If AutoLabel1.TextSize > AuMax1 Then Exit
      LHeight1 = su.MeasureMultilineTextHeight(AutoLabel1,AutoLabel1.Text)
      AutoLabel1.TextSize = AutoLabel1.TextSize * 1.4
      LHeight2 = su.MeasureMultilineTextHeight(AutoLabel1,AutoLabel1.Text)
      'Log(Label1.Text & ", Size=" & AutoLabel1.TextSize & ", LHeight1= " & LHeight1 & ", LHeight2= " & LHeight2)
      If LHeight2 > LHeight1*1.5 Then                 'Occurs when wordwrap!    
        Do Until LHeight2 <= LHeight1*1.5
          AutoLabel1.TextSize = AutoLabel1.TextSize-1
          LHeight2 = su.MeasureMultilineTextHeight(AutoLabel1,AutoLabel1.Text)
        Loop
        Exit
      End If
      i=i+1
    Loop
    Log("Speed= " & (DateTime.Now - Speed1) & "msec.")
    Return AutoLabel1.TextSize
End Sub

Sub Activity_Resume

End Sub

Sub Activity_Pause (UserClosed As Boolean)

End Sub

The trick of this project is to start with a small textsize and then increase the size until wordwrap occurs. Subsequently the size is reduced to the value before the wordwrap.
Please note that this project is intended for single line Labels, but can easily be adapted for multi-line Labels by playing with the Min and Max size values.
 
Last edited:

JohnC

Expert
Licensed User
You should post this under "B4A Code Snippet":

 
Top