Дана матрица А порядка н. Удалить строки содержащие нулевые элементы.
uses
crt;
type
matr=array[1..10,1..10] of integer;
stroka=string[30];
vekt=array[1..9] of byte;
var
a:matr;
n,m:integer;
flag:boolean;
procedure vvodmatr (var a:matr;namefile:stroka;
var n,m:integer);
var
i,j:integer;
fin:text;
begin
assign(fin,namefile);
reset(fin);
for i:=1 to n do
begin
for j:=1 to m do
read(fin,a[i,j]);
readln(fin);
end;
close(fin);
end;
procedure vivodmatr (namefile:stroka; a:matr; n,m:integer;
var flag:boolean);
var
i,j:integer;
fout:text;
begin
assign(fout,namefile);
if flag then
rewrite(fout)
else
append(fout);
for i:=1 to n do
begin
for j:=1 to m do
write(fout,a[i,j]);
writeln(fout);
end;
close(fout);
end;
procedure delstrok (namefile:stroka; var a:matr; n,m:integer; var flag:boolean);
var
b:vekt;
i,j:integer;
f,p,k:byte;
fout:text;
begin
f:=0;
for i:=1 to n do
begin
k:=0;
for j:=1 to m do
if a[i,j]=0 then
begin
k:=1;
f:=1;
end;
b[i]:=k;
end;
if f=0 then write('V matrice net nol')
else
begin
i:=n;
while(i>=1)and(n>0) do
begin
k:=0;
j:=1;
while(j<=m)and(k=0) do
if a[i,j]=0 then k:=1
else j:=j+1;
if k=1 then
begin
f:=f-1;
if i=n then
begin
n:=n-1;
i:=i-1;
end
else
begin
for k:=i to n-1 do
for p:=1 to m do
a[k,p]:=a[k+1,p];
n:=n-1;
end;
end
else i:=i-1;
end;
end;
assign(fout,namefile);
if flag then
rewrite(fout)
else
append(fout);
for i:=1 to n do
begin
for j:=1 to m do
write(fout,a[i,j]);
writeln(fout);
end;
close(fout);
end;
Begin
clrscr;
write ('vvod poryadok matric');
readln(n);
m:=n;
vvodmatr (a,'L8_in.txt',n,m);
flag:=true;
vivodmatr ('L8_out.txt',a,n,m,flag);
flag:=false;
delstrok ('L8_out.txt',a,n,m,flag);
end.