Modell: Ausgabe von formatiertem Text

[Daniel]

Hallo,

es geht darum, "HTML-ähnlich" formatierten Text auf einem Canvas auszugeben. Dieser (mehrzeilige) Text kann aus Blöcken verschiedener Schriftart, Größe und Farbe bestehen. Für einen Text, der linksbündig ausgerichtet ist, war das auch nicht sonderlich schwer. Interessanter und komplizierter wird es, wenn man den Text zentrieren und dann noch vertikal am unteren Rand eines Rechteckes (z.B. Tabellenzelle) ausrichten will.

Wie könnte man so ein Text-Objekt in geeigneter Weise modellieren? Ein Objekt für den gesamten Text? Mehrere Objekte in Abhängigkeit von der Formatierung? Meine bisherigen Ansätze sind noch nicht besonders befriedigend...

Grüße,
Daniel

[Luckie]

Kuck dir mal DrawText an. Damit kannst du einen Text relativ einfach ausrichten. Aber es wird dir wohl nichts anders übrigbleiben, als alles zusammenzubasteln. Also jedes mal, wenn sich die Formatierung ändert mit CreateFont die Schrift erzeugen und in den Devicekontext laden (löschen nicht vergessen).

[Daniel]

Hallo Luckie,

danke für Deine Antwort. Ich gebe den Text derzeit auch schon mit DrawText aus. Die Formatierungsmöglichkeiten (im Sinne der Ausrichtung) davon kann ich leider nicht nutzen, da sich u.U. mehrmals pro Zeile die Formatierung ändern kann (das wäre dann bestimmt kein besonders gutes Schriftbild - aber ich will nach Möglichkeit keine Einschränkungen machen).

Im Moment mache ich das so, dass jedes Textobjekt bei der Ausgabe seine eigene Höhe und Breite feststellt und diese Daten einem übergeordneten Objekt miteilt, welches seinerseits diese Daten nutzt, uum das folgende Textobjekt zu positionieren. Ich hatte gehofft, dass es da bereits fertige Konzepte (nicht fertige Komponenten) gibt.


Grüße,
Daniel

[Luckie]

Zitat:

Zitat von Daniel

Ich gebe den Text derzeit auch schon mit DrawText aus.

Mist, ich brauche eine neue Glaskugel. :mrgreen:

Könnte man das nicht in ein Richedit formatieren und dann davon ein Bitmap "schiessen" und das dann auf den Canvas blitten?

[Daniel]

