Листинг подпрограммы. procedure TForm1.FormCreate (Sender: TObject);

procedure TForm1.FormCreate (Sender: TObject);

var i, j: Integer;

Begin

Randomize;

for i:= 1 to size do {инициализация массива пикселов}

for i:= 1 to size do

Points[i, j]:= 1 + Random (csize); {Минимально возможное значение элемента массива равно 1}

end;

procedure TForm1.Timer1Timer (Sender: TObject);

var i, j: Integer;

c, l, r, u, d: Integer;

newPoints: array [1..size, 1..size] of Integer;

Begin

{Вычислить, какого цвета будет клетка на следующем шаге}

for i:= 1 to size do

for j:= 1 to size do

Begin

c:= Points[i, j] + 1;{Вычисляется «следующий цвет» и запоминается в переменной с}

if c > csize then c:= 1; {После последнего цвета идет первый}

{Вычисляются индексы для клеток, примыкающих к данной сверху, снизу, слева и справа. Края узора как бы «склеены» друг с другом}

u:= i – 1;

if u = 0 then u:= size;

d:= i + 1;

if d > size then d:= 1;

l:= j – 1;

if l = 0 then l:= size;

r:= j + 1;

if r > size then r:= 1;

newPoints [i, j]:= Points [i, j]; {Если среди «соседей» цвет отсутствует, то клетка остается без изменений}

{Если хотя бы один из «соседей» имеет такой цвет, клетка перекрашивается}

if (Points [u, j] = c) or (Points [d, j] = c) or (Points [i, l] = c) or (Points [i, r] = c)

then newPoints [i, j]:= c;

end;

c:= 320 div size; {Выбирается размер клетки так, чтобы узор занимал, по возможности, всю область рисования}

{Обновляется узор на экране}

for i:= 1 to size do

for j:= 1 to size do

Begin

Points [i, j]:= newPoints [i, j];

{Настроить цвет контура прямоугольника и цвет закраски}

PaintBox1.Canvas.Pen.Color:= Colors[Points[i, j]];

PaintBox1.Canvas.Brush.Color:= Colors[Points[i, j]];

{Выполнить рисование}

PaintBox1.Canvas.Rectangle (c*(i - 1), c*(j - 1), c*i – 1, c*j – 1);

{Параметры метода Rectangle подобраны так, чтобы между клетками оставался небольшой зазор. Чтобы клетки располагались вплотную друг к другу, заменить (c*(i - 1), c*(j - 1), c*i – 1, c*j – 1) на (c*(i - 1), c*(j - 1), c*i, c*j }

end;

end;