1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
PaintBox1: TPaintBox;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Const size = 40;
csize = 12;
Colors: array [1..16] of TColor =
(clRed, clGreen, clYellow, clBlue, clWhite, clGray, clFuchsia, clTeal,
clNavy, clMaroon, clLime, clOlive, clPurple, clSilver, clAqua, clBlack);
var
Form1: TForm1;
Points: array[1..size, 1..size] of Integer;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var i, j : Integer;
begin
Randomize;
for i := 1 to size do begin end; {инициализация массива пикселов}
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 new Points [i, j] := c;
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;
end;
end. |
(
Сообщение от Crockett
