Text in Bogenform anzeigen lassen

[toms]

Helmi hat hier einen Code veröffentlicht, wie man einen Text in Bogenform anzeigen lassen kann.

Delphi-Quellcode:

procedure MyTextOut(Ca: TCanvas; X, Y, Angle: Integer; Text: string);
var
  lf: TLogFont;
begin
  with Ca do
  begin
    GetObject(Font.Handle, SizeOf(lf), @lf);
    lf.lfEscapement := Angle * 10;
    Font.Handle := CreateFontIndirect(lf);
    TextOut(X, Y, Text);
    lf.lfEscapement   := 0;
    lf.lfOrientation  := 0;
    Font.Handle := CreateFontIndirect(lf);
  end;
end;

procedure CircleText(Ca: TCanvas; X0, Y0, RX, RY, BeginAngle, EndAngle: Integer;
  Text: WideString);
const
  aq = 180 / 3.1415926;
  qa = 3.1415926 / 180;

  procedure _CircleAlpha(Ca: TCanvas; X0, Y0, RX, RY, Angle: Integer;
    Alpha: WideChar);
  var
    x, y: Integer;
    tw: Double;
  begin
    tw := Ca.TextWidth(Alpha) / 2;
    x := Round(Cos((Angle - 90) * qa) * tw) + X0;
    y := Round(Sin((Angle - 90) * qa) * tw) + Y0;
    x := Round(Cos(Angle * qa) * RX) + x;
    y := Round(Sin(Angle * qa) * RY) + y;
    MyTextOut(Ca, x, y, 270 - Angle, Alpha);
  end;
var
  Angle, Step: Double;
  n: Integer;

begin
  Step := (EndAngle - BeginAngle) / Length(Text);
  Angle := BeginAngle;
  for n := 1 to Length(Text) do
  begin
    _CircleAlpha(Ca, X0, Y0, RX, RY, Round(Angle), Text[n]);
    Angle := Angle + Step;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Canvas.Font.Name := 'Arial';
  Canvas.Font.Color := clBlue;
  Canvas.Font.Size := 17;
  CircleText(Canvas, 200, 200, 150, 150, 150, 390, 'Delphi Praxis');
end;