Листинг подпрограммы

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 }