Разработайте программу, которая заполняет двумерный массив натуральными числами по спирали. Максимальное число N задается.

Так как по введённому числу N невозможно определить размеры матрицы (например для N = 16, может быть матрица 1x16, 2x8, 4x4, 8x2, 16x1), предполагается, что она квадратная.

{$R-}
program N184730327;
type
  TArray = array [1..1] of word;
  PArray = ^TArray;
  TMatrix = array [1..1] of PArray;
  PMatrix = ^TMatrix;

const
  d: word = 1;
  di: integer = 0;
  dj: integer = 1;
var
  i, j, k, l, m, b: integer;
  a: PMatrix;
  N: word;
  error: boolean;

begin
  repeat
    write('Введите N: ');
    {$I-}
    readln(N);
    error := (IOResult > 0) or (N < 1) or (N > 256) or (sqr(trunc(sqrt(N))) <> N);
    {$I+}
    if error then
      writeln('Ошибка! N дoлжнo быть тoчным квадратом целых чисел от 1 до 16.')
  until not error;
  m := trunc(sqrt(N));

  GetMem(a, sizeof(PArray) * m);
  for i := 1 to m do
    GetMem(a^[i], sizeof(word) * m);

  i := 1;
  j := 1;
  for l := 0 to m shr 1 - 1 do
  begin
    for k := 0 to 3 do
    begin
      while (i < m - l) and (k = 1) or (i > l + 1) and (k = 3)
        or (j < m - l) and (k = 0) or (j > l + 1) and (k = 2) do
      begin
        a^[i]^[j] := d;
        inc(d);
        inc(i, di);
        inc(j, dj)
      end;
      b := di;
      di := dj;
      dj := -b
    end;
    inc(i);
    inc(j)
  end;
  if odd(m) then
    a^[i]^[j] := d; {Не красиво, но по другому не получается}

  for i := 1 to m do
  begin
    for j := 1 to m do
      write(a^[i]^[j]:4);
    writeln
  end;

  write(#10'Для завершения работы нажмите Enter...');
  readln;
  for i := 1 to m do
    FreeMem(a^[i], sizeof(word) * m);
  FreeMem(a, sizeof(PArray) * m)
end.

cyberforum.ru/post129034.html