Gambas-it

Gambas dal mondo esterno => Mailing List => Topic aperto da: vuott - 15 Giugno 2022, 05:27:31

Titolo: Rilevare quando il testo eccede la dimensione orizzontale di una Label
Inserito da: vuott - 15 Giugno 2022, 05:27:31

https://lists.gambas-basic.org/pipermail/user/2022-June/076268.html

Titolo: Re:Rilevare quando il testo eccede la dimensione orizzontale di una Label
Inserito da: Gianluigi - 16 Giugno 2022, 17:05:56

Siccome le ultime mie due risposte non seguono il thred (sono sparite  :-\ ) metto qui il codice da me suggerito a Steve:

Codice: [Seleziona]

Public Sub Form_Open()

  Dim s As String = "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua."
  Dim iRows As Integer
  Dim hFont As Font
  Dim hTextLabel As TextLabel

  With hTextLabel = New TextLabel(Me) As "TextLabel1"
    .X = 50
    .Y = 50
    .W = 100
    .H = 100
    .AutoResize = False
    .Wrap = True
    .Text = s
    .Border = 1
    hFont = .Font
  End With

  iRows = Rows(hTextLabel.Text, hTextLabel.Width, hFont)

  While (iRows * hFont.Height) > hTextLabel.Height
    hFont.Size -= 0.5
    iRows = Rows(hTextLabel.Text, hTextLabel.Width, hFont)
  Wend

End

Private Function Rows(value As String, iWidth As Integer, hFont As Font) As Integer

  Dim i As Integer
  Dim ss As String[]
  Dim sRow As String

  If hFont.TextWidth(value) < iWidth Then Return 1
  ss = Split(value, " ")
  For Each s As String In ss
    sRow &= " " & s
    If hFont.TextWidth(sRow) > iWidth Then
      sRow = s
      Inc i
    Endif
  Next
  Return i + 1

End

Nota: il codice va copiato in un nuovo progetto grafico.

 :ciao:

Titolo: Re:Rilevare quando il testo eccede la dimensione orizzontale di una Label
Inserito da: Gianluigi - 17 Giugno 2022, 23:09:10

Comunque anche se pare che io non abbia capito quello che voleva se si desidera ridurre un testo fino a farlo stare all'interno di una Label invece che di una TextLabel che ha la proprietà Wrap, basta aggiungere la funzione:

Codice: [Seleziona]

Private Function RowSplit(value As String, iWidth As Integer, hFont As Font) As String

  Dim i As Integer
  Dim ss As String[]
  Dim sRow As String

  If hFont.TextWidth(value) < iWidth Then Return 1
  ss = Split(value, " ")
  For Each s As String In ss
    If hFont.TextWidth(sRow & " " & s) > iWidth Then
      sRow &= "\n"
      sRow &= s
    Else 
      sRow = sRow & " " & s
    Endif
  Next
  Return Trim(sRow)

End

che passa alla label il testo della giusta dimensione, tutto il testo senza troncarlo.
Probabilmente c'è un modo migliore per farlo ma a me è venuto in mente solo questo.