Заполнение массива спиралью

[Fellics{новичок}]

Всем доброго времени суток. Задача: Требуется заполнить массив размера N × N единичками по спирали (начиная с верхнего левого угла по часовой стрелке, см. пример).
Пример: N=7
1111111
0000001
1111101
1000101
1011101
1000001
1111111

Код я написал, только он работает достаточно не правильно, поэтому и прошу помощи, Вы последняя надежда в нахождении ошибок в моем коде.
Собственно код:

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var n,x,y,i,j,z,p:Integer;
a:array [1..1000,1..1000]of Integer;

begin
  { TODO -oUser -cConsole Main : Insert code here }
  Read(n);
  p:=n;
  x:=1;
  y:=1;


  for i:=y to n do
  a[y,i]:=1;
  for i:=x to n do
  a[i,n]:=1;
  for i:=x to n do
  a[n,i]:=1;
  x:=x+2;
  for i:=x to n do
  a[i,y]:=1;
    y:=y+1;
  n:=n-2;
  Writeln(x);
  if n>4 then
//******************************//
  while n>0 do
  begin
    for i:=y to n do
  a[x,i]:=1;
  for i:=x to n do
  a[i,n]:=1;
  for i:=x to n do
  a[n,i]:=1;
  x:=x+2;
  for i:=x to n do
  a[i,y+1]:=1;
  a[i,y]:=1;
    y:=y+2;
  n:=n-2;
  end;






  for i:=1 to p do
  begin
  for j:=1 to p do
  Write(a[i,j],' ');
  writeln;

  end;

  read(n);

end.

[Stilet]

Я бы пробовал что-то в таком роде:

var a:array[1..10,1..10] of byte;
 x,y,n:integer;

 begin
 y:=1; x:=1;n:=10;
 repeat
  while x<=n do begin a[x,y]:=1;inc(x);end;dec(n);dec(x);
  while y<=n do begin a[x,y]:=1;inc(y);end;dec(n);dec(y);
  while x>=(10-n) do begin a[x,y]:=1;dec(x);end;dec(n);inc(x);
  while y>=(10-n) do begin a[x,y]:=1;dec(y);end;dec(n);inc(y);
 until n<=0;
  { TODO -oUser -cConsole Main : Insert code here }
  for y:=1 to 10 do begin
   for x:=1 to 10 do begin
    write(a[x,y]:5);
   end;   writeln;
  end;   writeln;
  readln;
end.