Blob Blame Raw
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs;

type

  { TForm1 }

  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure Line(x1, y1, x2, y2: single);
begin
  Form1.Canvas.MoveTo(round(x1), round(y1));
  Form1.Canvas.LineTo(round(x2), round(y2));
end;

procedure Figure(x1, y1, x2, y2: single; level: integer);
var
  ax, ay, bx, by, cx, cy: single;
begin
  if level < 10 then begin
    ax := (x2 - x1)/3 + x1;
    ay := (y2 - y1)/3 + y1;

    cx := (x1 - x2)/3 + x2;
    cy := (y1 - y2)/3 + y2;

    bx := (ax + cx)/2 + (cy - ay)*sin(60/180*pi);
    by := (ay + cy)/2 - (cx - ax)*sin(60/180*pi);

    Figure(x1, y1, ax, ay, level+1);
    Figure(ax, ay, bx, by, level+1);
    Figure(bx, by, cx, cy, level+1);
    Figure(cx, cy, x2, y2, level+1);
  end else begin
    Line(x1, y1, x2, y2);
  end;
end;

{ TForm1 }

procedure TForm1.FormPaint(Sender: TObject);
begin
  Figure(100, 400, 500, 400, 0);
end;

end.