Dzielenie tekstu na linie (ustalona długość)

Hej,
Czy ma ktoś pomysł na podzielenie ciągu znaków na linie o ustalonej długości, ale bez dzielenia wyrazów?
Czy jest może na to gotowa funkcja?

Taki kod dzieli ciąg znaków na podciągi o ustalonej długości - ale ucina wyrazy!
Ma ktoś pomysł jak to poprawić? A może ktoś przypadkiem robił coś takiego?

procedure StrToStringList(const aSource: String;
                          const aList: TStrings;
                          const aFixedLen: Integer);
var
  idx: Integer;
  srcLen: Integer;
begin
  aList.Capacity := (Length(aSource) div aFixedLen) + 1;

  idx    := 1;
  srcLen := Length(aSource);

  while idx <= srcLen do
  begin
    aList.Add(Copy(aSource, idx, aFixedLen));
    Inc(idx, aFixedLen);
  end;
end;

procedure TEST;
var
	SL_LIST  : TStringList;
	sLine    : string;
   i        : Integer;
begin
	sLine := 'Ubiegłej nocy pod moim kierunkiem siły zbrojne w północno-zachodniej Syrii z powodzeniem przeprowadziły operację antyterrorystyczną, aby chronić obywateli Ameryki i naszych sojuszników oraz' + ' ' + 'uczynić świat bezpieczniejszym miejscem" - czytamy w oświadczeniu Joe Bidena, które po południu polskiego czasu opublikowano na stronie Białego Domu.' + ' ' + 'Jak stwierdzono dalej, przywódca ISIS Abu Ibrahim al-Kurajszi  został "zdjęty z pola bitwy". "Wszyscy Amerykanie wrócili bezpiecznie z operacji" - przekazano w oświadczeniu.';
	SL_LIST := TStringList.Create;
	try
		StrToStringList(sLine, SL_LIST, 100);

      // RESULT
      for i:= 0 to SL_LIST.Count-1 do
         begin
            ShowMessage('Line ' + Inttostr(i+1) + '. ' + #10#13 + SL_LIST.Strings[i]);
         end;
	finally
		SL_LIST.Free;
	end;
end;

W powyższym przykładzie mam 3 sytuacje z problemem dzielonego wyrazu:
Linia 1. przeprowadz[iły]
Linia 2. św [iat]
Linia 3. czas [u]

Jeśli nie ma na to gotowej funkcji, to co radzicie? Cofnąć się w każdej linii o ostatni wyraz (ten ucięty, szukając spacji), czy może czytać go ponad ustalony limit znaków (do pierwszej spacji)...

-Pawel

1. Podzielić tekst po spacjach na tablicę stringów. Wówczas w każdej komórce komórce tablicy mamy jeden wyraz o znanej długości;
2. Poskładać wyrazy w nowe wiersze uwzględniając spacje separujące ;

Robiłem kiedyś coś podobnego, kiedy pisałem TFuriousLabel — tam co prawda tekst był dzielony na sekcje wg znaczników HTML, natomiast aby go wyrenderować, trzeba zbudować listę zawierającą wiersze, a w każdym wierszu umieścić tyle wyrazów, aby jak najmniej linii zużyć. Oczywiście trzeba było wziąć pod uwagę również przypadki brzegowe, czyli sytuację, w której dane słowo jest tak długie, że ono jedno nie mieściłoby się w jednym wierszu, więc trzeba je było podzielić.

Aby coś takiego zrobić, można użyć dwóch znaczników liczbowych, określających indeks znaku początkowego i końcowego. Z ich wykorzystaniem szuka się początku i końca każdego wyrazu, a następnie wypakowuje do listy, sprawdzając długość podciągu po każdej inkrementacji. W mojej kontrolce musiałem tak robić, dlatego że krój oraz rozmiar fontu nie był znany, więc nie można było dodawać stałej szerokości znaku podczas iterowania. Tym bardziej, że kerning mocno wpływa na szerokość słów.

Oczywiście nie trzeba budować listy wierszy i dla każdego wiersza budować listy wyrazów — można tekst podzielić tylko na wiersze.

Pepe napisał(a):

Czy jest może na to gotowa funkcja?

Z tego co się orientuję, nie ma na to gotowej, uniwersalnej funkcji. Trzeba by poszukać w źródłach komponentów wizualnych, czy jakaś kontrolka ma coś takiego zaimplementowane — kontrolka, która potrafi renderować tekst typu String w formie wieloliniowej. Ale te standardowe kontrolki pokroju TLabel, choć to potrafią, to nie używają takich algorytmów, a korzystają z systemowej funkcji DrawText.

Czy ma ktoś pomysł na podzielenie ciągu znaków na linie o ustalonej długości, ale bez dzielenia wyrazów?

Pytanie — czy ta „ustalona długość” dotyczy długości w znakach czy pikselach? Bo to robi bardzo dużą różnicę, jeśli chodzi o implementację. W każdym razie, bardzo prostym rozwiązaniem jest skorzystanie ze znaczników początku i końca linii, a następnie inkrementowanie znacznika końca linii z jednoczesnym sprawdzaniem czy podciąg pomiędzy tymi znacznikami mieści się w linii — jeśli tak to inkrementujemy dalej, a jeśli nie to wypakowujemy linię, przesuwamy znaczniki na jej koniec i zaczynamy od nowa.

@katakrowa: Ciekawy pomysł... sprawdzę.
@furious programming: Ustalona długość w znakach.

Liczyłem na gotową funkcję :) No cóż, trzeba będzie coś wykombinować. Każdy wyraz, który nie mieści się w ustalonym przedziale (czyli np. w linii 100 znaków) zostanie przeniesiony do nowej (a linia skrócona o ten wyraz). Muszę tylko odpowiednio to zaimplementować...

