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