Delphi XE5 FireMonkey移动开发示例：Koch分形

  这个例子是参照Processing中的例子写的。代码简洁明了，直接上代码：

unit Example.KochFractal;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants, Generics.Collections,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics;

type

// The Nature of Code
// Daniel Shiffman
// http://natureofcode.com

// Koch Curve
// A class to describe one line segment in the fractal
// Includes methods to calculate midPVectors along the line according to the Koch algorithm
  TKochLine = class
  private
    A, B: TPointF;
  public
    constructor Create(StartPoint, EndPoint: TPointF);
    procedure Display(Canvas: TCanvas);
    function KochLeft(): TPointF;
    function KochMiddle(): TPointF;
    function kochRight(): TPointF;

    property StartPoint: TPointF read A;
    property EndPoint: TPointF read B;
  end;

  TKochFractal = class
  private
    FStart: TPointF;  // Start point
    FEnd: TPointF;  // End point
    FLines: TObjectList;
    FCount: Integer;
  public
    constructor Create();
    destructor Destroy(); override;
    procedure NextLevel();
    procedure Restart(StartPoint, EndPoint: TPointF);
    function GetCount(): Integer;
    procedure Render(Canvas: TCanvas);
    function Iterate(Before: TObjectList): TObjectList;
  end;

implementation

{ TKochLine }

constructor TKochLine.Create(StartPoint, EndPoint: TPointF);
begin
  A := StartPoint;
  B := EndPoint;
end;

procedure TKochLine.Display(Canvas: TCanvas);
begin
  Canvas.DrawLine(A, B, 1);
end;

// This is easy, just 1/3 of the way

function TKochLine.KochLeft: TPointF;
begin
  Result := B - A;
  Result := Result / 3;
  Result := Result + A;
end;

// More complicated, have to use a little trig to figure out where the point is

function TKochLine.KochMiddle: TPointF;
var
  P: TPointF;
begin
  Result := B - A;
  Result := Result / 3;

  P := A + Result;

  Result := Result.Rotate(-PI / 3);
  Result := P + Result;
end;

// Easy, just 2/3 of the way

function TKochLine.kochRight: TPointF;
begin
  Result := A - B;
  Result := Result / 3;
  Result := Result + B;
end;

{ TKochFractal }

constructor TKochFractal.Create();
begin
  FLines := TObjectList.Create(True);
end;

destructor TKochFractal.Destroy;
begin
  FLines.Free;
  inherited;
end;

function TKochFractal.GetCount: Integer;
begin
  Result := FCount;
end;

// This is where the **MAGIC** happens
// Step 1: Create an empty Object list
// Step 2：For every line currently in the object list
//   - calculate 4 line segments based on Koch algorithm
//   - add all 4 line segments into the new object list
// Step 3: Return the new object list and it becomes the list of line segments for the structure

// As we do this over and over again, each line gets broken into 4 lines, which gets broken into 4 lines, so on...

function TKochFractal.Iterate(Before: TObjectList): TObjectList;
var
  KochLine: TKochLine;
  A, B, C, D, E: TPointF;
begin
  Result := TObjectList.Create(True);
  for KochLine in Before do
  begin
    // Calculate 5 koch points (done for us by the line object)
    A := KochLine.StartPoint;
    B := KochLine.KochLeft;
    C := KochLine.KochMiddle;
    D := KochLine.kochRight;
    E := KochLine.EndPoint;
    // Make line segments between all the Poinsts and add them
    Result.Add(TKochLine.Create(A, B));
    Result.Add(TKochLine.Create(B, C));
    Result.Add(TKochLine.Create(C, D));
    Result.Add(TKochLine.Create(D, E));
  end;
end;

procedure TKochFractal.NextLevel;
var
  Before: TObjectList;
begin
  // For every line that is in the object list
  // create 4 more lines in a new object list
  Before := FLines;
  FLines := Iterate(Before);
  Before.Free;
  Inc(FCount);
end;

// This is easy, just draw all the lines

procedure TKochFractal.Render(Canvas: TCanvas);
var
  KochLine: TKochLine;
begin
  for KochLine in FLines do
    KochLine.Display(Canvas);
end;

procedure TKochFractal.Restart(StartPoint, EndPoint: TPointF);
begin
  FCount := 0;  // Reset count
  FLines.Clear;  // Empty the object list;
  FLines.Add(TKochLine.Create(StartPoint, EndPoint));  // Add the initial line (from one PointF to the other)
end;

end.

unit Example.KochMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, Example.KochFractal;

type
  TKochForm = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
  private
    { Private declarations }
    FFractal: TKochFractal;
    procedure Restart();
  public
    { Public declarations }
    procedure Setup();
    procedure Loop();
  end;

var
  KochForm: TKochForm;

implementation

{$R *.fmx}

{ TKochForm }

procedure TKochForm.FormCreate(Sender: TObject);
begin
  Setup();
end;

procedure TKochForm.FormPaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
begin
  Loop();
end;

procedure TKochForm.FormResize(Sender: TObject);
begin
  Restart();
end;

procedure TKochForm.Loop;
begin
  Canvas.BeginScene();
  Canvas.Stroke.Color := $FFFFFFFF;
  Canvas.Clear($FF000000);
  FFractal.Render(Canvas);
  Canvas.FillText(RectF(0, 0, ClientWidth, ClientHeight), '2013 曹伟民',
    False, 1, [], TTextAlign.taCenter, TTextAlign.taTrailing);
  Canvas.EndScene;

  FFractal.NextLevel;
  if FFractal.GetCount > 5 then
    Restart();
end;

procedure TKochForm.Restart;
begin
  FFractal.Restart(PointF(0, ClientHeight - 20), PointF(ClientWidth, ClientHeight - 20));
end;

procedure TKochForm.Setup;
begin
  FFractal := TKochFractal.Create();
  Restart();
end;

procedure TKochForm.Timer1Timer(Sender: TObject);
begin
  Invalidate();
end;

end.

   效果图：