Удаление столбцов матрицы, не содержащих 0

program UnDeIf0;
uses crt;
var
D: array [1..10,1..10] of integer;
I: byte;
J: byte;
N: byte;
M: byte;
R: integer; 
K: byte;
begin
clrscr;
writeln('Программа для удаления столбцов без 0');
readln;
clrscr;
repeat
writeln('Введите количество столбцов');
readln (N);
if (N<1) or (N>10) then
writeln('Ошибка размерности');
writeln('Введите количество строк');
readln (M);
if (M<1) or (M>10) then
writeln('Ошибка размерности');
until (N in [1..10]) and (M in [1..10]);
for J:=1 to M do
for I:=1 to N do
begin
writeln ('Введите элемент массива');
readln (D[i, j]);
end;
writeln ('Исходный массив');
for J:=1 to M do
begin
writeln;
for I:=1 to N do
write (D[i,j]);
end;
readln;
clrscr;
R:=0;
for I:=1 to N do
begin
K:=0;
for J:=1 to M do
    begin
    if D[i,j]=0 then
    K:=1;
    end;
If K=0 then
begin
R:=R+1;
for i:=i to N-1 do
for J:=1 to M do
D[i, j]:= D[i+1, j];
end;
end;
If R=N then writeln ('Все элементы были удалены!')
else writeln ('Новый массив:');
for J:=1 to M do
begin
  writeln;
  for I:=1 to N-R do
  write (D[i, j]);
end;
readln;
end.

program UnDeIf0;
uses crt;
var D: array [1..10,1..10] of integer;
    I,J,N,M,K,P,R: byte;
begin
clrscr;
writeln('Программа для удаления столбцов без 0');
readln;
clrscr;
repeat
writeln('Введите количество столбцов');
readln (N);
if (N<1) or (N>10) then
writeln('Ошибка размерности');
writeln('Введите количество строк');
readln (M);
if (M<1) or (M>10) then
writeln('Ошибка размерности');
until (N in [1..10]) and (M in [1..10]);
for I:=1 to M do
for J:=1 to N do
 begin
  write ('Введите элемент массива D[',I,',',J,']=');
  readln (D[i,j]);
end;
clrscr;
writeln ('Исходный массив');
for I:=1 to M do
 begin
  for J:=1 to N do
  write (D[i,j]:4);
  writeln
 end;
R:=0; {нет пока удалений}
J:=N;{начнем с последнего столбца}
while J>=1 do
 begin
  K:=0;{нет нулей}
  I:=1;
  while(I<=M)and(K=0) do{пока не конец столбца и нет нолей}
  if D[i,j]=0 then K:=1{если ксть 0, то больше не ищем}
  else I:=I+1; {иначе ищем дальше}
  if K=0 then{если нет нолей}
   begin
    R:=1;{зафиксируем удаление}
    if J=N then {если столбец на этот момент последний}
     begin
      N:=N-1;{обрезаем}
      J:=J-1;{влево}
     end
    else {если не последний}
     begin
      for K:=J to N-1 do{от этого столбца до предпоследнего}
      for P:=1 to M do{всем элементам столбцов}
      D[P,K]:=D[P,K+1];{присваиваем значения правого}
      N:=N-1;{уменьшаем количество}
     end;
   end
  else J:=J-1;{если есть ноли, влево}
 end;
if N=0 then writeln('Все столбцы удалены!')
else if R=0 then write('Нет столбцов для удаления')
else
 begin
  writeln('Удаление столбцов без нолей:');
  for I:=1 to M do
   begin
    for J:=1 to N do
    write(D[I,J]:4);
    writeln;
  end;
 end;
readln;
end.