Hints formatieren

[patti]

Hier ist also mal mein Quelltext. Ich weise nochmal darauf hin, dass er vielleicht nicht unbedingt besonders "sauber" geschrieben ist oder sehr schnell funktioniert, zumal jeder Buchstabe auf der Canvas einzeln ausgegeben wird. Als Denkanstoß sollte es aber allemal reichen. Bei Bedarf kannst du ihn ja noch erweitern. Zu erwähnen ist außerdem noch, dass der Font-Name und die Schriftgröße von den Canvas-Eigenschaften übernommen werden. Aber auch das ließe sich natürlich per Formatierungsbefehl noch ändern.

Delphi-Quellcode:

// PROCEDURE FormatText
//
// Gibt auf einer Canvas an einer bestimmten Stelle (APosition) einen string formatiert aus
// Formatierungs-Befehle sind dem Quelltext zu entnehmen und können nach den eigenen Wünschen
// angepasst werden
//
// by Patrick Kreutzer, August 2009
//
procedure FormatText(ACanvas : TCanvas; APosition : TPoint; AInput : string);
var CurComand : string;
var c         : integer;
var x,y       : integer;
var OldFont   : TFont;
var Comand    : boolean;
var ComandEnd : boolean;
// <--
   procedure ChangeFontStyle(AComandEnd : boolean; AFontStyle : TFontStyle);
   begin
        //--
        if AComandEnd then ACanvas.Font.Style := ACanvas.Font.Style - [AFontStyle]
        else ACanvas.Font.Style := ACanvas.Font.Style + [AFontStyle];
   end;
// -->
begin
     //--
     if AInput <> '' then
     begin
          OldFont := ACanvas.Font;
          //
          x := APosition.X;
          y := APosition.Y;
          //
          with ACanvas, ACanvas.Font do
          begin
               Font.Color  := clBlack;
               Style       := [];
               Brush.Style := bsClear;
               //
               CurComand   := '';
               Comand      := false;
               //
               c := 1;
               //
               repeat
                   if not(AInput[c] in ['[',']']) and not(Comand) then
                   begin
                        TextOut(x,y,AInput[c]);
                        //
                        x := x + TextWidth(AInput[c]);
                   end
                   else
                   begin
                        case AInput[c] of
                        '[' : Comand := true;
                        ']' : begin
                                   Comand    := false;
                                   ComandEnd := false;
                                   //
                                   if Length(CurComand) > 0 then
                                   begin
                                        if CurComand[1] = '/' then
                                        begin
                                             ComandEnd := true;
                                             //
                                             CurComand := Copy(CurComand,2,Length(CurComand)-1);
                                        end;
                                        //
                                        CurComand := AnsiUpperCase(CurComand);
                                        //
                                        if CurComand = 'B' then ChangeFontStyle(ComandEnd,fsBold);
                                        if CurComand = 'I' then ChangeFontStyle(ComandEnd,fsItalic);
                                        if CurComand = 'U' then ChangeFontStyle(ComandEnd,fsUnderline);
                                        if CurComand = 'S' then ChangeFontStyle(ComandEnd,fsStrikeOut);
                                        //
                                        if CurComand = 'BREAK' then
                                        begin
                                             y := y + TextHeight('Aq');
                                             x := APosition.X;
                                        end;
                                        //
                                        if CurComand = 'BLACK'  then Font.Color := clBlack;
                                        if CurComand = 'BLUE'   then Font.Color := clBlue;
                                        if CurComand = 'RED'    then Font.Color := clRed;
                                        if CurComand = 'GREEN'  then Font.Color := clGreen;
                                        if CurComand = 'YELLOW' then Font.Color := clYellow;
                                        if CurComand = 'WHITE'  then Font.Color := clWhite;
                                   end;
                                   //
                                   CurComand := '';
                              end;
                        else
                          CurComand := CurComand + AInput[c];
                        end;
                   end;
                   //
                   Inc(c);
               until c > Length(AInput);
          end;
          //
          ACanvas.Font := OldFont;
     end;
end;

Und so könnte beispielweise ein Aufruf ausschauen:

Delphi-Quellcode:

//--
PaintBox1.Repaint;
FormatText(PaintBox1.Canvas,Point(0,10),'Das [b]ist ein [i][u]Test [/u][/i][/b][i][u][/u][/i][u][/u]!!!');

Viel Spaß damit

Patti