Turbo Pascal / Stud_1_1 / Metlab / LABOR5 / LABOR5D

Program Labor5d;
Uses Crt,Printer;
Const
NmaxX = 100; { ¬ Єб.Є®«-ў® н«Ґ¬Ґ­в®ў ў ¬ ббЁўҐ • }
NmaxY = 200; { в® ¦Ґ ¤«п ¬ ббЁў  Y }
NmaxZ = 300; { в® ¦Ґ ¤«п ¬ ббЁў  Z }
Enter = 13; { Є®¤ Є« ўЁиЁ Enter }
Escape = 27; { Є®¤ Є« ўЁиЁ Escape }
PressKey = 'Ќ ¦¬ЁвҐ Є« ўЁиг Enter';
Type
Xar = array[1..NmaxX] of real;
Yar = array[1..NmaxY] of real;
Zar = array[1..NmaxZ] of real;
Var
nX,nY,nZ : integer; { Є®«-ў® н«-в®ў ў ¬ ббЁў е X,Y,Z }
IndPrinter : boolean; { Ё­¤ЁЄ в®а ЁбЇ®«м§®ў ­Ёп ЇаЁ­вҐа  }
Reply : char; { бЁ¬ў®« ®вўҐв  ­  § Їа®б Їа®Ја ¬¬л }
X : Xar; { Ёб室­л© ¬ ббЁў X }
Y : Yar; { Ёб室­л© ¬ ббЁў Y }
Z : Zar; { Ёб室­л© ¬ ббЁў Z }
FileX,FileY, { Ёб室­лҐ д ©«л }
FileZ : text;
{ ------------------------------------------------------------- }
Procedure WaitEnter;
{ ‡ ¤Ґа¦Є  ўлЇ®«­Ґ­Ёп Їа®Ја ¬¬л ¤® вҐе Ї®а, }
{ Ї®Є  ­Ґ Ўг¤Ґв ­ ¦ в  Є« ўЁи  Enter }
Var ch : char;
Begin
Repeat ch:=ReadKey;
Until ord(ch) = Enter;
End { WaitEnter };
{ ------------------------------------------------------------- }
Procedure PrintString(X,Y:integer; S:string);
{ ЏҐз вм бва®ЄЁ S б Ї®§ЁжЁЁ X бва®ЄЁ нЄа ­  б ­®¬Ґа®¬ Y }
Begin
GotoXY(X,Y);
Write(S);
End { PrintString };
{ ------------------------------------------------------------- }
Procedure PrintKeyAndWaitEnter;
{ ЏҐз вм бва®ЄЁ-Є®­бв ­вл PressKey б Ї®§ЁжЁЁ 1 бва®ЄЁ нЄа ­  25 }
{ Ё § ¤Ґа¦Є  ўлЇ®«­Ґ­Ёп Їа®Ја ¬¬л ¤® ­ ¦ вЁп Є« ўЁиЁ Enter }
Begin
PrintString(1,25,PressKey);
WaitEnter;
ClrScr;
End { PrintKeyAndWaitEnter };
{ ------------------------------------------------------------- }
Procedure ControlPageScreen(Var j,KeyExit:byte);
{ Љ®­ва®«м а §¬Ґа  бва ­Ёжл ­  нЄа ­Ґ }
Const LengthPage = 23; { Є®«-ў® бва®Є ­  ®¤­®© бва ­ЁжҐ }
S = '‘«Ґ¤.бва ­Ёж  - "Enter", Є®­Ґж Їа®б¬®ва  - "Escape"';
Var ch : char;
Begin
Inc(j); KeyExit:=0;
If j=LengthPage then
Begin
j:=0;
PrintString(1,25,S);
Repeat
ch:=ReadKey; KeyExit:=ord(ch);
Until (KeyExit=Enter) or (KeyExit=Escape);
ClrScr;
End;
End { ControlPageScreen };
{ ------------------------------------------------------------- }
Procedure ReadArray(Var FileArray:text; Var A; Var n:integer);
{ ‚ў®¤ Ёб室­®Ј® ¬ ббЁў  }
Type RealAr = array[1..2*MaxInt div SizeOf(real)] of real;
Var i : integer;
B : RealAr absolute A;
Begin
Reset(FileArray);
n:=0;
While not SeekEof(FileArray) do
Begin
Inc(n);
Read(FileArray,b[n]);
End;
Close(FileArray);
End { ReadArray };
{ ------------------------------------------------------------- }
Procedure ScreenArray(Var A; n:integer; S:string);
{ ‚лў®¤ Ёб室­®Ј® ¬ ббЁў  ­  нЄа ­ }
Type RealAr = array[1..2*MaxInt div SizeOf(real)] of real;
Var i : integer;
j,k,KeyExit : byte;
B : RealAr absolute A;
Begin
ClrScr; j:=0; k:=0;
Writeln(S);
For i:=1 to n do
Begin
Inc(k);
If k<5 then
Write(b[i]:8:2,' ':4)
Else
Begin
k:=0; Inc(j);
Writeln(b[i]:8:2);
ControlPageScreen(j,KeyExit);
If KeyExit=Escape then Exit;
End;
End;
If k>0 then Writeln;
PrintKeyAndWaitEnter;
End { ScreenArray };
{ ------------------------------------------------------------- }
Procedure PrinterArray(Var A; n:integer; S:string);
{ ЏҐз вм Ёб室­®Ј® ¬ ббЁў  ­  ЇаЁ­вҐаҐ }
Type RealAr = array[1..2*MaxInt div SizeOf(real)] of real;
Var i : integer;
k : byte;
B : RealAr absolute A;
Begin
k:=0;
Writeln(Lst); Writeln(Lst,S);
For i:=1 to n do
Begin
Inc(k);
If k<5 then
Write(Lst,b[i]:8:2,' ':4)
Else
Begin
k:=0;
Writeln(Lst,b[i]:8:2);
End;
End;
If k>0 then Writeln(Lst);
End { PrinterArray };
{ ------------------------------------------------------------- }
Procedure Exchange(Var A; n:integer);
{ ЋЎ¬Ґ­ Ї®«®¦ЁвҐ«м­ле Ё ®ваЁж вҐ«м­ле н«Ґ¬Ґ­в®ў ў § ¤ ­­®¬ ¬ ббЁўҐ }
Type RealAr = array[1..2*MaxInt div SizeOf(real)] of real;
BufAr = array[1..1000] of real;
Var
i, { Ї а ¬Ґва жЁЄ«  }
k1, { Ё­¤ҐЄб ­ з «  Ї®ЁбЄ  Ї®«®¦.н«Ґ¬Ґ­в  }
k2, { Ё­¤ҐЄб ­ з «  Ї®ЁбЄ  ®ваЁж.н«Ґ¬Ґ­в  }
IndexPos, { Ї®§ЁжЁп Ї®«®¦ЁвҐ«м­®Ј® н«Ґ¬Ґ­в  }
IndexNeg, { Ї®§ЁжЁп ®ваЁж вҐ«м­®Ј® н«Ґ¬Ґ­в  }
NumberPos, { Є®«ЁзҐбвў® Ї®«®¦ЁвҐ«м­ле н«Ґ¬Ґ­в®ў }
NumberNeg, { Є®«ЁзҐбвў® ®ваЁж вҐ«м­ле н«Ґ¬Ґ­в®ў }
NumberExchange { Є®«ЁзҐбвў® ®Ў¬Ґ­®ў н«Ґ¬Ґ­в®ў }
: integer;
Buf : real; { ЎгдҐа­ п ЇҐаҐ¬Ґ­­ п }
Buffer : BufAr; { ЎгдҐа­л© ¬ ббЁў }
B : RealAr absolute A;
{ ---------------------------------------- }
Procedure SearchIndex;
{ Џ®ЁбЄ ў § ¤ ­­®¬ ¬ ббЁўҐ ®зҐаҐ¤­®© Ї ал Ї®«®¦ЁвҐ«м­®Ј® Ё ®ваЁж - }
{ ⥫쭮Ј® н«Ґ¬Ґ­в®ў, ­ зЁ­ п ᮮ⢥вб⢥­­® б Ї®§ЁжЁ© k1 Ё k2 }
Label 10;
Var i : integer;
Begin
IndexPos:=0; IndexNeg:=0;
For i:=k1 to n do
If b[i]>0 then
Begin
IndexPos:=i; Goto 10
End;
10:
If IndexPos>0 then
For i:=k2 downto 1 do
If b[i]<0 then
Begin
IndexNeg:=i; Exit
End;
End { SearchIndex };
{ ---------------------------------------- }
Begin

