Удалить все строки матрицы, которые состоят из одних нулей.

uses
  crt;
var
  a:array [1..1000,1..1000] of integer;
  i,j,k,str,col,temp,c:integer;
begin
  clrscr;
  {çàäàåì ðàçìåð ìàòðèöû}
  writeln('Ââåäèòå ðàçìåð ìàòðèöû...');
  readln(str);
  col:=str;
  {çàïèñûâàåì ìàòðèöó}
  writeln('Çàäàéòå ìàòðèöó ðàçìåðîì ',str,'x',col,'...');
  for i:=1 to str do
    for j:=1 to col do
    begin
      write('a[',i,',',j,']:=');
      readln(a[i,j])
    end;
  {âûâîäèì ìàòðèöó ìàòðèöó}
  writeln('Èñõîäíàÿ ìàòðèöà:');
  for i:=1 to str do
  begin
    for j:=1 to col do
      write(a[i,j]:2,' ');
    writeln
  end;
  {óäàëÿåì íóëåâûå ñòðîêè}
  for i:=1 to str do
  begin
    c:=0;
    for j:=1 to col do
      if a[i,j]=0 then
        inc(c);
    if c=col then
    begin
      for k:=i to str-1 do
        for j:=1 to col do
          a[k,j]:=a[k+1,j];
      Dec(str)
    end;
  end;
  {âûâîäèì íîâóþ ìàòðèöó}
  writeln('Íîâàÿ ìàòðèöà: ');
  for i:=1 to str do
  begin
    for j:=1 to col do
      write(a[i,j]:2,' ');
    writeln
  end
end.