Pobawiłem się trochę i napisałem prostą funkcję, która realizuje to co potrzebujesz — szykuj portfel. ;)

Co prawda jest to Free Pascal, ale da się ten kod łatwo przenieść do Delphi (szczególnie nowego). Kod wygląda tak:

procedure DivideTextToLines(AOutput: TStrings; const AText: String; ALineWidth: Integer);
var
  LineStart, LineEnd, LineChar, LineSeparator: Integer;
  LineHasSeparator: Boolean;
begin
  LineStart := 1;

  while LineStart <= AText.Length do
  begin
    while (LineStart <= AText.Length) and (AText[LineStart] = ' ') do
      LineStart += 1;

    if LineStart <= AText.Length then
    begin
      LineEnd := LineStart + ALineWidth;

      if LineEnd > AText.Length then
      begin
        AOutput.Add(AText.Substring(LineStart - 1));
        Exit;
      end
      else
      begin
        LineChar := LineStart;
        LineHasSeparator := False;

        while LineChar <= LineEnd do
          if AText[LineChar] = ' ' then
          begin
            LineHasSeparator := True;
            LineSeparator := LineChar;

            while (LineChar <= LineEnd) and (AText[LineChar] = ' ') do
              LineChar += 1;
          end
          else
            LineChar += 1;

        if LineHasSeparator then
        begin
          AOutput.Add(AText.Substring(LineStart - 1, LineSeparator - LineStart));
          LineStart := LineSeparator;
        end
        else
        begin
          AOutput.Add(AText.Substring(LineStart - 1, LineEnd - LineStart));
          LineStart := LineEnd;
        end;
      end;
    end;
  end;
end;

Sporo się w nim dzieje, jak na tak z pozoru prostą rzecz, jak dzielenie tekstu. Jednak sprawa nie jest taka prosta, sporo przypadków trzeba obsłużyć, więc i kodu trochę potrzeba. Niżej opis tego co się w tym kodzie dzieje i co jest czym:

• LineStart — indeks pierwszego nie-bialego znaku w linii,
• LineEnd — indeks ostatniego znaku dla danej linii,
• LineChar — iterator używany do szukania separatorów wewnątrz bieżącej linii,
• LineSeparator — indeks ostatniego prawidłowego separatora w bieżącej linii,
• LineHasSeparator — flaga określająca czy w bieżącej linii znajduje się separator.

Teraz działanie algorytmu:

