Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

Turbo Pascal / Stud_1_1 / Metlab / LABOR5 / LABOR5A

.PAS
Скачиваний:
91
Добавлен:
03.03.2016
Размер:
5.9 Кб
Скачать
Program Labor5a;
Uses Crt,Printer;
Const
Nmax = 100; { ¬ Єб.Є®«-ў® н«Ґ¬Ґ­в®ў ў ¬ ббЁўҐ X }
Enter = 13; { Є®¤ Є« ўЁиЁ Enter }
Escape = 27; { Є®¤ Є« ўЁиЁ Escape }
PressKey = 'Ќ ¦¬ЁвҐ Є« ўЁиг Enter';
Type
Xar = array[1..Nmax] of real;
Var
i, { Ї а ¬Ґва жЁЄ«  }
n, { Є®«-ў® н«Ґ¬Ґ­в®ў ў ¬ ббЁўҐ • }
k1, { Ё­¤ҐЄб ­ з «  Ї®ЁбЄ  Ї®«®¦.н«-в  }
k2, { Ё­¤ҐЄб ­ з «  Ї®ЁбЄ  ®ваЁж.н«-в  }
IndexPos, { Ї®§ЁжЁп Ї®«®¦ЁвҐ«м­®Ј® н«Ґ¬Ґ­в  }
IndexNeg, { Ї®§ЁжЁп ®ваЁж вҐ«м­®Ј® н«Ґ¬Ґ­в  }
NumberPos, { Є®«ЁзҐбвў® Ї®«®¦ЁвҐ«м­ле н«Ґ¬Ґ­в®ў }
NumberNeg, { Є®«ЁзҐбвў® ®ваЁж вҐ«м­ле н«Ґ¬Ґ­в®ў }
NumberExchange { Є®«ЁзҐбвў® ®Ў¬Ґ­®ў н«Ґ¬Ґ­в®ў }
: integer;
Buf : real; { ЎгдҐа­ п ЇҐаҐ¬Ґ­­ п }
IndPrinter : boolean; { Ё­¤ЁЄ в®а ЁбЇ®«м§®ў ­Ёп ЇаЁ­вҐа  }
Reply : char; { бЁ¬ў®« ®вўҐв  ­  § Їа®б Їа®Ја ¬¬л }
X,Buffer : Xar; { Ёб室­л© Ё ЎгдҐа­л© ¬ ббЁўл }
FileX : 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 i : integer;
Begin
Reset(FileX);
n:=0;
While not SeekEof(FileX) do
Begin
Inc(n);
Read(FileX,x[n]);
End;
Close(FileX);
End { ReadArray };
{ ------------------------------------------------------------- }
Procedure ScreenArray(S:string);
{ ‚лў®¤ ­  нЄа ­ ¬ ббЁў  • }
Var i : integer;
j,k,KeyExit : byte;
Begin
j:=0; k:=0;
Write(S); Writeln(' n = ',n);
For i:=1 to n do
Begin
Inc(k);
If k<5 then
Write(x[i]:8:2,' ':4)
Else
Begin
k:=0; Inc(j);
Writeln(x[i]:8:2);
ControlPageScreen(j,KeyExit);
If KeyExit=Escape then Exit;
End;
End;
If k>0 then Writeln;
PrintKeyAndWaitEnter;
End { ScreenArray };
{ ------------------------------------------------------------- }
Procedure PrinterArray(S:string);
{ ЏҐз вм ­  ЇаЁ­вҐаҐ ¬ ббЁў  • }
Var i : integer;
k : byte;
Begin
k:=0;
Writeln(Lst);
Write(Lst,S); Writeln(Lst,' n = ',n);
For i:=1 to n do
Begin
Inc(k);
If k<5 then
Write(Lst,x[i]:8:2,' ':4)
Else
Begin
k:=0;
Writeln(Lst,x[i]:8:2);
End;
End;
If k>0 then Writeln(Lst);
End { PrinterArray };
{ ------------------------------------------------------------- }
Procedure SearchIndex;
{ Џ®ЁбЄ ў ¬ ббЁўҐ • ®зҐаҐ¤­®© Ї ал Ї®«®¦ЁвҐ«м­®Ј® Ё ®ваЁж вҐ«м­®Ј® }
{ н«Ґ¬Ґ­в®ў, ­ зЁ­ п ᮮ⢥вб⢥­­® б Ї®§ЁжЁ© k1 Ё k2 }
Label 10;
Var i : integer;
Begin
IndexPos:=0; IndexNeg:=0;
For i:=k1 to n do
If x[i]>0 then
Begin
IndexPos:=i; Goto 10
End;
10:
If IndexPos>0 then
For i:=k2 downto 1 do
If x[i]<0 then
Begin
IndexNeg:=i; Exit
End;
End { SearchIndex };
{ ------------------------------------------------------------- }
Begin

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

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

{ ‚ў®¤ Ё ўлў®¤ Ёб室­ле ¤ ­­ле }
ReadArray;
ScreenArray(' €б室­л© ¬ ббЁў •');
If IndPrinter then
PrinterArray(' €б室­л© ¬ ббЁў •');

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

{ ЋЇаҐ¤Ґ«Ґ­ЁҐ Є®«ЁзҐбвў  ®Ў¬Ґ­®ў н«Ґ¬Ґ­в®ў ў ¬ ббЁўҐ }
NumberPos:=0; NumberNeg:=0;
For i:=1 to n do
If x[i]>0 then
Inc(NumberPos)
Else
If x[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
x[i]:=buffer[i];

{ ‚лў®¤ ЇаҐ®Ўа §®ў ­­®Ј® ¬ ббЁў  }
ScreenArray(' ЏаҐ®Ўа §®ў ­­л© ¬ ббЁў X');
If IndPrinter then
PrinterArray(' ЏаҐ®Ўа §®ў ­­л© ¬ ббЁў X');

End.

Соседние файлы в папке LABOR5