VPF::[Pascal] Пошаговое изменение цвета клеток поля

Матрицаааа

Дата 3.5.2008, 18:56 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 3
Регистрация: 2.5.2008

Репутация: нет
Всего: нет

Суть задачи: в графическом режиме во весь экран создать поле, состоящее из квадратов примерно 20 на 20 пикселей. При первом шаге каждый квадрат этого поля заполняется случайным цветом (всего используются 8 цветов). Далее, для каждого квадрата нужно просчитывать, какой цвет преобладает среди окружающих его 8 квадратов и менять его собственный цвет на преобладающий. И так повторяется с каждым шагом, пока все поле не будет заполнено каким-то одним цветом.

Надеюсь на вашу помощь.

ama_kid

Дата 3.5.2008, 20:26 (ссылка)

(нет голосов)

Загрузка ...

АСУТП-кодер

Профиль
Группа: Комодератор
Сообщений: 1460
Регистрация: 5.3.2007
Где: Москва

Репутация: 16
Всего: 95

Код

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.

Переход к следующему шагу осуществляется по нажатию клавиши. Выход - ESC...

Это сообщение отредактировал(а) ama_kid - 4.5.2008, 07:32

--------------------

самурай без меча подобен самураю с мечом, но только без меча

ama_kid

Дата 4.5.2008, 07:33 (ссылка)

(нет голосов)

Загрузка ...

АСУТП-кодер

Профиль
Группа: Комодератор
Сообщений: 1460
Регистрация: 5.3.2007
Где: Москва

Репутация: 16
Всего: 95

Подредактировал предыдущий пост, нашел небольшую ошибку...

--------------------

самурай без меча подобен самураю с мечом, но только без меча

Матрицаааа

Дата 4.5.2008, 12:12 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 3
Регистрация: 2.5.2008

Репутация: нет
Всего: нет

Огромное спасибо за помощь. smile

Я уже неделю парюсь, но мои собственные ошибки загнали меня в тупик.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Центр помощи \| Следующая тема »