Text in Bogenform anzeigen lassen

[Helmi]

Hallo,

Danke für den Tip!

Ich hab den mal rauskopiert und etwas formatiert:

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  := '??';
  Canvas.Font.Color := clBlue;
  Canvas.Font.Size  := 14;
  CircleText(Canvas, 200, 200, 150, 150, 150, 390, 'Delphi Praxis');
end;