Sejtek

 

Írjunk programot, mely egy sejtből kiindulva, egyre nagyobb sejttelepet hoz létre. A születendő sejteket véletlen választással hozzuk létre. A születés akkor adjon valóban új sejtet, ha az adott helyen és a 8 szomszédos helyen, összesen csak egyetlen sejt létezik. Megfigyelhetjük a sejttelep fejlődésében a fa struktúrát, azaz nem abszolút véletlenül épül fel a kolónia (felépítése talán korallhoz hasonlít legjobban).

 

         Egy futtatás végeredménye:

 

 

A program listája:

 

unit USejtek;

interface

uses
  Windows, MessagesSysUtilsVariantsClasses

  GraphicsControlsForms, DialogsStdCtrls;

type
  TfmSejtek = class(TForm)
    btKilepesTButton;
    procedure FormPaint(SenderTObject);
    procedure btKilepesClick(SenderTObject);
  private
    Private declarations }
  public
    Public declarations }
  end;

var
  fmSejtekTfmSejtek;

implementation

{$R *.dfm}

procedure TfmSejtek.btKilepesClick(SenderTObject);
begin
  Close;
end;

procedure TfmSejtek.FormPaint(SenderTObject);
Var X, Y, XkYkXb,XjYf,YlDi: Integer;
    J: LongInt;
    A,B,C,D,E,F,G,H,I: Byte;
begin
  btKilepes.Enabled:= False;
  Xk:= ClientWidth Div 2;
  Yk:= ClientHeight Div 2;
  Di:= 10;
  Randomize;
  With Canvas Do
  Begin
    Pixels[Xk,Yk]:= 0;
    Xb:= Xk-DiXj:= Xk+Di;
    Yf:= Yk-DiYl:= Yk+Di;
    Sleep(500);
    For J:= 1 To 1000000 Do
    Begin
      X:= Random(Xj-Xb+1)+Xb;
      Y:= Random(Yl-Yf+1)+Yf;
      A:= 0; B:= 0; C:= 0; D:= 0; E:= 0;
      F:= 0; G:= 0; H:= 0; I:= 0;
      If (Pixels[X-1,Y-1]=0) Then A:= 1;
      If (Pixels[X  ,Y-1]=0) Then B:= 1;
      If (Pixels[X+1,Y-1]=0) Then C:= 1;
      If (Pixels[X-1,Y  ]=0) Then D:= 1;
      If (Pixels[X  ,Y  ]=0) Then E:= 1;
      If (Pixels[X+1,Y  ]=0) Then F:= 1;
      If (Pixels[X-1,Y+1]=0) Then G:= 1;
      If (Pixels[X,  Y+1]=0) Then H:= 1;
      If (Pixels[X+1,Y+1]=0) Then I:= 1;
      If A+B+C+D+E+F+G+H+I=1 Then
      Begin
        Pixels[X,Y]:= 0;
        If X-Di<Xb Then Xb:= X-Di;
        If X+Di>Xj Then Xj:= X+Di;
        If Y-Di<Yf Then Yf:= Y-Di;
        If Y+Di>Yl Then Yl:= Y+Di;
      End;
    End;
  End;
  btKilepes.Enabled:= True;
end;

end.