Listing 12

//mit DrawTextTo können Texte formatiert ausgegeben werden
//dabei werden HTML-ähnliche Tags genutzt
...

const
  DTT_WORDWRAP = 1;

...

procedure DrawTextTo(drwCanvas: TCanvas; drwRect: TRect; drwText: string; drwFlags: Integer);
var cv, x, y, op, np, ep: Integer;
    s: string;
    sl: TStringList;
    reg: HRGN;

    fc: TColor;
    fs: TFontStyles;
    fh: Integer;

begin
sl:=TStringList.Create;
sl.sorted:=False;

FindToken(drwText, ' ', sl);

//Werte merken und ...
fc:=drwCanvas.Font.Color;
fs:=drwCanvas.Font.Style;
fh:=drwCanvas.Font.Size;

//Region kreieren und in den drwCanvas selektieren
reg:=CreateRectRgn(drwRect.left, drwRect.top, drwRect.right, drwRect.bottom);
SelectClipRgn(drwCanvas.handle, reg);

drwCanvas.FillRect(drwRect);

x:=drwRect.left; y:=drwRect.top;
for cv:=0 to sl.Count-1 do
begin
   op:=0; np:=0; ep:=0;
   while (InStr(np+1, sl[cv], '<')>0) do
   begin
      //< im Text mit "<<" nutzen (&lt; in HTML), dies hier prüfen, bearbeiten und übergehen
      //für > gilt das nicht, dies kann (solange kein einleitendes < vorhanden)
      //beliebeig oft genutzt werden
      if InStr(np+1, sl[cv], '<')=InStr(np+1, sl[cv], '<<') then
      begin
         np:=InStr(np+1, sl[cv], '<');
         sl[cv]:=CutStr(sl[cv], '<', np); //siehe stringm.htm
         Continue;
      end;

      np:=InStr(np+1, sl[cv], '<');
      ep:=InStr(np+1, sl[cv], '>'); if ep=0 then Continue;

      //Text von op bis np ausgeben
      s:=Copy(sl[cv], op+1, (np-1)-op);
      if (x>drwRect.left) and (x+drwCanvas.TextWidth(s)>drwRect.right) and (drwFlags=DTT_WORDWRAP) then
      begin
         x:=drwRect.left;
         y:=y+drwCanvas.TextHeight('Wg');
      end;
      drwCanvas.TextOut(x, y, s); x:=x+drwCanvas.TextWidth(s);

      //neue Textattribute setzen
      s:=Copy(sl[cv], np+1, (ep-1)-np); s:=AnsiUpperCase(Trim(s));
      if s<>'' then
      begin
         if (s='B') and not (fsBold in drwCanvas.Font.Style) then drwCanvas.Font.Style:=drwCanvas.Font.Style+[fsBold];
         if (s='/B') and (fsBold in drwCanvas.Font.Style) then drwCanvas.Font.Style:=drwCanvas.Font.Style-[fsBold];
         if (s='I') and not (fsItalic in drwCanvas.Font.Style) then drwCanvas.Font.Style:=drwCanvas.Font.Style+[fsItalic];
         if (s='/I') and (fsItalic in drwCanvas.Font.Style) then drwCanvas.Font.Style:=drwCanvas.Font.Style-[fsItalic];
         if (s='U') and not (fsUnderline in drwCanvas.Font.Style) then drwCanvas.Font.Style:=drwCanvas.Font.Style+[fsUnderline];
         if (s='/U') and (fsUnderline in drwCanvas.Font.Style) then drwCanvas.Font.Style:=drwCanvas.Font.Style-[fsUnderline];
         if s[1]='C' then begin fc:=drwCanvas.Font.Color; drwCanvas.Font.Color:=StrToInt(Copy(s, 2, Length(s)-1)); end;
         if s='/C' then drwCanvas.Font.Color:=fc;
         if s='BR' then
         begin
            x:=drwRect.left;
            y:=y+drwCanvas.TextHeight('Wg');
         end;
         if s[1]='H' then
         begin
            x:=drwRect.left;
            y:=y+drwCanvas.TextHeight('Wg');
            fh:=drwCanvas.Font.Size; drwCanvas.Font.Size:=StrToInt(Copy(s, 2, Length(s)-1));
         end;
         if s='/H' then
         begin
            x:=drwRect.left;
            y:=y+drwCanvas.TextHeight('Wg');
            drwCanvas.Font.Size:=fh;
         end;
         //Tip:
         //mit Jump-Tags <Jindex.htm> bzw. </J> kann hier weiterentwickelt werden
         //d. h. z.B. beim Ausgeben kann die Fkt. eine TRectList (siehe TIntList)
         //aufbauen und zurückgeben
      end;

      op:=ep;
   end;

   if op<Length(sl[cv]) then
   begin
      //Text von op bis Length ausgeben
      s:=Copy(sl[cv], op+1, Length(sl[cv])-op);
      if (x>drwRect.left) and (x+drwCanvas.TextWidth(s)>drwRect.right) and (drwFlags=DTT_WORDWRAP) then
      begin
         x:=drwRect.left;
         y:=y+drwCanvas.TextHeight('Wg');
      end;
      drwCanvas.TextOut(x, y, s); x:=x+drwCanvas.TextWidth(s);
   end;

   x:=x+drwCanvas.TextWidth(' ');
end;

//altes ClipRect wieder herstellen, Region freigeben
SelectClipRgn(drwCanvas.handle, 0);
DeleteObject(reg);

//... am Ende wieder herstellen
drwCanvas.Font.Color:=fc;
drwCanvas.Font.Style:=fs;
drwCanvas.Font.Size:=fh;

sl.Free;
end;

...

//Beispielaufruf:

DrawTextTo(Canvas, ClientRect, '<H12>Funktion DrawTextTo</H>Bitte beachten: Zwischen << und > dürfen keine Leerzeichen stehen!', 0);

Zurück zur Hauptseite