{ ”®а¬Ёа®ў ­ЁҐ ЎгдҐа­®Ј® ¬ ббЁў  }
For i:=1 to n do
buffer[i]:=b[i];

{ ЋЇаҐ¤Ґ«Ґ­ЁҐ Є®«ЁзҐбвў  ®Ў¬Ґ­®ў ў ¬ ббЁўҐ }
NumberPos:=0; NumberNeg:=0;
For i:=1 to n do
If b[i]>0 then
Inc(NumberPos)
Else
If b[i]<0 then
Inc(NumberNeg);
If NumberPos>NumberNeg then
NumberExchange:=NumberNeg
Else
NumberExchange:=NumberPos;

{ ЋаЈ ­Ё§ жЁп ®Ў¬Ґ­®ў н«Ґ¬Ґ­в®ў ў ¬ ббЁўҐ }
k1:=1; k2:=n;
For i:=1 to NumberExchange do
Begin
SearchIndex;
Buf:=buffer[IndexPos];
buffer[IndexPos]:=buffer[IndexNeg];
buffer[IndexNeg]:=Buf;
k1:=IndexPos+1; k2:=IndexNeg-1;
End;
For i:=1 to n do
b[i]:=buffer[i];
End { Exchange };
{ ------------------------------------------------------------- }
Begin