Ich wäre gerne unabhängig von den RichEdit-DLLs. (Ausserdem können die keine Tabellen mit Farbverläufen füllen und diese dann halbtransparent auf einem Bitmap-gekachelten Hintergrund darstellen. :mrgreen:

Grüße,
Daniel

[jbg]

Ich habe da so was. Vielleicht kannst du das gut gebrauchen.

Code:

function SubStr(const S: string; StartIndex: Integer; Seperator: Char): string;
var P, F: PChar;
begin
  Result := '';
  if (StartIndex < 1) or (StartIndex > Length(S)) then Exit;
  F := PChar(S) + (StartIndex - 1);
  P := StrScan(F, Seperator);
  if P = nil then Exit;
  SetString(Result, F, P - F);
end;

function IsInTextArray(const S: string; const Args: array of string): Integer;
begin
  for Result := High(Args) downto 0 do
    if CompareText(S, Args[Result]) = 0 then Break;
end;

procedure DrawHlTextEx(Canvas: TCanvas; Rect: TRect; TransparentBkgnd: Boolean;
  const State: TOwnerDrawState; const Text: string; HideSelColor: Boolean;
  LineHeight: Integer; out PlainText: string; out Width, Height: Integer;
  CalcWidth: Boolean);
var
  i: Integer;
  S, A: string;
  OrgRect: TRect;
  TextLayout: TTextLayout;

  function Cmp(S: string): Boolean;
  begin
    Result := AnsiStrLIComp(PChar(Text) + i, PChar(S), Length(S)) = 0;
  end;

  function Cmp1(S: string): Boolean;
  begin
    Result := AnsiStrLIComp(PChar(Text) + i, PChar(S), Length(S)) = 0;
    if Result then Inc(i, Length(S));
  end;

  function CmpL(S: string) : boolean;
  begin
    Result := Cmp(S + '>');
  end;

  function CmpL1(S: string) : boolean;
  begin
    Result := Cmp1(S + '>');
  end;

  procedure Draw(const S: string);
  var y: Integer;
  begin
    if not Assigned(Canvas) then Exit;
    if not CalcWidth then
    begin
      y := Rect.Top;
      if LineHeight > 0 then
      begin
        case TextLayout of
          tlCenter: Inc(y, (LineHeight - Canvas.TextHeight(S)) div 2);
          tlBottom: Inc(y, LineHeight - abs(Canvas.Font.Height) - 2);
        end;
      end;
      Canvas.TextOut(Rect.Left, y, S);
    end;
    Rect.Left :=  Rect.Left + Canvas.TextWidth(S);
  end;

  procedure Style(const Style: TFontStyle; const Include: Boolean);
  begin
    if not Assigned(Canvas) then Exit;
    if Include then Canvas.Font.Style := Canvas.Font.Style + [Style]
     else Canvas.Font.Style := Canvas.Font.Style - [Style];
  end;

var
  OldFont: TFont;
  TextLen: Integer;
begin
  PlainText := '';
  OldFont := nil;
  TextLayout := tlTop;
  if Assigned(Canvas) then
  begin
   // Canvas-Einstellungen sichern
    OldFont := TFont.Create;
    OldFont.Assign(Canvas.Font);
  end;
  try
    if HideSelColor and Assigned(Canvas) then
    begin
      Canvas.Brush.Color := clWindow;
      Canvas.Font.Color := clWindowText;
    end;
    if (Assigned(Canvas)) and (not TransparentBkgnd) then
      Canvas.FillRect(Rect);

    Height := Rect.Top;
    Width := Rect.Left;
    Inc(Rect.Left, 2);
    OrgRect := Rect;
    S := '';
    i := 1;
    TextLen := Length(Text); // schneller als laufend Length() aufzurufen
    while i <= TextLen do
    begin
      if (Text[i] = '<') and
        (CmpL('b') or CmpL('/b') or
         CmpL('i') or CmpL('/i') or
         CmpL('u') or CmpL('/u') or
         Cmp('c:') or
         Cmp('fname:') or Cmp('fsize') or
         Cmp('valign:')
        ) then
      begin
        Draw(S);
        PlainText := PlainText + S;

        if CmpL1('b')       then Style(fsBold, True)
        else if CmpL1('/b') then Style(fsBold, False)
        else if CmpL1('i')  then Style(fsItalic, True)
        else if CmpL1('/i') then Style(fsItalic, False)
        else if CmpL1('s')  then Style(fsStrikeOut, True)
        else if CmpL1('/s') then Style(fsStrikeOut, False)
        else if CmpL1('u')  then Style(fsUnderline, True)
        else if CmpL1('/u') then Style(fsUnderline, False)
        else if Cmp1('c:') then // color
        begin
          A := SubStr(Text, i + 1, '>');
          if (HideSelColor or not (odSelected in State)) and Assigned(Canvas) then
          try
            if (Length(A) > 0) and (A[1] <> '$') then
              Canvas.Font.Color := StringToColor('cl' + A)
            else
              Canvas.Font.Color := StringToColor(A);
          except
          end;
          inc(i, Length(A) + 1); {'>' überpringen}
        end else if Cmp1('fname:') then
        begin
          A := SubStr(Text, i + 1, '>');
          if (A = '') and (Assigned(OldFont)) then A := OldFont.Name;
          Canvas.Font.Name := A;
          inc(i, Length(A) + 1); {'>' überpringen}
        end else if Cmp1('fsize:') then
        begin
          A := SubStr(Text, i + 1, '>');
          if A <> '' then
          try
            if CompareText(Copy(A, Length(A) - 2, 2), 'px') = 0 then
              Canvas.Font.Height := StrToInt(Copy(A, 1, Length(A) - 2))
            else
              Canvas.Font.Size := StrToInt(A);
          except
          end;
          inc(i, Length(A) + 1); {'>' überpringen}
        end else if Cmp1('valign:') then
        begin
          A := SubStr(Text, i + 1, '>');
          if A <> '' then
            case IsInTextArray(A, ['Top', 'Center', 'Bottom']) of
              0: TextLayout := tlTop;
              1: TextLayout := tlCenter;
              2: TextLayout := tlBottom;
            end;
          inc(i, Length(A) + 1); {'>' überpringen}
        end;
        S := '';
      end else
      begin
        // neue Zeile (könne auch mit 
 gemacht werden)
        if (Text[i] = #13) and (Cmp1(#10)) then
        begin
          Draw(S);
          PlainText := PlainText + S;
          if Assigned(Canvas) then
          begin
            Rect.Left := OrgRect.Left;
            Inc(Rect.Top, Canvas.TextHeight(S));
          end;
          S := '';
        end else S := S + Text[i]; // Text Zeichen für Zeichen zusammensetzen
      end;
      inc(i);
    end; // for
    Draw(S); // Rest zeichnen
    PlainText := PlainText + S;
  finally
    if Assigned(Canvas) then
    begin
     // Canvas wiederherstellen
      Canvas.Font.Assign(OldFont);
      OldFont.Free;
    end;
  end;
  Width := Rect.Left - Width + 2;
  Height := Rect.Top - Height + 2;
end;

function DrawHlText(Canvas: TCanvas; Rect: TRect; const State: TOwnerDrawState;
  const Text: string; HideSelColor: Boolean; LineHeight: Integer = 0): string;
var
  S: string;
  w, h: Integer;
begin
  DrawHlTextEx(Canvas, Rect, True, State, Text, HideSelColor, LineHeight, S, w, h, False);
end;

function GetHlPlainText(const Text: string): string;
var w, h: Integer;
begin
  DrawHlTextEx(nil, Rect(0, 0, -1, -1), False, [], Text, False, 0, Result, w, h, False);
end;

function GetHlTextExt(Canvas: TCanvas; Rect: TRect; const State: TOwnerDrawState;
  const Text: string; HideSelColor: Boolean): TSize;
var S: string;
begin
  DrawHlTextEx(Canvas, Rect, False, State, Text, HideSelColor, 0, S, Result.cx, Result.cy, True);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  DrawHlText(PaintBox1.Canvas, PaintBox1.ClientRect, [],
    '<c:blue>H<fsize:10>a<fsize:11>l<fsize:12>l<fsize:13>o<fsize:6px><c:black> [b]du da[/b]', False);
end;

Wenn du den ganzen Textblock zentriert ausgeben willst, dann ermittelst du zuerst mit GetHlTextExt die Ausmaße und kannst dann mit diesen zentrieren:

Code:

size := GetHlTextExt(PaintBox1.Canvas, PaintBox1.ClientRect, [], Text, False);
r := PaintBox1.ClientRect;
r.Left := (PaintBox1.Width - size.cx) div 2;
DrawHlText(PaintBox1.Canvas, r, [], Text, False);

[Daniel]

@jbg: Vielen Dank erstmal; ich werde hoffentlich am Nachmittag Gelegenheit haben, mir das näher anzusehen :P.

So - nun habe ich mir das näher angesehen und konnte einige Dinge für mein Projekt verwerten :-) Dankeschön!

Grüße,
Daniel