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;