[gelöst] Blocksatz mit Canvas

[mulcheo]

Hallo,

ich will über eine Canvasroutine (geht leider nicht anders) Text auf dem Bildschirm ausgeben und nutze hierfür Canvas.TextOut(). Das funktioniert auch ganz prima, nur habe ich bei der Ausgabe mehrerer Zeilen unterschiedlicher Länge lediglich einen linksbündigen Text. Ich hätte aber gerne so etwas wie Blocksatz realisiert.

Gibt es eine einfache Möglichkeit, den Text [string] beim TextOut so zu strecken, dass er eine bestimmte Länge annimmt? Vorzugsweise dadurch, dass (wie beim normalen Blocksatz auch) nur die 'Space' gestreckt/gestaucht werden und die Texthöhe sowie andere Parameter erhalten bleiben?

p.s. die Strings sind alle ungefähr gleich lang, der Unterschied beträgt da max. 6-7%.

Vielleicht hat jemand von euch ja bereits eine Routine für Ähnliches geschrieben. Ansonsten wäre meine Idee, zunächst mal die Breite aller Wörter und Zeichenketten des Strings (ohne Space) über TextWidth zu ermitteln, die vorhandenen Space zu zählen und dann zu berechnen, wie viele Pixel jeweils ein Space haben müsste. Im zweiten Schritt dachte ich dann daran, jedes Wort einzeln (also den String stückweise ohne Space) auszugeben und jeweils mit TextOut(x,y) die Sapce selbst zu setzen. Klingt das sinnvoll?

[edit:] ist gelöst, Danke!

[Komoluna]

Vielleicht findes du ja was in TCanvas.TextRect...
Die methode hat eine Menge Formatierungsfeatures

MFG

Komoluna

[martin_frb]

Ansonsten wäre meine Idee, zunächst mal die Breite aller Wörter und Zeichenketten des Strings (ohne Space) über TextWidth zu ermitteln, die vorhandenen Space zu zählen und dann zu berechnen, wie viele Pixel jeweils ein Space haben müsste. Im zweiten Schritt dachte ich dann daran, jedes Wort einzeln (also den String stückweise ohne Space) auszugeben und jeweils mit TextOut(x,y) die Sapce selbst zu setzen. Klingt das sinnvoll?

Keine Ahnung ob es was fertiges gibt. Insbesondere auch je nach Platform...

Der Ansatz ist zunaechst korrekt. Haengt aber vom Text Inhalt ab.

Wenn der Text auch RTL (Arabisch, und andere) enthalten kann, wird es kompliziert, weil dann die Woerter in anderer Reihenfolge auf den Bildschirm muessen. Dass gilt sogar schon beim aufteilen in Zeilen...

Ausserdem gibt es in UTF8 verschiedene Leerzeichen. Z.B. Leerzeichen mit halber Breite. Oder Leerzeichen ohne Breite (lediglich als Markierung, das ein ZeilenUmbruch erlaubt ist.)

[Patito]

Für spezielle Wünsche an die Textausgabe, habe ich immer direkt die Windows-Api benutzt (z.B. Windows.DrawText).
Vermutlich ist Windows.SetTextJustification() für Blocksatz gedacht.
Unter Linux wird es dafür sicher andere APIs geben...

In TCanvas ist sicher schon viel drin, aber meine Spezialitäten waren entweder nicht da oder gut versteckt.
Daher habe ich lieber ohne viel zu suchen gleich die rohe API genommen - die ist zwar oft unhandlich, aber es gibt dafür am ehesten
(brauchbare?) Informationen.

[mulcheo]

TextRect bietet leider nicht, was ich brauche (Canvas.Textstlye ist zu beschränkt). Die Sache ist aber ganz nett, was die Organisation von Zeilenumbrüchen angeht...

Ich zögere noch, meine eigene function zu schreiben und hänge derzeit am Tipp, die Windows Api zu nutzen, verstehe aber die gesamte Syntax nicht...

[Edit 2h später]: Mhmmm, so langsam macht die Sache Sinn. Im Übrigen lag die Lösung irgendwo zwischen den Beipsielen, die man so im Netz findet... irgendwie waren alle in die ein der andere Richtung etwas schief aber ich glaube, ich hab's nun.

hier meine Testroutine, nach der die Richtung klar sein müsste, vielleicht interessiert's ja auch andere

Code: Alles auswählen

var
  Zeile: string;
  a: INteger;
 
begin
  Canvas.Font.Name:='Times New Roman';
  Canvas.TextOut(50,200,'Hier der Referenztext mit einigen Space');
  Zeile:='Ein Test mit vier Space';
  for a:= 0 to 5 do begin
    SetTextJustification(Canvas.Handle, 10*a, 4);
    Canvas.TextOut(50,50+(a*20),Zeile);
  end;
  // wird nun für jedes weitere Textout verwendet, daher reset zum Ausgangszustand...
  SetTextJustification(Canvas.Handle,0,0);
  Canvas.TextOut(50,220,'Hier der Referenztext mit einigen Space');
end;

p.s. auf DrawText habe ich zum Glück verzichten können, das hatte für mich auch eine zu kryptische Syntax.

Eine Frage aber drängt sich mir dann doch auf; beim Problelauf mit TextRect ist mir aufgefallen, dass ich durch die Beifügung von Windows zu den units (denn sonst zieht SetTextJustification nicht) manche Befehle nicht mehr wie zuvor nutzen kann. Wenn ich beispielsweise vorher (var Rechteck: Trect) RechtEck:= rect(10,10,100,50); nehmen konnte, muss ich nun den komplizierteren Weg über Rechteck.Left:=10, Rechteck.Right:=100 etc. gehen, weil es sonst einen compliererror gibt.
Kann es sein, dass mir die unit Windows noch mehr functionen verhagelt und wenn ja, welche? Ich wäre ja ziemlich aufgeschmissen, wenn sich nun etwas beispielsweise im Filehandling ändern würde. Was wäre eigentlich die einfachste Lösung in einem solchen Fall?

