В матрице уплотнить все четные элементы в направлении, указанном на рисунке

var i, n, row, col : integer;
 
procedure convCoords (var r : integer; var c : integer; idx : integer);
 
var brow, erow, i  : integer;
    direction_flag : boolean;
 
begin
  if idx = 1 then
  begin
    r := 1;
    c := n-1;
  end
  else if idx = ((n*n)-2) then
  begin
    r := n;
    c := 1;
  end
  else
  begin
    i              := 2;
    brow           := 2;
    erow           := brow + i;
    direction_flag := True;
    while i<n do
    begin
      if (erow>=idx) and (brow<=idx) then
      begin
        if direction_flag=True then
          r := (idx-brow) + 1
        else
          r := (erow - idx) + 1;
 
        c := (n-i) + (r - 1);
        Exit;
      end;
 
      Inc(i);
      direction_flag := not direction_flag;
      brow := erow + 1;
      erow := brow + i;
    end;
 
    i    := i - 2;
    erow := brow + i;
    while i>0 do
    begin
      if (erow>=idx) and (brow<=idx) then
      begin
        if direction_flag=True then
        begin
          c := (idx - brow) + 1;
          r := (n-i) + (c - 1);
        end
        else
        begin
          c := (erow - idx) + 1;
          r := (n-i) + (c - 1);
        end;
        Exit;
      end;
 
      Dec(i);
      direction_flag := not direction_flag;
      brow := erow + 1;
      erow := brow + i;
    end;
  end;
end;
 
begin
  N:=5;
 
  for i:=1 to (n*n)-2 do
  begin
    convCoords(row, col, i);
    WriteLn(i:2,') = ',row:2,';',col:2);
  end;
 
  ReadLn;
end.

uses crt;
var
    a:array[1..20,1..20]of integer;
    n,k,x,y,z:integer;
procedure check(n:byte;var i,j:integer);
begin
  if i=0 then inc(i)
  else
  if i>n then
      begin
        i:=n;
        j:=j+2;
      end;
end;
begin
clrscr;
write('n=');readln(n);
x:=1; y:=1; k:=1;
for z:=1 to n*n do
    begin
      a[x,y]:=z;
      x:=x+k;
      y:=y-k;
      if (x=0)or(y=0)or(x>n)or(y>n) then k:=-k;
      if odd(n)then
          begin
            check(n,x,y);
            check(n,y,x);
          end
      else
          begin
            check(n,y,x);
            check(n,x,y);
          end;
      end;
    for x:=1 to n do
      begin
        for y:=1 to n do
        write(a[x,y]:3);
        writeln;
      end;
  readln;
  end.