View Full Version : پيش فرض حرکت دادن یک متن بطور دایره وار
  
amir_varasteh
پنج شنبه 23 دی 1389, 18:30 عصر
سلام.
چطور میشه یک متن رو توی یک فرم به شکل دایره حرکت داد ؟
Pascal
دوشنبه 29 خرداد 1391, 10:43 صبح
سلام.
 
چطور میشه یک متن رو توی یک فرم به شکل دایره حرکت داد ؟
 
این کد را از همین سایت برنامه نویس پیدا کرده بودم ، اما آدرس دقیق تاپیک را فراموش کردم!
 
 
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Label1: TLabel;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  X,Y,Sec :Integer;
implementation
{$R *.dfm}
procedure TForm1.Timer1Timer(Sender: TObject);
begin
    inc(Sec);
    X:= Round(150 * Cos((Pi / 180) * (6 * Sec - 90)) + 200);
    Y:= Round(150 * Sin((Pi / 180) * (6 * Sec  - 90)) + 200);
    label1.Top := Y;
    Label1.Left :=x;
    Inc(X);
    Inc(Y);
    canvas.Pixels[x,y];
end;
end.
SAASTN
دوشنبه 29 خرداد 1391, 14:35 عصر
حسش اومد اینو نوشتم!
procedure DrawRadialText(Text: string; StartAngle: Integer; JamFactor: Double;
  Radius: Integer; Origin: TPoint; Canvas: TCanvas; Size: Integer; Color: TColor);
var
  LF :LogFont;
  NewFont :HFont;
  OldFont: HFont;
  I: Integer;
  Rect: TRect;
  Char: string;
  CharAngleDeg: Integer;
  CharAngleRad: Double;
  BaseAngleRad: Double;
  BaseAngleDeg: Integer;
begin
  GetObject(CAnvas.Font.Handle, SizeOf(LogFont),@LF);
  BaseAngleRad := DegToRad(StartAngle);
  BaseAngleDeg := StartAngle;
  Canvas.Brush.Style := bsClear;
  Canvas.Font.Size := Size;
  Canvas.Font.Color := Color;
  for i := 1 to Length(Text) do
  begin
    Char := Text[I];
    Rect := Classes.Rect(0, 0, 100, 100);
    Canvas.TextRect(Rect, Char, [tfCalcRect]);
    CharAngleRad := 2 * ArcSin((Rect.Right * JamFactor) / Radius);
    CharAngleDeg := Round(RadToDeg(CharAngleRad));
    LF.lfEscapement := (BaseAngleDeg) * 10 - 900;
    LF.lfOrientation := (BaseAngleDeg) * 10 - 900;
    NewFont := CreateFontIndirect(LF);
    OldFont := SelectObject(Canvas.Handle, NewFont);
    Canvas.TextOut(Origin.X + Round(Radius * Cos(BaseAngleRad)) ,
      Origin.Y - Round(Radius * Sin(BaseAngleRad)), Char);
    SelectObject(Canvas.Handle, OldFont);
    DeleteObject(NewFont);
    BaseAngleRad := BaseAngleRad - CharAngleRad;
    BaseAngleDeg := BaseAngleDeg - CharAngleDeg;
  end;
end;
 
vBulletin® v4.2.5, Copyright ©2000-1404, Jelsoft Enterprises Ltd.