Помогите решить задачу про двумерные массивы Опции

[Voivod]

Помогите решить задачу
Матрицу А(m,n) заполнить следующим образом. Для заданных k и l элементу аkl присвоить значение 1 ; элементам , окаймляющим его (соседним с ним по вертикали, горизонтали и диагоналям) – значение 2; элементам следующего окаймление – значение 3 и так далее до заполнения всей матрицы. Результат вывести на экран ,раскрасив слой разными цветами. Примечание : алгоритм не изменится ,если координаты элемента (несуществующего ) k и l находятся за пределами матрицы.

Сообщение отредактировано: Voivod - 17.11.2006 16:57

[klem4]

Вот на вскидку ...

uses crt;

const

  n = 5;

type
  TMx = array [1..n, 1..n] of Integer;

function IsOk(const a, b: Integer): Boolean;
begin
  isOk := (a >= 1) AND (a <= n) AND (b >= 1) AND (b <= n);
end;

function CreateMatrix(const k, l: Integer): TMx;
var
  delta, i, count: LongInt;
  mx: TMx;
begin

  for i := 1 to n do
   FillChar(mx[i], sizeof(mx[i]), 0);

  count := 0;
  delta := 0;

  while (count < n * n) do begin

    for i := l - delta to l + delta do begin

      if IsOk(k - delta, i) then begin
        if mx[k - delta, i] = 0 then inc(count);
        mx[k - delta, i] := delta + 1;
      end;

      if IsOk(k + delta, i) then begin
        if mx[k + delta, i] = 0 then inc(count);
        mx[k + delta, i] := delta + 1;
      end;

    end;

    for i := k - delta to k + delta do begin

      if IsOk(i, l - delta) then begin
        if mx[i, l - delta] = 0 then inc(count);
        mx[i, l - delta] := delta + 1;
      end;

      if IsOk(i, l + delta) then begin
        if mx[i, l + delta] = 0 then inc(count);
        mx[i, l + delta] := delta + 1;
      end;

    end;

    inc(delta);
  end;

  CreateMatrix := mx;
end;

procedure PrintMatrix(const mx: TMx);
var
  i, j: Integer;
begin
  for i := 1 to n do begin
    writeln;
    for j := 1 to n do begin
      TextColor(mx[i, j] + 1);
      write(mx[i, j]:3);
    end;
  end;
end;

begin
  clrscr;
  PrintMatrix(CreateMatrix(2, 2));
  readln;
end.