unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Buttons,
StdCtrls, Spin, Math;
type
TPointSingle = record
X: single;
Y: single;
end;
{ TForm1 }
TForm1 = class(TForm)
cbLinecolor: TColorButton;
cbBackcolor: TColorButton;
cbFillcolor: TColorButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
PaintBox1: TPaintBox;
Panel1: TPanel;
seDepth: TSpinEdit;
seLinewidth: TSpinEdit;
procedure cbFillcolorColorChanged(Sender: TObject);
procedure cbLinecolorColorChanged(Sender: TObject);
procedure cbBackcolorColorChanged(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure seDepthChange(Sender: TObject);
procedure seLinewidthChange(Sender: TObject);
private
Initiator: array of TPointSingle;
ScaleFactor: Single;
GeneratorDTheta: array of Single;
procedure DrawSnowflake(ACanvas: TCanvas; depth: Integer);
procedure DrawSnowflakeEdge(ACanvas: TCanvas; depth: Integer; var p1: TPointSingle;
theta: Single; dist: Single);
procedure FillSnowflake(ACanvas: TCanvas; CenterPoint: TPoint; depth: Integer; p1: TPointSingle;
theta: Single; dist: Single);
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
procedure TForm1.FillSnowflake(ACanvas: TCanvas; CenterPoint: TPoint; depth: Integer; p1: TPointSingle;
theta: Single; dist: Single);
var
i: Integer;
p2: TPointSingle;
Points: array of TPoint;
begin
if depth = 0 then
Exit;
SetLength(Points, 5);
for i := 1 to High(Initiator) do
begin
p1 := Initiator[i - 1];
p2 := Initiator[i];
Points[0] := CenterPoint;
Points[1].X := Round(p1.X);
Points[1].Y := Round(p1.Y);
Points[2].X := Round(p2.X);
Points[2].Y := Round(p2.Y);
Points[3] := CenterPoint;
Points[4] := Points[1];
ACanvas.Polygon(Points);
end;
end;
procedure TForm1.DrawSnowflakeEdge(ACanvas: TCanvas; depth: Integer; var p1: TPointSingle;
theta: Single; dist: Single);
var
i: Integer;
p2: TPointSingle;
ip1, ip2: TPoint;
begin
if depth = 0 then
begin
p2.X := p1.X + (dist * Cos(theta + Pi / 2));
p2.Y := p1.Y + (dist * Sin(theta + Pi / 2));
ip1.X := Trunc(p1.X + 0.5); // Because "banker's rounding" is not what I was taught in University
ip1.Y := Trunc(p1.Y + 0.5);
ip2.X := Trunc(p2.X + 0.5);
ip2.Y := Trunc(p2.Y + 0.5);
ACanvas.Line(ip1, ip2);
p1 := p2;
Exit;
end;
dist := dist / Sqrt(5.0);
for i := 0 to High(GeneratorDTheta) do
begin
theta := theta + GeneratorDTheta[i];
DrawSnowflakeEdge(ACanvas, depth - 1, p1, theta, dist);
end;
end;
procedure TForm1.DrawSnowflake(ACanvas: TCanvas; depth: Integer);
var
i: Integer;
p1, p2: TPointSingle;
dx, dy, length, theta: Single;
begin
ACanvas.Pen.Color := cbLinecolor.ButtonColor;
for i := 1 to High(Initiator) do
begin
p1 := Initiator[i - 1];
p2 := Initiator[i];
dx := p2.X - p1.X;
dy := p2.Y - p1.Y;
length := Sqrt(dx * dx + dy * dy);
theta := ArcTan2(dy, dx);
DrawSnowflakeEdge(ACanvas, depth, p1, theta, length);
end;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
MinDimension: Integer;
begin
SetLength(Initiator, 0);
SetLength(GeneratorDTheta, 0);
// Ensure Initiator array is properly initialized
if Length(Initiator) < 5 then
SetLength(Initiator, 5);
MinDimension := Min(PaintBox1.Width, PaintBox1.Height);
MinDimension := MinDimension - 300;
if Length(Initiator) >= 5 then // Ensure Initiator array has enough elements
begin
Initiator[0].X := (PaintBox1.Width - MinDimension) / 2;
Initiator[0].Y := (PaintBox1.Height - MinDimension) / 2;
Initiator[1].X := (PaintBox1.Width + MinDimension) / 2;
Initiator[1].Y := (PaintBox1.Height - MinDimension) / 2;
Initiator[2].X := (PaintBox1.Width + MinDimension) / 2;
Initiator[2].Y := (PaintBox1.Height + MinDimension) / 2;
Initiator[3].X := (PaintBox1.Width - MinDimension) / 2;
Initiator[3].Y := (PaintBox1.Height + MinDimension) / 2;
Initiator[4] := Initiator[0];
end;
ScaleFactor := 1 / Sqrt(5);
GeneratorDTheta := nil;
SetLength(GeneratorDTheta, 3);
GeneratorDTheta[0] := -ArcTan(1 / 2);
GeneratorDTheta[1] := Pi / 2;
GeneratorDTheta[2] := -Pi / 2;
DrawSnowflake(PaintBox1.Canvas, seDepth.Value);
end;
procedure TForm1.cbLinecolorColorChanged(Sender: TObject);
begin
PaintBox1.Canvas.Pen.Color := cbLinecolor.ButtonColor;
PaintBox1.Invalidate;
end;
procedure TForm1.cbFillcolorColorChanged(Sender: TObject);
begin
PaintBox1.Invalidate;
end;
procedure TForm1.cbBackcolorColorChanged(Sender: TObject);
begin
PaintBox1.Invalidate;
end;
procedure TForm1.seDepthChange(Sender: TObject);
begin
PaintBox1.Invalidate;
end;
procedure TForm1.seLinewidthChange(Sender: TObject);
begin
PaintBox1.Canvas.Pen.Width := seLinewidth.Value;
PaintBox1.Invalidate;
end;
end.