[wp_xyz]

Du hast wahrscheinlich die Windows-Unit an der falschen Stelle in der Uses-Liste: Windows definiert ein eigenes Rect, und es wird nicht das aus Classes genommen. Setze Windows vor Classes, dann sollte es gehen (oder auch umgekehrt - ich kann mir das nie merken...).

[Michl]

Kann es sein, dass mir die unit Windows noch mehr functionen verhagelt und wenn ja, welche?

Ja, die Unit Windows stellt einige Routinen zur Verfügung, die ansonsten plattformübergreifend die RTL oder auch LCL bereitstellen würden, welche alle, kannst Du ja selber in der Unit nachlesen.

Was wäre eigentlich die einfachste Lösung in einem solchen Fall?

Um weiterhin z.B. das Rect(10,10,100,50) zu nutzen, müsstest Du einfach die Unit Windows als erstes in die Uses-Klausel einfügen. Alternativ könntest Du auch noch den Unitnamen der aufzurufende Funktion (z.B. Rechteck:=Classes.Rect(10,10,100,50);) vor diese schreiben - ist aber umständlicher.

[Patito]

Gut. Falls es mit SetTextJustification() mal nicht funktionieren sollte, kann es an der Schriftart liegen.
Mit Windows.GetTextMetrics() kann man sich den Charakter besorgen, bei dem die API versucht den Leerraum einzufügen
(normalerweise #32). Wenn man die Schriftart nicht ändert, ist bei mir tmBreakChar = #13, und damit funktioniert
dann SetTextJustification() nicht.

[Horst_h]

Hallo,

eine Variante, die kein Windows braucht.Für Fliesstext und Blocksatz.
"ausgeben" kann man entfernen.Diese war nur für Tests.

Code: Alles auswählen

 
const
  cTrenner = ' ';
....
procedure TextAufCanvas(const canv: TCanvas; const Ausgabe: string;
  Maxbreite: integer; ausgeben: boolean = True; blocksatz: boolean = False);
const
  KeinBlockSatzFaktor = 3 / 4;
var
  OldBrush: tbrush;
  tmpWordList: TStringList;
  Wordwidths: array of integer;
  deltaTrenner, momLenTren: double;
  trnCnt, momIdx, altIdx, momHeight, rowdist, txtHeight, maxHeight,
  canvLeft, lenZeile, lenWort, lenTrenner: integer;
  done: boolean;
 
begin
  rowdist := 2;
  tmpWordList := TStringList.Create;
  Oldbrush := Canv.brush;
  try
    tmpWordList.Delimiter := cTrenner;
    tmpWordList.DelimitedText := Ausgabe;
    setlength(Wordwidths, tmpWordList.Count);
 
    with Canv do
    begin
      for trnCnt := tmpWordList.Count - 1 downto 0 do
        Wordwidths[trnCnt] := TextWidth(tmpWordList[trnCnt]);
 
      brush.Style := bsSolid;
      brush.Color := clwindow;
      with cliprect do
      begin
        momHeight := top;
        canvleft := left;
        maxHeight := Bottom;
        if MaxBreite > Right - left then
          Maxbreite := Right - left;
      end;
      Fillrect(ClipRect);
      txtHeight := -Font.Height;
      lenTrenner := TextWidth(cTrenner);
      momIdx := 0;
      done := momIdx >= Length(Wordwidths);
      while not (done) do
      begin
        //Wieviele Worte passen in eine Zeile
        lenZeile := 0;
        //Anzahl Worttrenner
        trnCnt := 0;
        altIdx := MomIdx;
        repeat
          lenWort := Wordwidths[momIdx] + lenTrenner;
          Inc(lenZeile, lenWort);
          done := (momIdx >= (Length(Wordwidths) - 1));
          if done or (lenZeile >= MaxBreite) then
            break;
          Inc(momIdx);
          Inc(trnCnt);
        until done;
 
        //Zuviel angehaengtes Trennzeichen am Ende
        //LenWort ist jetzt Trennzeichen+Wort
        //statt Wort+Trennzeichen
        Dec(LenZeile, lenTrenner);
        if trnCnt > 0 then
        begin
          if LenZeile > MaxBreite then
          begin
            Dec(lenZeile, lenWort);
            Dec(momIdx);
            Dec(trnCnt);
            done := False;
          end;
          if (trnCnt >= 1) then
          begin
            //Neue Trennerbreite
            deltaTrenner := lenTrenner;
            if (lenZeile > KeinBlockSatzFaktor * MaxBreite) and blocksatz then
              deltaTrenner := (MaxBreite - LenZeile) / trnCnt + deltaTrenner;
            //Zum runden
            momLenTren := 0.5;
            repeat
              if ausgeben then
                TextOut(canvleft + trunc(momLenTren), momHeight, tmpWordList[altIdx]);
              momLenTren := momLenTren + deltaTrenner + WordWidths[altIdx];
              Inc(altIdx);
            until altIdx > MomIdx;
          end;
        end;
        //nur ein Wort moeglich
        if (trnCnt = 0) and ausgeben then
          TextOut(canvleft, momHeight, tmpWordList[momIdx]);
        Inc(momIdx);
        // Nichts mehr anzuzeigen
        if momHeight > maxHeight then
          BREAK;
        Inc(momHeight, TxtHeight + rowdist);
      end;
    end;
 
  finally
    tmpWordList.Free;
    Canv.brush := Oldbrush;
  end;
end;

Gruß Horst