SHARE
TWEET

Spiral Out 3

djjd47130 Sep 16th, 2019 87 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit uMain;
  2.  
  3. (*
  4.   Spiral Out - Simple visualization by Jerry Dodge
  5.  
  6.   This code was inspired by a short video/GIF I've seen a few times showing
  7.   a line which becomes a spiral and slowly takes on other shapes. I thought
  8.   to myself "I can do that!" And I did.
  9.  
  10.   The easiest way to describe how this works is to first use your imagination.
  11.   There's a canvas, and this canvas has a center point. From that point,
  12.   put some imaginary circles around it, each one slightly larger than the next,
  13.   creating a sort of dart board design (but with many circles close together).
  14.   Then, place a single dot (point) on each of those circles, forming a straight
  15.   line. Finally, rotate those dots around their related circle, each point
  16.   moving at a slightly faster speed than the prior one. Then draw lines
  17.   between each of these points.
  18.  
  19.   Future edits (and prior attempts) will support coloration, where the design
  20.   slowly changes colors, and blends colors together. I had already tried this,
  21.   but failed miserably, so I stripped it back out of the code. For now,
  22.   it's just a black background with white lines.
  23.  
  24. *)
  25.  
  26. interface
  27.  
  28. uses
  29.   Winapi.Windows, Winapi.Messages,
  30.   System.SysUtils, System.Variants, System.Classes, System.Types,
  31.   Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls,
  32.   GDIPAPI, GDIPOBJ;
  33.  
  34. const
  35.   //Total number of points - increasing will make total line longer.
  36.   DOT_COUNT = 100;
  37.  
  38.   //Number of pixels between each point in initial radius
  39.   DOT_SPACING = 3.0;
  40.  
  41.   //Thickness of line(s)
  42.   LINE_WIDTH = 1.3;
  43.  
  44.   //How much faster each point moves relative to the one before it
  45.   //Important: Make sure 365 is divisible by whatever number you choose,
  46.   //  or else animation will never end the same as it started!
  47.   SPEED_FACTOR = 0.02;
  48.  
  49. type
  50.   TSpiralPoint = record
  51.     Degrees: Currency; //Degrees of this point around its corresponding circle
  52.     Distance: Currency; //Distance from center point / Radius of the imaginary circle
  53.     Speed: Currency; //How fast to move this point around its circle via "Degrees"
  54.   end;
  55.  
  56.   TSpiralPoints = array of TSpiralPoint;
  57.  
  58.   TfrmMain = class(TForm)
  59.     tmrStart: TTimer;
  60.     tmrMain: TTimer;
  61.     procedure FormCreate(Sender: TObject);
  62.     procedure FormDestroy(Sender: TObject);
  63.     procedure tmrStartTimer(Sender: TObject);
  64.     procedure tmrMainTimer(Sender: TObject);
  65.     procedure FormPaint(Sender: TObject);
  66.   private
  67.     FPoints: TSpiralPoints; //Main array of points to be animaged
  68.     FPen: TGPPen; //GDI+ pen for basic line information
  69.     function CenterPoint: TGPPointF; //Returns absolute center point of form's client area
  70.   public
  71.     function CreateCanvas: TGPGraphics;
  72.   end;
  73.  
  74. var
  75.   frmMain: TfrmMain;
  76.  
  77. implementation
  78.  
  79. {$R *.dfm}
  80.  
  81. //Calculates an absolute pixel point based on a center point, distance (radius), and degrees.
  82. //This is perhaps the most complicated part of the whole thing. Someone wrote this
  83. //  function for me many years ago and I've used it in many projects, and tweak it for each.
  84. function NewPosition(Center: TGPPointF; Distance: Currency; Degrees: Currency): TGPPointF;
  85. var
  86.   Radians: Real;
  87. begin
  88.   //TODO: Change input from "Degrees" to "Radians" to eliminate the need for
  89.   //  a variable, this reducing heap allocation and increasing performance.
  90.  
  91.   //Convert angle from degrees to radians; Subtract 135 to bring position to 0 Degrees
  92.   Radians:= (Degrees - 135) * Pi / 180;
  93.   Result.X:= Trunc(Distance*Cos(Radians)-Distance*Sin(Radians))+Center.X;
  94.   Result.Y:= Trunc(Distance*Sin(Radians)+Distance*Cos(Radians))+Center.Y;
  95. end;
  96.  
  97. { TfrmSpiral }
  98.  
  99. procedure TfrmMain.FormCreate(Sender: TObject);
  100. var
  101.   X: Integer;
  102. begin
  103.   WindowState:= wsMaximized; //Maximize window on startup
  104.   Color:= clBlack; //Set form's background to black
  105.   FPen:= TGPPen.Create(MakeColor(180, 180, 255)); //Create pen and set color to light blue
  106.   FPen.SetWidth(LINE_WIDTH); //Set the width of the line (pen)
  107.   SetLength(FPoints, DOT_COUNT); //Populate array of points
  108.   //Set defaults values for each point
  109.   for X := 0 to Length(FPoints)-1 do begin
  110.     FPoints[X].Degrees:= 0; //Start all at 0 degrees to be straight line
  111.     FPoints[X].Distance:= (X+1) * DOT_SPACING; //Spacing between each point / radius from center point
  112.     FPoints[X].Speed:= (X+1) * SPEED_FACTOR; //Make each one slightly slower than the next
  113.   end;
  114. end;
  115.  
  116. procedure TfrmMain.FormDestroy(Sender: TObject);
  117. begin
  118.   SetLength(FPoints, 0); //Clear array of points
  119.   FreeAndNil(FPen); //Destroy pen object
  120. end;
  121.  
  122. procedure TfrmMain.tmrStartTimer(Sender: TObject);
  123. begin
  124.   //One-time timer just to put delay before main animation starts
  125.   tmrStart.Enabled:= False;
  126.   tmrMain.Enabled:= True;
  127. end;
  128.  
  129. procedure TfrmMain.tmrMainTimer(Sender: TObject);
  130. var
  131.   X: Integer;
  132. begin
  133.   //Increase degrees of each point based its "speed"
  134.   for X := 0 to Length(FPoints)-1 do begin
  135.     FPoints[X].Degrees:= FPoints[X].Degrees + FPoints[X].Speed;
  136.   end;
  137.   Self.Invalidate; //Force form to repaint
  138. end;
  139.  
  140. function TfrmMain.CenterPoint: TGPPointF;
  141. begin
  142.   //Returns absolute center point of form's client area
  143.   Result.X:= ClientWidth / 2;
  144.   Result.Y:= ClientHeight / 2;
  145. end;
  146.  
  147. function TfrmMain.CreateCanvas: TGPGraphics;
  148. begin
  149.   //Create GDI+ canvas object and sets its defaults...
  150.   //NOTE: Unfortunately this has to be created/destroyed for every single
  151.   //  iteration of the canvas' "OnPaint" event or otherwise "WM_PAINT" message.
  152.   Result:= TGPGraphics.Create(Canvas.Handle);
  153.   Result.SetInterpolationMode(InterpolationMode.InterpolationModeHighQuality);
  154.   Result.SetSmoothingMode(SmoothingMode.SmoothingModeHighQuality);
  155.   Result.SetCompositingQuality(CompositingQuality.CompositingQualityHighQuality);
  156. end;
  157.  
  158. procedure TfrmMain.FormPaint(Sender: TObject);
  159. var
  160.   X: Integer;
  161.   P: TGPPointF;
  162.   Last: TGPPointF;
  163.   Can: TGPGraphics;
  164. begin
  165.   Can:= CreateCanvas; //Create GDI+ canvas
  166.   try
  167.     //Iterate through all points
  168.     for X := 0 to Length(FPoints)-1 do begin
  169.       //Calculate position around center point
  170.       P:= NewPosition(CenterPoint, FPoints[X].Distance, FPoints[X].Degrees);
  171.       if X > 0 then begin
  172.         //Only draw line if not the first point (need at least 2 points)
  173.         Can.DrawLine(FPen, Last.X, Last.Y, P.X, P.Y);
  174.       end;
  175.       //Keep track of prior point to draw next line
  176.       Last:= P;
  177.     end;
  178.   finally
  179.     Can.Free; //Destroy GDI+ canvas
  180.   end;
  181. end;
  182.  
  183. 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