Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement