Hints formatieren

[Jens01]

Habe hier das Programmteil von patti ergänzt :
FormatTextSize gibt die Größe des Textstrings an.
FormatText ist um einen Tab-Sprung [/P11] und Änderung der Zeichengröße [/FS11] ergänzt. Außerdem werden eckige Klammern ohne / hier ausgegeben.

Delphi-Quellcode:

procedure FormatText(ACanvas : TCanvas; APosition : TPoint; AInput : string);
var
  CurComand: string;
  c, x, y, THmax: integer;
  OldFont: TFont;
  Comand, 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;
      THmax       := TextHeight('Aq'); //setz die Anfangtexthöhe (max)
      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
                  if CurComand[1] = '/' then
                  begin
                    ComandEnd := true;
                    CurComand := Copy(CurComand,2,Length(CurComand)-1);
                    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 //Zeilenumbruch
                    begin
                      THmax := TextHeight('Aq');
                      y := y + THmax;
                      x := APosition.X;
                    end;

                    if copy(CurComand,1,1) = 'P' then // Tab
                    begin
                      CurComand := Copy(CurComand,2,Length(CurComand)-1);
                      x := APosition.X + StrToInt(CurComand);
                    end;

                    if copy(CurComand,1,2) = 'FS' then //FontSize
                    begin
                      CurComand := Copy(CurComand,3,Length(CurComand)-1);
                      Font.Size := StrToInt(CurComand);
                      if THmax < TextHeight('Aq') then THmax := TextHeight('Aq');
                    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
                  else
                  begin
                    CurComand := '[' + CurComand + ']';
                    TextOut(x, y, CurComand);
                    x := x + TextWidth(CurComand);
                  end;

                  CurComand := '';
                end;
          else
            CurComand := CurComand + AInput[c];
          end;
        end;

        Inc(c);
      until c > Length(AInput);
    end;

    ACanvas.Font := OldFont;
  end;
end;

function FormatTextSize(ACanvas : TCanvas; AInput : string): TSize ;
var
  CurComand: string;
  c, x, y, THmax, Xmax, Ymax: integer;
  Comand, ComandEnd: boolean;
begin
  if AInput <> '' then
  with ACanvas, ACanvas.Font do
  begin
    CurComand := '';
    Comand := false;
    c := 1;
    x := 0;
    y := 0;
    THmax := TextHeight('Aq'); //setzt die Anfangtexthöhe (max)
    Xmax := 0;
    Ymax := 0;

    repeat
      if not(AInput[c] in ['[',']']) and not(Comand) then
      begin
        x := x + TextWidth(AInput[c]);
        if x > Xmax then Xmax := x;
      end
      else
      begin
        case AInput[c] of
        '[' : Comand := true;
        ']' : begin
                Comand    := false;
                ComandEnd := false;

                if Length(CurComand) > 0 then
                if CurComand[1] = '/' then
                begin
                  ComandEnd := true;
                  CurComand := Copy(CurComand,2,Length(CurComand)-1);

                  CurComand := AnsiUpperCase(CurComand);
                  if CurComand = 'BREAK' then
                  begin
                    y := y + THmax;
                    THmax := TextHeight('Aq');
                    x := 0;
                  end;

                  if copy(CurComand,1,1) = 'P' then // Tab
                  begin
                    CurComand := Copy(CurComand,2,Length(CurComand)-1);
                    x := x + StrToInt(CurComand);
                    if x > Xmax then Xmax := x;
                  end;

                  if copy(CurComand,1,2) = 'FS' then
                  begin
                    CurComand := Copy(CurComand,3,Length(CurComand)-1);
                    Font.Size := StrToInt(CurComand);
                    if THmax < TextHeight('Aq') then THmax := TextHeight('Aq');
                  end;
                end
                else
                begin
                  CurComand := '[' + CurComand + ']';
                  x := x + TextWidth(CurComand);
                  if x > Xmax then Xmax := x;
                end;

                CurComand := '';
              end;
        else
          CurComand := CurComand + AInput[c];
        end;
      end;

      Inc(c);
    until c > Length(AInput);
  end;

  result.cx := Xmax;
  result.cy := y + THmax;
end;