Массивы. Заполнить зигзагом и по спирали

type
    TM = Array[1..100, 1..100] Of Byte;
    TMass = record
        mass : TM;
        n, m : Byte;
    end;
 
var
    arr : TMass;
 
procedure PrintMass(const a : TMass);
var
    i, j : Byte;
begin
    WriteLn;
    with a do
        for i := 1 to n do
        begin
            for j := 1 to m do
                Write(mass[i, j]:3);
            WriteLn;
        end;
    WriteLn;
end;
 
procedure Init1(var a : TMass);
var
    i, j : Byte;
begin
    with a do
    begin
        Write('n,m='); ReadLn(n, m);
        for i := 1 to n do
            for j := 1 to m do
                if Odd(i)
                then
                    mass[i, j] := (i - 1) * m + j
                else
                    mass[i, j] := i * m - j + 1;
    end;
end;
 
procedure Init2(var a : TMass); //https://www.cyberforum.ru/pascalabc/thread455450.html
var
    i, j, l : Byte;
begin
    j := 0;
    with a do
    begin
        Write('n='); ReadLn(n);
        m := n;
        for l := 1 to 2 * n - 1 do
            if (l > n)
            then
                if Odd(l)
                then
                    for i := l - n + 1 to n do
                    begin
                        Inc(j);
                        mass[i, l - i + 1] := j;
                    end
                else
                    for i := n downto l - n + 1 do
                    begin
                        Inc(j);
                        mass[i, l - i + 1] := j;
                    end
            else
                if Odd(l)
                then
                    for i := 1 to l do
                    begin
                        Inc(j);
                        mass[i, l - i + 1] := j;
                    end
                else
                    for i := l downto 1 do
                    begin
                        Inc(j);
                        mass[i, l - i + 1] := j;
                    end;
    end;
end;
 
procedure Init3(var a : TMass);
var
    i, j : Byte;
begin
    with a do
    begin
        Write('n,m='); ReadLn(n, m);
        for j := 1 to m do
            for i := 1 to n do
                if Odd(j)
                then
                    mass[i, j] := (j - 1) * n + i
                else
                    mass[i, j] := j * n - i + 1;
    end;
end;
 
begin
    Init1(arr); PrintMass(arr);
    Init2(arr); PrintMass(arr);
    Init3(arr); PrintMass(arr);
end.

b,k,n,m,i,j,x,y:integer;
begin
writeln('vvedite n');read(n);
for i:=1 to 2*n-1 do
if i mod 2<>0 then
begin
x:=n;
y:=i;
for j:=1 to i do
begin if (x>0) and (x<=n) and (y>0)and (y<=n) then
begin k:=k+1;
a[x,y]:=k;end;
x:=x-1;
y:=y-1;end;end
else begin x:=n-1+1;
y:=1;
for j:=1 to i do
begin if (x>0) and (x<=n) and (y>0)and (y<=n) then
begin k:=k+1;
a[x,y]:=k;end;
x:=x+1;
y:=y+1;end;
 
write (a[i,j]:4);
 writeln;end;
 end.
 
Также есть пример по спирали
program gfh;
var a:array[0..5,0..5] of integer;
b,k,n,m,i,j,di,dj:integer;
begin i:=1;j:=1;di:=0;dj:=1;
writeln('vvedite n,m:');read(n,m);
repeat k:=k+1;
a[i,j]:=k;
if (i+di>n) or (i+di<1) or(j+dj>m) or (j+dj<1) or (a[i+di,j+dj]>0)
then begin b:=dj;
           dj:=-di;
           di:=b; end;
 i:=i+di;
 j:=j+dj;
 until a[i,j]>0;
 for i:=1 to n do begin
 for j:=1 to m do
 write (a[i,j]:4);
 writeln;end;
 end.