SHARE
TWEET

Spiral Out 2

djjd47130 Sep 16th, 2019 92 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.   DOT_COUNT = 120;
  13.   DOT_SPACING = 2.5;
  14.   LINE_WIDTH = 1.0;
  15.   SPEED_FACTOR = 0.01;
  16.  
  17. type
  18.   TSpiralPoint = record
  19.     Degrees: Currency;
  20.     Distance: Currency;
  21.     Speed: Currency;
  22.   end;
  23.  
  24.   TSpiralPoints = array of TSpiralPoint;
  25.  
  26.   TfrmMain = class(TForm)
  27.     tmrStart: TTimer;
  28.     tmrMain: TTimer;
  29.     procedure FormCreate(Sender: TObject);
  30.     procedure FormDestroy(Sender: TObject);
  31.     procedure tmrStartTimer(Sender: TObject);
  32.     procedure tmrMainTimer(Sender: TObject);
  33.     procedure FormPaint(Sender: TObject);
  34.   private
  35.     FPoints: TSpiralPoints;
  36.     FPen: TGPPen;
  37.     function CenterPoint: TGPPointF;
  38.   public
  39.     function CreateCanvas: TGPGraphics;
  40.   end;
  41.  
  42. var
  43.   frmMain: TfrmMain;
  44.  
  45. implementation
  46.  
  47. {$R *.dfm}
  48.  
  49. function NewPosition(Center: TGPPointF; Distance: Currency; Degrees: Currency): TGPPointF;
  50. var
  51.   Radians: Real;
  52. begin
  53.   //Convert angle from degrees to radians; Subtract 135 to bring position to 0 Degrees
  54.   Radians:= (Degrees - 135) * Pi / 180;
  55.   Result.X:= Trunc(Distance*Cos(Radians)-Distance*Sin(Radians))+Center.X;
  56.   Result.Y:= Trunc(Distance*Sin(Radians)+Distance*Cos(Radians))+Center.Y;
  57. end;
  58.  
  59. { TfrmSpiral }
  60.  
  61. procedure TfrmMain.FormCreate(Sender: TObject);
  62. var
  63.   X: Integer;
  64. begin
  65.   WindowState:= wsMaximized; //Maximize window on startup
  66.   Color:= clBlack; //Set form's background to black
  67.   FPen:= TGPPen.Create(MakeColor(180, 180, 255)); //Create pen and set color to light blue
  68.   FPen.SetWidth(LINE_WIDTH); //Set the width of the line (pen)
  69.   SetLength(FPoints, DOT_COUNT); //Populate array of points
  70.   //Set defaults values for each point
  71.   for X := 0 to Length(FPoints)-1 do begin
  72.     FPoints[X].Degrees:= 0; //Start all at 0 degrees to be straight line
  73.     FPoints[X].Distance:= (X+1) * DOT_SPACING; //Spacing between each point / radius from center point
  74.     FPoints[X].Speed:= (X+1) * SPEED_FACTOR; //Make each one slightly slower than the next
  75.   end;
  76. end;
  77.  
  78. procedure TfrmMain.FormDestroy(Sender: TObject);
  79. begin
  80.   SetLength(FPoints, 0); //Clear array of points
  81.   FreeAndNil(FPen); //Destroy pen object
  82. end;
  83.  
  84. procedure TfrmMain.tmrStartTimer(Sender: TObject);
  85. begin
  86.   //One-time timer just to put delay before main animation starts
  87.   tmrStart.Enabled:= False;
  88.   tmrMain.Enabled:= True;
  89. end;
  90.  
  91. procedure TfrmMain.tmrMainTimer(Sender: TObject);
  92. var
  93.   X: Integer;
  94. begin
  95.   //Increase degrees of each point based its "speed"
  96.   for X := 0 to Length(FPoints)-1 do begin
  97.     FPoints[X].Degrees:= FPoints[X].Degrees + FPoints[X].Speed;
  98.   end;
  99.   Self.Invalidate; //Force form to repaint
  100. end;
  101.  
  102. function TfrmMain.CenterPoint: TGPPointF;
  103. begin
  104.   //Returns absolute center point of form's client area
  105.   Result.X:= ClientWidth / 2;
  106.   Result.Y:= ClientHeight / 2;
  107. end;
  108.  
  109. function TfrmMain.CreateCanvas: TGPGraphics;
  110. begin
  111.   //Create GDI+ canvas object
  112.   Result:= TGPGraphics.Create(Canvas.Handle);
  113.   Result.SetInterpolationMode(InterpolationMode.InterpolationModeHighQuality);
  114.   Result.SetSmoothingMode(SmoothingMode.SmoothingModeHighQuality);
  115.   Result.SetCompositingQuality(CompositingQuality.CompositingQualityHighQuality);
  116. end;
  117.  
  118. procedure TfrmMain.FormPaint(Sender: TObject);
  119. var
  120.   X: Integer;
  121.   P: TGPPointF;
  122.   Last: TGPPointF;
  123.   Can: TGPGraphics;
  124. begin
  125.   Can:= CreateCanvas; //Create GDI+ canvas
  126.   try
  127.     //Iterate through all points
  128.     for X := 0 to Length(FPoints)-1 do begin
  129.       //Calculate position around center point
  130.       P:= NewPosition(CenterPoint, FPoints[X].Distance, FPoints[X].Degrees);
  131.       if X > 0 then begin
  132.         //Only draw line if not the first point (need at least 2 points)
  133.         Can.DrawLine(FPen, Last.X, Last.Y, P.X, P.Y);
  134.       end;
  135.       //Keep track of prior point to draw next line
  136.       Last:= P;
  137.     end;
  138.   finally
  139.     Can.Free; //Destroy GDI+ canvas
  140.   end;
  141. end;
  142.  
  143. 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
 
Top