Добрый день! Очень прошу помочь со следующей задачей: в заданной квадратной матрице NxN удалить все строки и столбцы, которые содержат нулевой элемент (то есть если находится 0, то надо удалить сразу и строку и столбец). Для одного нуля моя программа работает, но как сделать для большего количества, я не могу понять. Очень прошу помощи, заранее спасибо!

Вот то что я написал:

program Project1;
{$APPTYPE CONSOLE}
uses
  SysUtils;
const n=4;
type telem=integer;
      mas=array[1..n] of telem;
      matr=array[1..n] of mas;
var i,j,k,p,m:integer;
a:matr;
procedure delstroka(var a:matr; k:integer);
var i,j:integer;
begin
  for i:=k to n-1 do
  for j:=1 to n do
    a[i,j]:=a[i+1,j]
end;
procedure delstolbec(var a:matr; p:integer);
var i,j:integer;
begin
  for i:=1 to n do
  for j:=p to n-1 do
    a[i,j]:=a[i,j+1]
end;
procedure vvod(var a:matr);
var i,j:integer;
begin
  writeln('vvedite massiv');
  for i:=1 to n do
  for j:=1 to n do
    read(a[i,j]);
end;
procedure delnyli(var a:matr);
var i,j,p,k,m:integer;
begin
  for i:=1 to n do
  for j:=1 to n do
      if a[i,j]=0 then
        begin
          k:=i;
          p:=j;
          delstroka(a,k);
          delstolbec(a,p);
        end;
end;
procedure print(var a:matr);
var i,j:integer;
begin
  for i:=1 to n do
      begin
        writeln;
        for j:=1 to n do
            write(a[i,j],' ');
      end;
end;
begin
  vvod(a);
  delnyli(a);
  print(a);
  readln;
  readln;
end.

Твоя ошибка заключается в непонимании, что значит удалить строку или столбец. То есть ты понимаешь наполовину: передвигаешь элементы правильно, а вот уменьшить размер матрицы - забываешь. Ведь если мы действительно удаляем их - матрица становится меньше. Поэтому основной цикл нужно изменить. В момент удаления нужно уменьшать размер матрицы (поэтому я ввел дополнительную константу m, а n сделал переменной). И тогда использование цикла FOR тут исключается (в FOR нельзя менять пределы в процессе цикла), и я использовал WHILE. Кроме того, после каждого удаления нужно снова проходить по той же строке сначала (сбрасывать j в 1), так как нули могли прийти в уже просмотренный участок текущей строки в процессе сдвига строки (со столбцом такого произойти не может, так что сбрасывать i в единицу не нужно).

Еще несколько замечаний:
1. при удалении строки достаточно одного цикла (посмотри, как я сделал);
2. не нужно декларировать всякие i,j и т.п. в основной программе, если они нужны тебе только в процедурац и ты там их все равно декларируешь;
3. обрати внимание, как я изменил процедуру Vvod - теперь в конце тебе должно быть достаточно одного ReadLn;
4. форматирование, форматирование и еще раз форматирование!! посмотри, как я сделал и постарайся придерживаться..

Вроде все пока.. Спрашивай, что неясно.

program Project1;
{$APPTYPE CONSOLE}
uses
  SysUtils;
const
  m=5;
type
  telem= integer;
  mas= array[1..m] of telem;
  matr= array[1..m] of mas;
var
  n: integer;

const
  a: matr=(
    (11, 12, 13,  0, 15),
    (21, 22, 23, 24,  0),
    (31, 32, 33, 34, 35),
    (41, 42,  0, 44, 45),
    ( 0, 52, 53, 54, 55)
  );

procedure print(var a:matr);
var
  i,j:integer;
begin
  WriteLn;
  for i:=1 to n do begin
    for j:=1 to n do write(a[i,j]:5,' ');
    writeln;
  end;
end;

procedure DelStroka(var a:matr; k:integer);
var
  i: integer;
begin
   // достаточно одного цикла, если перемещать целые строки
  for i:=k to n-1 do a[i]:=a[i+1]
end;

procedure DelStolbec(var a:matr; p:integer);
var
  i,j:integer;
begin
  for i:=1 to n do for j:=p to n-1 do a[i,j]:=a[i,j+1]
end;

procedure vvod(var a:matr);
var
  i,j:integer;
begin
  writeln('vvedite massiv');
  for i:=1 to n do begin
    for j:=1 to n do read(a[i,j]);
    ReadLn
  end
end;

procedure DelNyli(var a:matr);
var
  i,j: integer;
