Fraktál

Hozzunk létre véletlen fraktált a számítógép segítségével, mely pontokból áll össze. A generálás alapja az legyen, hogy a fraktál csak lapszomszéd szerint növekedhet. Ha véletlen választunk egy pontot a síkon, akkor azt addig mozgassuk véletlenül tengelyirányokba, ameddig hozzá nem tapad, a már meglévő pontokhoz. Így a fraktál növekedése egy fához hasonlít, csak a burjánzás mind a négy irányba megtörténik. A fraktál növekedésével a generálás lelassul, mert egyre több új pont nem tud a meglévőkhöz tapadni, hamarabb jut el a véletlen választás határához, amikor megsemmisül. (A program a Sejtek programhoz hasonló, viszont a generálás alapvetően más, mint ott, ezáltal a végeredmény is jelentősen különbözik, az ott látottaktól.)

A program futási képe körülbelül két perc után:

A program listája:

unit UFraktal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;

type
TfmFraktal = class(TForm)
btKilepes: TButton;
tiIdozito: TTimer;
procedure tiIdozitoTimer(Sender: TObject);
procedure btKilepesClick(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
fmFraktal: TfmFraktal;
  X, Y, Xk, Yk, Fx, D: Integer;


implementation

{$R *.dfm}

procedure TfmFraktal.tiIdozitoTimer(Sender: TObject);
begin
With Canvas Do
Begin
While (Pixels[X-1,Y]=clBlack) And (Pixels[X+1,Y]=clBlack) And
(Pixels[X,Y-1]=clBlack) And (Pixels[X,Y+1]=clBlack) And
          (X>Xk-D) And (X<Xk+D) And (Y>Yk-D) And (Y<Yk+D) Do
Begin
Pixels[X, Y]:= clBlack;
Case Random(4) Of
        0: Dec(X);
        1: Dec(Y);
        2: Inc(X);
        3: Inc(Y);
End;
Pixels[X, Y]:= clWhite;
If (X=Xk-D) Or (X=Xk+D) Or (Y=Yk-D) Or (Y=Yk+D)
Then Pixels[X, Y]:= clBlack;
End;
If Not((X=Xk-D) Or (X=Xk+D) Or (Y=Yk-D) Or (Y=Yk+D)) Then
If X<Fx Then Fx:= X; D:= 20+2*(Xk-Fx);
    X:= Xk + Random(D) - (D Div 2);
    Y:= Yk + Random(D) - (D Div 2);
End;
end;

procedure TfmFraktal.btKilepesClick(Sender: TObject);
begin
Close;
end;

procedure TfmFraktal.FormPaint(Sender: TObject);
begin
Xk:= ClientWidth Div 2;
Yk:= ClientHeight Div 2;
Fx:= Xk; Randomize; D:= 20;
With Canvas Do
Begin
Pen.Color:= clBlack;
Brush.Color:= clBlack;
Rectangle(0,0,2*Xk,2*Yk);
Pixels[Xk, Yk]:= clWhite;
End;
  X:= Xk + Random(D) - (D Div 2);
  Y:= Yk + Random(D) - (D Div 2);
end;

end.