Привет.
Я пробовал вот таким алгоритмом, но он не пашет.
Надо пройти массив зиг-загом и вывести каждое число на экран.
Например:
INput: 4
1 2 3 4
5 6 7 8
9 10 11 12
13 14 15 16
Output: 13 14 9 5 10 15 16 11 6 1 2 7 12 8 3 4

 
║               i:=n; j:=1;                                                    
║               y:=1;     x:=-1;                                                
║               write(a[i,j],' ');                                             
║               while (i<>1) and (j<>1) do begin                               
║                  x:=x+2;                                                     
║                  j:=j+1; write(a[i,j],' ');                                  
║                        while (i<>i-x) and (j<>j-x) do begin                  
║                        inc(k);                                               
║                      i:=i-k; j:=j-k;                                         
║                           write(a[i,j],' ');                                 
║                       end;                                                   
║                    i:=i-1; write(a[i,j],' ');                                
║                     k:=0;                                                    
║                      inc(y);                                                 
║                     while (i<>i+y) and (j<>j+y) do begin                     
║                           inc(k);                                            
║                         i:=i+k;  j:=j+k;                                     
║                                write(a[i,j],' ');                            
║                          end;                       

вот так.
║

На самом деле все очень просто, не надо всех этих ужасных циклов. Делаем так:

const
  n = 4;
  a : array[0 .. n - 1, 0 .. n - 1] of integer =
  (
    ( 1,  2,  3,  4),
    ( 5,  6,  7,  8),
    ( 9, 10, 11, 12),
    (13, 14, 15, 16)
  );

var
  i, j, K, L : Integer;

begin
  for K := 2 * n - 2 downto 0 do
    for L := 0 to k do
    begin
      if k mod 2 = 1 then
      begin
        i := L; j := K - L;
      end
      else
      begin
        i := K - L; j := L;
      end;

      if (i < n) and (j < n) then
        write(a[j, n - 1 - i] : 4);
    end;
  writeln;
end.

, на выходе - то, что ты просил...

Ну для начала,непонятно какое первоначальное значение принимает ваше k... первое упоминание о нем, в том что вы выложили, лиш когда вы его повышаете (inc(k)).Во вторых,у вас 3 бегина и 2 энда...непонятно как организованы циклы.А в третьих,как я понял у вас идет 2 вложеных цикла и сложность алгоритма n в кубе,что не очень хорошо для больших матриц.

Я могу предложить вам такую идею,можете ее рассмотреть.

У нас есть 4 возможных направления движения.Вправо,вверх,влево-вверх,вправо-вниз.Что если организовать 1 цикл и в нем проверять,куда можно пойти с условием приоритетов ходов.Например.
Мы стартуем с точки (n;1)сначала мы проверяем можем ли мы сделать шаг влево-вверх,нет не можем,выходим за граници,тогда проверяем можем ли мы сделать шам вправо,да можем идем туда,теперь мы в (n;2),проверяем можем ли мы вверх-влево,да можем идем туда.Тперь мы в (n-1;1),проверяем вверх влево,нет не можем.смотрим вправо,да можем.тогда проверяем,какой был предыдущий шаг,он был вверх-влево,тогда проверяем можем ли мы вверх,,если да то идем вверх.если нет то идем вправо.Да мы можем, идем в верх.

Ну и так далее.В общем мы создаем приоритеты по направлению движения и ставим условия так,чтобы у нас нельзя сделать шаг после вверх-влево сразу вправо,если у нас есть возможность сдвинуться вверх.ну и другие подобные ходы.Сложность этого алгоритма N,что достаточно выгодно для больших матриц,правда с условиями надо достаточно сильно проработать.

Всё гениальное просто! спасибо большое.

Вот сделал своим способом, показывает всё отлично, помогите упростить, а то слишком много букв.

