Форум программистов [Powered by Invision Power Board]

Код

program matrixwave;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  MATRIX_DIM = 11;{размерность матрицы}
  UNUSED_VALUE = 255;{специальное значение}
type
  TMatrix = array[ 1..MATRIX_DIM, 1..MATRIX_DIM ] of integer;{тип матрицы}

procedure InitMatrix( var matrix : TMatrix );
{процедура инициализации матрицы}
var
  i, j : integer;{счетчики}
begin
  {заполняем матрицу специальным значением}
  for i := 1 to MATRIX_DIM do
    for j := 1 to MATRIX_DIM do
      matrix[ i, j ] := UNUSED_VALUE;
  {на главную и побочную диагональ ставим 1}
  for i := 1 to MATRIX_DIM do
  begin
    matrix[ i, i ] := 1;
    matrix[ i, MATRIX_DIM - i + 1 ] := 1;
  end;
end;

function SetElem( var matrix : TMatrix; x, y, value : integer ) : boolean;
{функция устанавливает элемент матрицы с имндексами x, y в значение value, если это возможно и оповещает об успешности действия}
begin
  if ( x >= 1 ) and ( y >= 1 ) and ( x <= MATRIX_DIM ) and ( y <= MATRIX_DIM ) and ( matrix[ x, y ] > value ) then
  begin
    matrix[ x, y ] := value;
    SetElem := true;
  end
  else
    SetElem := false;
end;

procedure Wave( var matrix : TMatrix; value : integer );
{процедура ищет в матрице элементы со значением value, и пытается}
var
  nextStep : boolean;{нужно ли искать следующее значение}
  i, j : integer;{счетчики}
begin
  nextStep := false;{не нужно искать}
  for i := 1 to MATRIX_DIM do
    for j := 1 to MATRIX_DIM do
      if( matrix[ i, j ] = value ) then{если нашли значение value}
      begin
        {вокруг данного элемента пытаемся поставить значение на 1 больше}
        nextStep := SetElem( matrix, i - 1, j - 1, value + 1 ) or nextStep;
        nextStep := SetElem( matrix, i - 1, j, value + 1 ) or nextStep;
        nextStep := SetElem( matrix, i - 1, j + 1, value + 1 ) or nextStep;
        nextStep := SetElem( matrix, i, j - 1, value + 1 ) or nextStep;
        nextStep := SetElem( matrix, i, j + 1, value + 1 ) or nextStep;
        nextStep := SetElem( matrix, i + 1, j - 1, value + 1 ) or nextStep;
        nextStep := SetElem( matrix, i + 1, j, value + 1 ) or nextStep;
        nextStep := SetElem( matrix, i + 1, j + 1, value + 1 ) or nextStep;
      end;
  if nextStep then{если поставили хотя бы 1 элемент со значением value + 1, то ищем такие значение}
    Wave( matrix, value + 1 );
end;

procedure PrintMatrix( var matrix : TMatrix );
{процедура печати матрицы, если встречается ячейка = UNUSED_VALUE, то печатаем пробел}
var
  i, j : integer;{счетчики}
begin
  for i := 1 to MATRIX_DIM do
  begin
    for j := 1 to MATRIX_DIM - 1 do
      if matrix [ i, j ] = UNUSED_VALUE then
        write( '  ' )
      else
        write( matrix[ i, j ], ' ');

    if matrix [ i, MATRIX_DIM ] = UNUSED_VALUE then
      writeln( '  ' )
    else
      writeln( matrix[ i, MATRIX_DIM ], ' ');
  end;
end;

var
  matrix : TMatrix;{матрица}

begin
  InitMatrix( matrix );{инициализация}
  writeln( 'After init:' );
  PrintMatrix( matrix );{печать после инициализации}
  Wave( matrix, 1 );{заполняем матрицу по условию задачи}
  writeln( 'After wave:' );
  PrintMatrix( matrix );{печать после заполнения}
  readln;{ожидаем ввода}
end.