Spiral Out 3

unit uMain;

(*
  Spiral Out - Simple visualization by Jerry Dodge

  This code was inspired by a short video/GIF I've seen a few times showing
  a line which becomes a spiral and slowly takes on other shapes. I thought
  to myself "I can do that!" And I did.

  The easiest way to describe how this works is to first use your imagination.
  There's a canvas, and this canvas has a center point. From that point,
  put some imaginary circles around it, each one slightly larger than the next,
  creating a sort of dart board design (but with many circles close together).
  Then, place a single dot (point) on each of those circles, forming a straight
  line. Finally, rotate those dots around their related circle, each point
  moving at a slightly faster speed than the prior one. Then draw lines
  between each of these points.

  Future edits (and prior attempts) will support coloration, where the design
  slowly changes colors, and blends colors together. I had already tried this,
  but failed miserably, so I stripped it back out of the code. For now,
  it's just a black background with white lines.

*)

interface

uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants, System.Classes, System.Types,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls,
  GDIPAPI, GDIPOBJ;

const
  //Total number of points - increasing will make total line longer.
  DOT_COUNT = 100;

  //Number of pixels between each point in initial radius
  DOT_SPACING = 3.0;

  //Thickness of line(s)
  LINE_WIDTH = 1.3;

  //How much faster each point moves relative to the one before it
  //Important: Make sure 365 is divisible by whatever number you choose,
  //  or else animation will never end the same as it started!
  SPEED_FACTOR = 0.02;

type
  TSpiralPoint = record
    Degrees: Currency; //Degrees of this point around its corresponding circle
    Distance: Currency; //Distance from center point / Radius of the imaginary circle
    Speed: Currency; //How fast to move this point around its circle via "Degrees"
  end;

  TSpiralPoints = array of TSpiralPoint;

  TfrmMain = class(TForm)
    tmrStart: TTimer;
    tmrMain: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tmrStartTimer(Sender: TObject);
    procedure tmrMainTimer(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    FPoints: TSpiralPoints; //Main array of points to be animaged
    FPen: TGPPen; //GDI+ pen for basic line information
    function CenterPoint: TGPPointF; //Returns absolute center point of form's client area
  public
    function CreateCanvas: TGPGraphics;
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

//Calculates an absolute pixel point based on a center point, distance (radius), and degrees.
//This is perhaps the most complicated part of the whole thing. Someone wrote this
//  function for me many years ago and I've used it in many projects, and tweak it for each.
function NewPosition(Center: TGPPointF; Distance: Currency; Degrees: Currency): TGPPointF;
var
  Radians: Real;
begin
  //TODO: Change input from "Degrees" to "Radians" to eliminate the need for
  //  a variable, this reducing heap allocation and increasing performance.

  //Convert angle from degrees to radians; Subtract 135 to bring position to 0 Degrees
  Radians:= (Degrees - 135) * Pi / 180;
  Result.X:= Trunc(Distance*Cos(Radians)-Distance*Sin(Radians))+Center.X;
  Result.Y:= Trunc(Distance*Sin(Radians)+Distance*Cos(Radians))+Center.Y;
end;

{ TfrmSpiral }

procedure TfrmMain.FormCreate(Sender: TObject);
var
  X: Integer;
begin
  WindowState:= wsMaximized; //Maximize window on startup
  Color:= clBlack; //Set form's background to black
  FPen:= TGPPen.Create(MakeColor(180, 180, 255)); //Create pen and set color to light blue
  FPen.SetWidth(LINE_WIDTH); //Set the width of the line (pen)
  SetLength(FPoints, DOT_COUNT); //Populate array of points
  //Set defaults values for each point
  for X := 0 to Length(FPoints)-1 do begin
    FPoints[X].Degrees:= 0; //Start all at 0 degrees to be straight line
    FPoints[X].Distance:= (X+1) * DOT_SPACING; //Spacing between each point / radius from center point
    FPoints[X].Speed:= (X+1) * SPEED_FACTOR; //Make each one slightly slower than the next
  end;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  SetLength(FPoints, 0); //Clear array of points
  FreeAndNil(FPen); //Destroy pen object
end;

procedure TfrmMain.tmrStartTimer(Sender: TObject);
begin
  //One-time timer just to put delay before main animation starts
  tmrStart.Enabled:= False;
  tmrMain.Enabled:= True;
end;

procedure TfrmMain.tmrMainTimer(Sender: TObject);
var
  X: Integer;
begin
  //Increase degrees of each point based its "speed"
  for X := 0 to Length(FPoints)-1 do begin
    FPoints[X].Degrees:= FPoints[X].Degrees + FPoints[X].Speed;
  end;
  Self.Invalidate; //Force form to repaint
end;

function TfrmMain.CenterPoint: TGPPointF;
begin
  //Returns absolute center point of form's client area
  Result.X:= ClientWidth / 2;
  Result.Y:= ClientHeight / 2;
end;

function TfrmMain.CreateCanvas: TGPGraphics;
begin
  //Create GDI+ canvas object and sets its defaults...
  //NOTE: Unfortunately this has to be created/destroyed for every single
  //  iteration of the canvas' "OnPaint" event or otherwise "WM_PAINT" message.
  Result:= TGPGraphics.Create(Canvas.Handle);
  Result.SetInterpolationMode(InterpolationMode.InterpolationModeHighQuality);
  Result.SetSmoothingMode(SmoothingMode.SmoothingModeHighQuality);
  Result.SetCompositingQuality(CompositingQuality.CompositingQualityHighQuality);
end;

procedure TfrmMain.FormPaint(Sender: TObject);
var
  X: Integer;
  P: TGPPointF;
  Last: TGPPointF;
  Can: TGPGraphics;
begin
  Can:= CreateCanvas; //Create GDI+ canvas
  try
    //Iterate through all points
    for X := 0 to Length(FPoints)-1 do begin
      //Calculate position around center point
      P:= NewPosition(CenterPoint, FPoints[X].Distance, FPoints[X].Degrees);
      if X > 0 then begin
        //Only draw line if not the first point (need at least 2 points)
        Can.DrawLine(FPen, Last.X, Last.Y, P.X, P.Y);
      end;
      //Keep track of prior point to draw next line
      Last:= P;
    end;
  finally
    Can.Free; //Destroy GDI+ canvas
  end;
end;

end.