║Program Olimp3; uses crt;                                                     
║const Nmax=10;                                                               
║type matrice=array[1..Nmax,1..Nmax] of integer;                               
║var     a:matrice; n:integer;     i,j,m,k,y,x,l:integer;                      
║        procedure Creare;                                                     
║         var i,j:integer;                                                     
║           begin                                                              
║           readln(n);                                                         
║            for i:=1 to n do                                                  
║             for j:=1 to n do begin                                          
║             write('a[',i,',',j,']='); read(a[i,j]);                          
║              end;                                                            
║           end;                                                               
║          procedure Afisare;                                                  
║           var i,j:integer;                                                   
║            begin                                                             
║            for i:=1 to n do begin                                            
║             for j:=1 to n do begin                                           
║              write(a[i,j], ' '); end; writeln;                               
║               end;      writeln; end;                                        
║                                                                              
║                                                                              
║begin clrscr;                                                                 
║  Creare;                                                                     
║  Afisare;                                                                    
║   i:=n; j:=1;                                                                
║        write(a[i,j],' ');                                                    
║     if n mod 2=0 then L:=1 else L:=n;                                        
║     while (i<>L) or (j<>L) do begin                                          
║      if j<>n then begin j:=j+1;   write(a[i,j],' '); {Right}               
║       x:=x+1;  k:=0;   end;                                                  
║       if j<>1 then while k<x  do begin   {Diagonal UP}                     
║         inc(k);                                                              
║         i:=i-1; j:=j-1;  write(a[i,j],' ');         end;                     
║       if i<>1 then begin i:=i-1;  write(a[i,j],' ');  {UP}                  
║        x:=x+1;   k:=0;  end;                                                 
║       if i<>n  then while k<x do begin {Diagonal Down}                       
║         inc(k);                                                              
║          i:=i+1; j:=j+1; write(a[i,j],' ');     end;                         
║         end;                                                                 
║       if (i=L) and (j=L) then                                                                                               
║        while (i<>1) or (j<>n) do begin                                       
║          if i<>1 then begin i:=i-1; write(a[i,j],' ');                       
║          x:=x-1; k:=0;      end;      {UP}                                  
║          if j<>1 then while k<x do begin                     {Diagonal UP} 
║           inc(k); i:=i-1; j:=j-1;  write(a[i,j],' ');                        
║                                    end;                                      
║             if j<>n then begin j:=j+1; write(a[i,j],' '); {RIGHT}          
║            x:=x-1; k:=0;       end;                                          
║           if i<>n then while k<x do begin {Diagonal Down}                    
║            inc(k);                                                           
║             i:=i+1; j:=j+1; write(a[i,j],' '); end;                         
║          end;                                                                
║   readln; readln;                                                            
║   end.                                                                       

у volvo там только для N=4

Да ты что? А если я изменю на N = 5 и подкорректирую описание матрицы А - то программа что, не запустится? Тогда скажи, почему. Потому что у меня она запускается и работает. Вот я хочу узнать, почему она работает, если не должна...

Да нет, если читать N с клавиатуры то бред выводит на экран.

2 DarkWishmaster:
Давай условимся: если программа переделана (хоть немного), то это уже не "у volvo", а у тебя. И означает это только то, что ты не можешь даже полностью рабочую программу немного модифицировать для своих нужд..

Ошибаться у тебя право есть. Для того ты сюда и пришел, чтоб ошибки исправлять. У тебя нет права приписывать свои ошибки другим. Это понятно?
Программа volvo прекрасно работает для всех n. Покажи, что ты в ней "наисправлял" - будем разбираться. А то так сказать "у volvo там.." - и ничем не подтвердить - это, знаешь ли, некрасиво..

2 volvo:
я тоже не удержался и сделал свой вариантик . Вряд ли он эффективнее твоего, но в нем только один цикл )). Вота:

const
  m= 10;

var
  a: array[1..m, 1..m] of integer;
  i,j,d,n: integer;

begin
  Write('введите размер матрицы (не более ',m,') : ');
  ReadLn(n);
  for i:=1 to n do begin
    for j:=1 to n do begin
      a[i,j]:= (i-1)*n+j;
      Write(a[i,j]:4)
    end;
    WriteLn
  end;
  WriteLn;
  // поехали..
  i:= n-1;
  j:= 0;
  d:= 1;
  repeat
    i:= i+d;
    j:= j+d;
    if (i>n) or (i=0) or (j>n) or (j=0) then begin
      d:= -d;
      if j>n then Dec(i) else if i=0 then Inc(j) else if j=0 then Dec(i) else Inc(j)  // heart
    end
    else Write(a[i,j]:4);
  until (i<=0) and (j>=n);
  readln
end.

Если честно, довольно долго с ним провозился (больше часа в общей сложности). Изюминка - правильно описать разворот. Как это водится, в конце концов он вписался в одну элегантную строчку (сердце)).

Lapp, спасибо.