| Код | Program Rects;
uses crt,graph;
const
MaxX = 100;
MaxY = 80;
Side = 20;
type
TSquare = 1..8;
TSquareArray = array[1..MaxX,1..MaxY] of TSquare;
var
Gd,Gm:integer;
CountX,CountY:integer;
Squares:TSquareArray;
ch:char;
procedure InitArray;
var
i,j:integer;
begin
for i:=1 to CountX do
for j:=1 to CountY do
Squares[i,j]:=random(8)+1;
end;
procedure DrawRectangles;
var
i,j:integer;
begin
for i:=1 to CountX do
for j:=1 to CountY do
begin
SetColor(Black);
SetFillStyle(1,Squares[i,j]);
Bar((i-1)*Side+1,(j-1)*Side+1,i*Side-1,j*Side-1);
end;
end;
procedure DoNextStep;
var
i,j:integer;
TmpSquare:TSquareArray;
Tmp_i1,Tmp_i2,Tmp_j1,Tmp_j2:integer;
k:integer;
ColorMax:byte;
Colors:array [1..8] of byte;
ColorIdx:integer;
procedure ClearColors;
var
Tmp:integer;
begin
for Tmp:=1 to 8 do Colors[Tmp]:=0;
end;
begin
for i:=1 to CountX do
for j:=1 to CountY do
begin
Tmp_i1 := i-1;
Tmp_i2 := i+1;
Tmp_j1 := j-1;
Tmp_j2 := j+1;
if (i=1) then Tmp_i1:=CountX else if (i=CountX) then Tmp_i2:=1;
if (j=1) then Tmp_j1:=CountY else if (j=CountY) then Tmp_j2:=1;
ClearColors;
Inc(Colors[Squares[Tmp_i1,Tmp_j1]]);
Inc(Colors[Squares[i ,Tmp_j1]]);
Inc(Colors[Squares[Tmp_i2,Tmp_j1]]);
Inc(Colors[Squares[Tmp_i1,j ]]);
Inc(Colors[Squares[Tmp_i2,j ]]);
Inc(Colors[Squares[Tmp_i1,Tmp_j2]]);
Inc(Colors[Squares[i ,Tmp_j2]]);
Inc(Colors[Squares[Tmp_i2,Tmp_j2]]);
ColorMax:=Colors[1];
ColorIdx:=1;
for k:=2 to 8 do if Colors[k]>=ColorMax then
begin
ColorMax:=Colors[k];
ColorIdx:=k;
end;
TmpSquare[i,j]:=ColorIdx;
end;
for i:=1 to CountX do
for j:=1 to CountY do
Squares[i,j]:=TmpSquare[i,j];
end;
begin
InitGraph(Gd,Gm,'');
if GraphResult<>grOk then
begin
writeln('Error Graphic initializing...');
Readkey;
exit;
end;
randomize;
CountX:=GetMaxX div Side;
CountY:=GetMaxY div Side;
if CountX>MaxX then CountX:=MaxX;
if CountY>MaxY then CountY:=MaxY;
InitArray;
repeat
DrawRectangles;
DoNextStep;
ch:=Readkey;
until ord(ch)=27;
CloseGraph;
end. |
|
Я уже неделю парюсь, но мои собственные ошибки загнали меня в тупик.