• główna pętla iteruje dotąd, aż znacznik początku linii będzie większy niż długość tekstu,
• jeśli znacznik jest przed końcem tekstu:
  • wyszukiwanie w pętli pierwszego nie-białego znaku,
  • jeśli go znaleziono:
    • ustawienie indeksu końca linii na indeks początkowy plus długość linii,
    • jeśli znacznik końca linii jest poza tekstem:
      • kopiujemy pozostały tekst jako ostatnią linię,
      • wychodzimy z procedury,
    • w przeciwnym razie:
      • ustawiamy indeks iteratora oraz zerujemy flagę,
      • w pętli szukamy separatorów:
        • jeśli bieżący znak jest separatorem:
          • zapalamy flagę określającą istnienie separatorów w linii,
          • zapamiętujemy indeks tego separatora,
          • pomijamy w pętli wszystkie kolejne białe znaki, aż do napotkania nie-białego znaku lub do końca linii,
        • w przeciwnym razie:
          • inkrementujemy iterator,
      • jeśli linia zawiera co najmniej jeden separator:
        • dodajemy do wyjściowej listy podciąg od indeksu pierwszego znaku do separatora
        • ustawiamy indeks pierwszego znaku nowej linii na indeks separatora,
      • w przeciwnym razie:
        • dodajemy do wyjściowej listy podciąg od indeksu pierwszego znaku do indeksu ostatniego znaku,
        • ustawiamy indeks pierwszego znaku na indeks ostatniego znaku.

To by było na tyle. Kod ten nie tylko działa według założeń, ale też przy okazji implementuje pewne dodatkowe ficzery:

• dzieli tekst na linie o zadanej liczbie znaków,
• usuwa białe znaki z początku linii,
• nie zostawia białych znaków na końcach linii,
• jeśli pojedyncze słowo jest dłuższe niż linia to je dzieli na części i je przenosi do nowej linii,
• w razie podzielenia słowa na części, druga część ląduje w nowej linii, a obok niej dalszy tekst,
• wspiera podciągi składające się z wielu następujących po sobie białych znaków.

Stworzyłem do testów małą aplikację okienkową — można się pobawić. Efekt działania wygląda tak:

W załączniku jest archiwum z projektem dla Lazarusa oraz plikiem wykonywalnym do zabawy.

@furious programming: strasznie skomplikowane...
Nie łatwiej użyć: https://docwiki.embarcadero.com/Libraries/Alexandria/en/System.StrUtils.SplitString
a potem w jednej pętli poskładać?

Nie jest skomplikowane, a bogate, wydajne i nie wymaga alokacji dodatkowej pamięci.

Oczywiście, że można użyć jakichś gotowych funkcji, podzielić sobie tekst na wyrazy i później je poukładać w liniach. To co pokazałem to sposób podobny do tego, którego używałem w komponencie etykiety, ale rozwiązań jest nieskończenie wiele — można sobie wybrać to co komu pasuje.

Ale obstawiam, że więcej kodu do napisania będzie wymagane, jeśli przyjdzie zaprogramować ten algorytm tak, aby np. zostawiał podciągi po kilka spacji pomiędzy słowami oraz aby dzielił zbyt długie słowa na części. ;)

No ludzie! Człowiek idzie spać z myślą, że jutro pobawi się w algorytmy, a tu suprise!
Pozostaje mi ładnie podziękować. No i szacun za chęć zmierzenia się z problemem... choć, tak bywa, że człowiek pragnie sobie udowodnić, że dla mnie to nie problem, a małe wyzwanie przy kawie na śniadanie :P Zawsze to jakaś intelektualna zabawa :)

No to chyba temat wyczerpany. Mam nadzieję, że więcej osób skorzysta, bo temat wydaje się być niebanalny.

Można ten kod nieco skrócić i uprościć, tak aby zmniejszyć ifologię:

procedure DivideTextToLines(AOutput: TStrings; const AText: String; ALineWidth: Integer);
var
  LineStart, LineEnd, LineChar, LineSeparator: Integer;
  LineHasSeparator: Boolean;
begin
  LineStart := 1;

  while LineStart <= AText.Length do
  begin
    while (LineStart <= AText.Length) and (AText[LineStart] = ' ') do
      LineStart += 1;

    if LineStart > AText.Length then Exit;

    LineEnd := LineStart + ALineWidth;

    if LineEnd > AText.Length then
    begin
      AOutput.Add(AText.Substring(LineStart - 1));
      Exit;
    end;

    LineChar := LineStart;
    LineHasSeparator := False;

    while LineChar <= LineEnd do
      if AText[LineChar] = ' ' then
      begin
        LineHasSeparator := True;
        LineSeparator := LineChar;

        while (LineChar <= LineEnd) and (AText[LineChar] = ' ') do
          LineChar += 1;
      end
      else
        LineChar += 1;

    if LineHasSeparator then
      LineEnd := LineSeparator;

    AOutput.Add(AText.Substring(LineStart - 1, LineEnd - LineStart));
    LineStart := LineEnd;
  end;
end;

Działanie pozostaje bez zmian. ;)