(CodeLib-Manager)
Registriert seit: 10. Jun 2002
4.648 Beiträge
Delphi XE Professional
|
Text in Bogenform anzeigen lassen
9. Jun 2009, 05:50
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;
Thomas
|
|
Zitat
|