{ “бв ­®ўЄ  ᮮ⢥вбвўЁп ¬Ґ¦¤г ў­гв७­Ё¬Ё Ё ў­Ґи­Ё¬Ё д ©« ¬Ё }
Assign(FileX,'X.dat');
Assign(FileY,'Y.dat');
Assign(FileZ,'Z.dat');

{ ‡ Їа®б ®Ў ЁбЇ®«м§®ў ­ЁЁ ЇаЁ­вҐа  }
ClrScr; IndPrinter:=false;
Writeln('Ѓг¤Ґв «Ё ЁбЇ®«м§®ў ­ ЇаЁ­вҐа („ ,ЌҐв) ?');
Reply:=ReadKey;
If Reply in ['„','¤','L','l'] then
IndPrinter:=true;

{ ‚ў®¤, ®Ўа Ў®вЄ  Ё ўлў®¤ ¬ ббЁў  X }
ReadArray(FileX,X,nX);
ScreenArray(X,nX,' €б室­л© ¬ ббЁў •');
If IndPrinter then
PrinterArray(X,nX,' €б室­л© ¬ ббЁў •');
Exchange(X,nX);
ScreenArray(X,nX,' ЏаҐ®Ўа §®ў ­­л© ¬ ббЁў X');
If IndPrinter then
PrinterArray(X,nX,' ЏаҐ®Ўа §®ў ­­л© ¬ ббЁў X');

{ ‚ў®¤, ®Ўа Ў®вЄ  Ё ўлў®¤ ¬ ббЁў  Y }
ReadArray(FileY,Y,nY);
ScreenArray(Y,nY,' €б室­л© ¬ ббЁў Y');
If IndPrinter then
PrinterArray(Y,nY,' €б室­л© ¬ ббЁў Y');
Exchange(Y,nY);
ScreenArray(Y,nY,' ЏаҐ®Ўа §®ў ­­л© ¬ ббЁў Y');
If IndPrinter then
PrinterArray(Y,nY,' ЏаҐ®Ўа §®ў ­­л© ¬ ббЁў Y');

{ ‚ў®¤, ®Ўа Ў®вЄ  Ё ўлў®¤ ¬ ббЁў  Z }
ReadArray(FileZ,Z,nZ);
ScreenArray(Z,nZ,' €б室­л© ¬ ббЁў Z');
If IndPrinter then
PrinterArray(Z,nZ,' €б室­л© ¬ ббЁў Z');
Exchange(Z,nZ);
ScreenArray(Z,nZ,' ЏаҐ®Ўа §®ў ­­л© ¬ ббЁў Z');
If IndPrinter then
PrinterArray(Z,nZ,' ЏаҐ®Ўа §®ў ­­л© ¬ ббЁў Z');

End.