Правила форума
Прочтите прежде чем задавать вопрос!
запускаю
выдает запрос на принтер
жму нет
показывает матрицу
жму Esc
и тут черный экран....
Program Labor4;
Uses Crt,Printer;
Const Nmax = 30;Mmax = 20;
Type
Ar=array[1..Mmax] of byte;
Matrix = array[1..Mmax,1..Nmax] of real;
Var
i,j,n,m,r,p : byte;
K : ar;
IndPrinter,
Cond : boolean;
ch : char;
tmp : real;
buf : integer;
A : Matrix;
F : text;
s1,s2 : shortint;
{ ------------------------------------------------------------- }
Procedure WaitEscape;
Var ch : char;
Begin
Repeat
ch:=ReadKey;
Until ord(ch)=27;
End { WaitEscape };
{ ------------------------------------------------------------- }
Procedure ReadMatrix;
Var i,j : byte;
Begin
Reset(F);
Read(F,n,m);
For i:=1 to m do
For j:=1 to n do
Read(F,a[i,j]);
Close(F);
End { ReadMatrix };
{ ------------------------------------------------------------- }
Procedure ScreenMatrix;
Var i,j,r : byte;
Begin
For i:=1 to m do
Begin
r:=0;
For j:=1 to n do
Begin
Inc®;
If r<10 then
Write(a[i,j]:8:2,' ')
Else
Begin
r:=0;
Writeln(a[i,j]:8:2,' ')
End
End;
If r>0 then Writeln;
End;
If r>0 then Writeln;
End { ScreenMatrix };
{ ------------------------------------------------------------- }
function sign(b:real):shortint;
begin
if b>0 then
sign:=1
else
if b=0 then
sign:=0
else
sign:=-1;
end {sign};
{ ------------------------------------------------------------- }
Procedure PrinterMatrix;
Var i,j,r : byte;
Begin
For i:=1 to m do
Begin
r:=0;
For j:=1 to n do
Begin
Inc®;
If r<10 then
Write(Lst,a[i,j]:8:2,' ')
Else
Begin
r:=0;
Writeln(Lst,a[i,j]:8:2,' ')
End
End;
If r>0 then Writeln(Lst);
End;
If r>0 then Writeln(Lst);
End { PrinterMatrix };
{ ------------------------------------------------------------- }
Begin
Assign(F,'Matrix.dat');
ClrScr;
Writeln(' Буде тли использован принтер (Да,нет)?');
ch:=ReadKey;
If ch in ['д','Д','L','l'] then
IndPrinter:=true
Else
IndPrinter:=false;
ReadMatrix;
Writeln(' Исходная матрица ');
Writeln(' m = ',m);
Writeln(' n = ',n);
ScreenMatrix;
If IndPrinter then
Begin
Writeln(Lst,' Исходная матрица ');
Writeln(Lst,' n = ',n);
Writeln(Lst,' m = ',m);
PrinterMatrix;
End;
waitescape;
clrscr;
begin
for i:=1 to m do
begin
k[i]:=0;
for j:=1 to n do
s1:=sign(a[i,j]);
s2:=sign(a[m,j]);
if s1=s2 then
inc(k[i]);
end;
cond:=true;
p:=m-1;
while cond do
begin
cond:=false;
for i:=1 to p do
if k[i]>k[i+1] then
buf:=k[i];
k[i]:=k[i+1];
k[i+1]:=buf;
for j:=1 to n do
begin
tmp:=a[i,j];
a[i,j]:=a[i+1,j];
a[i+1,j]:=tmp;
end;
cond:=true;
end;
dec(p);
end;
writeln(' preobrazovannaia matriza');
screenmatrix;
If IndPrinter then
Begin
Writeln(Lst);
Writeln(Lst,'Preobrazovannaia matriza');
PrinterMatrix;
end;
waitescape;
end.
Сообщение отредактировано: sashamarhenko -