begin
    i:=1;
    while i<=n do begin    // for - нельзя
      j:=1;
      while j<=n do begin    // for - нельзя
        if a[i,j]=0 then begin
          DelStroka(a,i);
          DelStolbec(a,j);
          Dec(n);      // уменьшаем размер матрицы
          Print(a);     // промежуточная печать - убери ее
          j:=1      // проходим по строке снова с самого начала
        end
        else Inc(j)
      end;
      Inc(i);
    end
end;

begin
  n:=m;
  Print(a);
  //vvod(a);
  delnyli(a);
  print(a);
  readln;
end.

Со всем разобрался. Большое спасибо за помощь =)

хотя нет, вру. программа работает корректно только в случае если два нуля не стоят на одной строке или в одном столбце, иначе при как только встречается первый ноль, то программа удаляет всю строку целиком и поэтому при втором просмотре матрицы этого нуля уже нет и соответственно нужный столбец не удаляется.
Например
5 0 0 6
8 2 3 5
8 8 2 3
7 9 1 3

В данном случае программа выдаст
8 3 5
8 2 3
7 1 3
хотя должно быть
8 5
8 3
7 3
Попробую доработать программу для такого случая

по-моему, надо запомнить номера всех строк и столбцов, в которых есть 0 и удалить что надо

Да, согласен. Извиняюсь за дезу..

Начать советую с того, что отказаться от квадратности матрицы - ввести отдельные размеры по строкам и столбцам.
И алгоритм просмотра нужно полностью менять. Нельзя удалять в процессе поиска нулей. Нужно сначала найти и запомнить (или пометить) все содержащие нули строки и столбцы. Запоминать (метить) можно по-разному - можно в двух одномерных массивах, например. Ниже я привел свой вариант с запоминаниями в двух переменных типа множество. В процессе удаления нельзя забывать, что номера строк меняются при удалении (я делаю коррекцию прямо в процедурах удаления).

Надеюсь, оно работает верно на этот раз . Главное - надо обязательно разделять процесс поиска нулей и процесс удаления.

program Project1;
{$APPTYPE CONSOLE}
uses
  SysUtils;
const
  max= 5;
  Debug= true;
type
  tElem= integer;
  tRow= array[1..max] of tElem;
  tMatrix= array[1..max] of tRow;
var
  m,n: integer;
  zi,zj: set of byte;

procedure print(var a:tMatrix; m,n: integer);
var
  i,j:integer;
begin
  WriteLn;
  if m*n=0 then WriteLn('Matrix is empty')
  else for i:=1 to m do begin
    for j:=1 to n do write(a[i,j]:5,' ');
    writeln;
  end;
end;

procedure DelRow(var a:tMatrix; var m,n: integer; k:integer);
var
  i: integer;
begin
  for i:=k to m-1 do a[i]:=a[i+1];
  zi:=zi-[k];
  for i:=k+1 to m do if i in zi then begin
    zi:=zi-[i];
    zi:=zi+[i-1]
  end;
  Dec(m);
  if Debug then Print(a,m,n)
end;

procedure DelCol(var a:tMatrix; var m,n: integer; k :integer);
var
  i,j:integer;
begin
  for i:=1 to m do for j:=k to n-1 do a[i,j]:=a[i,j+1];
  zj:=zj-[k];
  for j:=k+1 to n do if j in zj then begin
    zj:=zj-[j];
    zj:=zj+[j-1]
  end;
  Dec(n);
  if Debug then Print(a,m,n)
end;

var
  i,j: integer;
  a: tMatrix;

begin
  m:=max;
  n:=max;

  // заполнение случайными величинами
  Randomize;
  for i:=1 to m do for j:=1 to n do a[i,j]:=Random(max);
  Print(a,m,n);

  // просмотр и поиск нулей
  zi:=[];   // подготовка множеств меченых строк,
  zj:=[];   // сначала они пустые
  for i:=1 to m do for j:=1 to n do if a[i,j]=0 then begin  // если найден нуль, то
    zi:=zi+[i];     // запоминаем номер строки
    zj:=zj+[j]      // и номер столбца
  end;

  // цикл удаления
  for i:=max downto 1 do if i in zi then DelRow(a,m,n,i);   // строк
  for j:=max downto 1 do if j in zj then DelCol(a,m,n,j);   // столбцов

  print(a,m,n);
  readln;
end.

Еще раз извиняюсь, и спасибо за указание на ошибку.

Добавлено через 57 сек.
Ага

Lapp спасибо большое еще раз , программа работает нормально, ошибок не обнаружил больше=)