SHARE
TWEET

Spiral Out

djjd47130 Sep 16th, 2019 102 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit uMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages,
  7.   System.SysUtils, System.Variants, System.Classes, System.Types,
  8.   Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls,
  9.   GDIPAPI, GDIPOBJ;
  10.  
  11. const
  12.   BG_COLOR = clBlack;
  13.   LINE_COLOR = clWhite;
  14.  
  15.   DOT_COUNT = 120;
  16.   DOT_SPACING = 2.5;
  17.   LINE_WIDTH = 1.0;
  18.   SPEED_FACTOR = 0.01;
  19.  
  20. type
  21.   TSpiralPoint = record
  22.     Degrees: Currency;
  23.     Distance: Currency;
  24.     Speed: Currency;
  25.   end;
  26.  
  27.   TSpiralPoints = array of TSpiralPoint;
  28.  
  29.   TfrmMain = class(TForm)
  30.     tmrStart: TTimer;
  31.     tmrMain: TTimer;
  32.     procedure FormCreate(Sender: TObject);
  33.     procedure FormDestroy(Sender: TObject);
  34.     procedure tmrStartTimer(Sender: TObject);
  35.     procedure tmrMainTimer(Sender: TObject);
  36.     procedure FormPaint(Sender: TObject);
  37.   private
  38.     FPoints: TSpiralPoints;
  39.     FPen: TGPPen;
  40.     function CenterPoint: TGPPointF;
  41.   public
  42.     function CreateCanvas: TGPGraphics;
  43.   end;
  44.  
  45. var
  46.   frmMain: TfrmMain;
  47.  
  48. implementation
  49.  
  50. {$R *.dfm}
  51.  
  52. uses
  53.   System.Math;
  54.  
  55. function NewPosition(Center: TGPPointF; Distance: Currency; Degrees: Currency): TGPPointF;
  56. var
  57.   Radians: Real;
  58. begin
  59.   //Convert angle from degrees to radians; Subtract 135 to bring position to 0 Degrees
  60.   Radians:= (Degrees - 135) * Pi / 180;
  61.   Result.X:= Trunc(Distance*Cos(Radians)-Distance*Sin(Radians))+Center.X;
  62.   Result.Y:= Trunc(Distance*Sin(Radians)+Distance*Cos(Radians))+Center.Y;
  63. end;
  64.  
  65. { TfrmSpiral }
  66.  
  67. procedure TfrmMain.FormCreate(Sender: TObject);
  68. var
  69.   X: Integer;
  70. begin
  71.   Self.WindowState:= wsMaximized;
  72.   Self.Color:= BG_COLOR;
  73.  
  74.   Randomize;
  75.  
  76.   FPen:= TGPPen.Create(MakeColor(180, 180, 255));
  77.   FPen.SetWidth(LINE_WIDTH);
  78.  
  79.   SetLength(FPoints, DOT_COUNT);
  80.   for X := 0 to Length(FPoints)-1 do begin
  81.     FPoints[X].Degrees:= 0;
  82.     FPoints[X].Distance:= (X+1) * DOT_SPACING;
  83.     FPoints[X].Speed:= (X+1) * SPEED_FACTOR;
  84.   end;
  85. end;
  86.  
  87. procedure TfrmMain.FormDestroy(Sender: TObject);
  88. begin
  89.   SetLength(FPoints, 0);
  90.   FreeAndNil(FPen);
  91. end;
  92.  
  93. procedure TfrmMain.tmrMainTimer(Sender: TObject);
  94. var
  95.   X: Integer;
  96. begin
  97.   for X := 0 to Length(FPoints)-1 do begin
  98.     FPoints[X].Degrees:= FPoints[X].Degrees + FPoints[X].Speed;
  99.   end;
  100.   Self.Invalidate;
  101. end;
  102.  
  103. procedure TfrmMain.tmrStartTimer(Sender: TObject);
  104. begin
  105.   tmrStart.Enabled:= False;
  106.   tmrMain.Enabled:= True;
  107. end;
  108.  
  109. function TfrmMain.CenterPoint: TGPPointF;
  110. begin
  111.   Result.X:= ClientWidth / 2;
  112.   Result.Y:= ClientHeight / 2;
  113. end;
  114.  
  115. function TfrmMain.CreateCanvas: TGPGraphics;
  116. begin
  117.   Result:= TGPGraphics.Create(Canvas.Handle);
  118.   Result.SetInterpolationMode(InterpolationMode.InterpolationModeHighQuality);
  119.   Result.SetSmoothingMode(SmoothingMode.SmoothingModeHighQuality);
  120.   Result.SetCompositingQuality(CompositingQuality.CompositingQualityHighQuality);
  121. end;
  122.  
  123. procedure TfrmMain.FormPaint(Sender: TObject);
  124. var
  125.   X: Integer;
  126.   P: TGPPointF;
  127.   Last: TGPPointF;
  128.   Can: TGPGraphics;
  129. begin
  130.   Can:= CreateCanvas;
  131.   try
  132.     for X := 0 to Length(FPoints)-1 do begin
  133.       P:= NewPosition(CenterPoint, FPoints[X].Distance, FPoints[X].Degrees);
  134.       if X > 0 then begin
  135.         Can.DrawLine(FPen, Last.X, Last.Y, P.X, P.Y);
  136.       end;
  137.       Last:= P;
  138.     end;
  139.   finally
  140.     Can.Free;
  141.   end;
  142. end;
  143.  
  144. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top