Файл LABAZZ7.PAS
Program LabaZZ7;
Uses ManagZZ,ProceZZ,ServiZZ,Crt;
Const NORM=$1F; { Цвет невыделенного пункта }
SEL=$3F; { Цвет выделенного пункта }
Var ch:char; { Введенный символ }
{
------------------------ ОСНОВНАЯ ПРОГРАММА ------------------------------
}
BEGIN
Window(1,1,80,25);
TextAttr:=Norm;
ClrScr;
menu[1]:=' Постановка задачи ';
menu[2]:=' Ввод данных с клавиатуры ';
menu[3]:=' Считывание данных из файла ';
menu[4]:=' Выход ';
SetNoCursor;
punkt:=1;
x:=2;
y:=1;
MenuToScr(punkt);
PodSkazka;
repeat
repeat
ch:=ReadKey;
if ch=chr(0) then begin
ch:=ReadKey;
TextAttr:=NORM;
MenuToScr(punkt);
case ch of
chr(80): { Стрелка вниз }
if (punkt<N) and (punkt<>0) then begin
GoToXY(x,y+punkt-1);
write(menu[punkt]);
punkt:=punkt+1;
TextAttr:=SEL;
GoToXY(x,y+punkt-1);
write(menu[punkt]);
PodSkazka;
end
else begin
punkt:=N;
GoToXY(x,y+N-1);
write(menu[punkt]);
punkt:=1;
TextAttr:=SEL;
GoToXY(x,y+punkt-1);
write(menu[punkt]);
PodSkazka;
end;
chr(72): { Стрелка вверх }if punkt>1 then begin
GoToXY(x,y+punkt-1);
write(menu[punkt]);
punkt:=punkt-1;
TextAttr:=SEL;
GoToXY(x,y+punkt-1);
write(menu[punkt]);
PodSkazka;
end
else begin
punkt:=1;
GoToXY(x,y);
write(menu[punkt]);
punkt:=N;
TextAttr:=SEL;
GoToXY(x,y+punkt-1);
write(menu[punkt]);
PodSkazka;
end;
chr(59): begin { Нажатие <F1> }
help;
window(1,1,80,25);
MenuToScr(punkt);
Podskazka;
end;
chr(61): begin { Нажатие <F3> }
VFile;
window(1,1,80,25);
MenuToScr(punkt);
Podskazka;
end;
chr(60): begin { Нажатие <F2> }
VKeyb;
{CFile; }
window(1,1,80,25);
MenuToScr(punkt);
Podskazka;
end;
end;
Podskazka;
end
else if ch=chr(13) then begin { Нажата клавиша <ENTER> }
case punkt of
{------------------- ПУНКТЫ МЕНЮ --------------}
1:Help;
2:begin VKeyb;{CFile; }
end;
3:begin VFile;{CFile; }
end;
4:ViborVixod; { Выход }
{----------------------------------------------}
end;
if flag=1 then begin
window(1,1,80,25);
TextBackGround(0);
clrscr;
exit;
end;
window(1,1,80,25);
TextAttr:=Norm;
MenuToScr(punkt);
Podskazka;
end;
until ch=Chr(27);
ViborVixod;{ 27=код <ESC> }
Podskazka;
until flag=1;{условие на выход}
window(1,1,80,25);
TextBackGround(0);
clrscr;
ClrKeyBuf;
end.
Файл ManagZZ.PAS
UNIT ManagZZ;
interface
Uses ServiZZ, Crt;
CONST
NORM=$1F; { Цвет невыделенного пункта }
SEL=$3F; { Цвет выделенного пункта }
N=4; { Число пунктов меню }
VAR
x,y:integer; { Координаты первой строки меню }
menu:array[1..N] of string[50]; { Названия пунктов меню }
punkt:integer; { Номер выделенного пункта }
flag:word; { Флаг выхода}
{------------------------------------------------------------------}
PROCEDURE MenuToScr(punkt :integer);
PROCEDURE ViborVixod;
PROCEDURE PodSkazka;
{------------------------------------------------------------------}
implementation
{
----------------Вывод меню на экран-----------------
}
PROCEDURE MenuToScr(punkt :integer);
Var
i:integer;
begin
SetNoCursor;
CLrScr;
Win(1,1,80,25,1,1);
Frame(3,2,78,24,15,2);
Win(35,2,44,4,1,15);
Write(' Лаба № 7');
Window(3,25,80,25);
TextBackGround(7);
TextColor(4);
write(' <ESC>');
TextColor(0);
write(' - Exit');
TextColor(4);
write(' <F1>');
TextColor(0);
write(' - Help');
TextColor(4);
write(' <F2>');
TextColor(0);
write(' - WriteKeyb');
TextColor(4);
write(' <F3> ');
TextColor(0);
write('- WriteDataFile ');
Win(7,4,73,23,1,7);
clrscr;
TextAttr:=NORM;
for i:=1 to N do
begin
GoToXY(x,y+i-1);
write(menu[i]);
end;
TextAttr:=SEL;
GoToXY(x,y+punkt-1);
write(menu[punkt]); { Выделение строки меню }
TextAttr:=NORM;
END;
{
------------------ выбор выхода из программы -----------------------------------------------
}
PROCEDURE ViborVixod;
VAR
ch1:char;
BEGIN
Win(1,1,80,25,0,0);
Win(15,12,66,14,1,9);
Frame(2,1,51,3,11,2); { Рамка в окне вывода }
Win(17,13,64,13,1,15);
ClrScr;
Write(' Выйти из программы? (Y/N) или (<Enter>/<Esc>)');
ch1:=ReadKey;
if ((ch1='y') or (ch1='Y') or (ch1='н') or (ch1='Н') or (ch1=chr(13)))
then flag:=1 { Значение флага для выхода из программы }
else
begin
Window(1,1,80,25); {Отрисовка меню и прочее...}
TextAttr:=Norm;
MenuToScr(punkt);
end;
while KeyPressed do ch1:= ReadKey;
END;
{
----------------------------вывод комментариев------------------------------
}
PROCEDURE PodSkazka;
begin
Win(10,22,70,23,1,15);
ClrScr;
WRITE('Комментарий:');
TextColor(11);
case punkt of
1: write(' Что делает программа. ');
2: write(' Ввод данных вручную. Результаты записываются в файл res.txt');
3: write(' Ввод данных из файла. Результаты записываются в файл res.txt');
4: write(' Sic transit gloria mundi. ');
end;
end;
BEGIN
END.
Файл ProceZZ.PAS
UNIT ProceZZ;
interface
Uses
Crt,ServiZZ,dos;
Type
Tvector= array [1..80] of integer;
CONST
NORM=$1F; { Цвет невыделенного пункта }
SEL=$3F; { Цвет выделенного пункта }
VAR
Vector, v1 : Tvector;
I0, j0, k0, B0, p0, y0 : integer;
f, inf:text;
ss:pathstr;
{------------------------------------------------------------------}
PROCEDURE Reshenie;
PROCEDURE Help;
PROCEDURE VKeyb;
PROCEDURE VFile;
{------------------------------------------------------------------}
implementation
{
---------------------------Алгоритм решения--------------------------------
}
PROCEDURE Reshenie;
begin
ClrScr;
for i0:= 2 to p0 do
begin
B0:= Vector[i0]; {Берем несортированный элемент}
{Ищем куда вставить}
j0:= 1;
while (B0> Vector[j0]) do
j0:= j0+1; {Фиксируем позицию j вставки}
{сдвигаем элементы для освобождения позиции}
for k0:= i0-1 downto j0 do
Vector[k0+1] := Vector [k0];
{вставка элемента}
Vector[j0] := B0;
end;
gotoxy(3,3); {Вывод результата на экран}
writeln('Отсортированный массив');
writeln;
writeln (' A = [ ');
gotoxy(9,5);
for i0 := 1 to p0 do
write (Vector[i0],' ');
write(']');
end;
{
----------------Пункт 1: файл-комментарий-------------
}
PROCEDURE Help;
CONST
nameh='help.txt'; { путь к Файлу-комментарию }
VAR
fh : text;
shet_r,r,r_str : integer;
strokarem : array[1..99]of string[65]; {Строки и столбцы файла-комментария}
chh : char;
BEGIN
{$I-}; { Режим проверки ввода-вывода отключен }
Assign(fh,nameh);
Reset(fh); { пытаемся открыть файл }
{$I+}; { Режим проверки ввода-вывода включен }
if IOResult<>0
then { Файл не найден }
begin
While KeyPressed do chh:=ReadKey;
Win(1,1,80,25,0,0);
ClrScr;
Win(15,9,66,13,4,14);
Signal;
writeln; {Вывод сообщения об ошибке}
writeln (' ОШИБКА! ');
writeln(' Файл помощи не найден или неверно указано имя ');
writeln(' Для продолжения нажмите любую клавишу ');
repeat until KeyPressed;
ClrKeyBuf;
end
else { Файл помощи найден }
begin
r:=1;
repeat { построчное считывание - цикл }
ReadLn(fh,strokarem[r]);
r:=r+1;
until SeekEOf(fh);
{ до конца }
Close(fh); { закрытие файла }
shet_r:=r-1; { определение кол-ва прочитанных строк }
{--------полоса-подсказка ------------}
clrscr;
win(1,1,80,25,1,1);
Frame(3,2,78,23,15,2);
Win(32,2,45,4,1,15);
Write(' О программе ');
Window(3,25,80,25);
TextBackGround(7);
TextColor(4);
Write(' <Esc>');
TextColor(0);
Write(' - Выход');
TextColor(4);
Write(' <Стрелки курсора,Home,End,PageUp,PageDown>');
TextColor(0);
Write(' - Листать ');
win(4,4,77,22,1,10);
r:=1;
repeat
r_str:=1;
for r_str:=1 to 18 do
begin { цикл вывода 18-ти прочитанных строк в окно-"экран" }
GoToXY(5,r_str);
WriteLn(' ');
GoToXY(5,r_str);
WriteLn(strokarem[r+(r_str-1)]);
end;
chh:=ReadKey;
if chh=Chr(0)
then
begin {Листание клавишами }
chh:=readkey;
case chh of
Chr(72): begin {Клавиша стрелка вверх}
dec(r);
if r<1 then r:=1;
end;
Chr(80): begin {Клавиша стрелка вверх}
inc(r);
if r>(shet_r-17) then r:=shet_r-17;
end;
Chr(79): begin {Клавиша End}
r:=shet_r-17;
end;
Chr(71): begin {Клавиша Home}
r:=1;
end;
Chr(81): begin {Клавиша PgDown}
r:=r+18;
if r>(shet_r-17) then r:=shet_r-17;
end;
Chr(73): begin {Клавиша PgUp}
r:=r-18;
if r<1 then r:=1;
end;
end;
end;
until chh=Chr(27); {Esc - выход}
ClrKeyBuf;
end;
ClrScr;
END;
{
----------------- Пункт 2:ввод данных с клавиатуры--------
}
PROCEDURE VKeyb;
var codi, stop: integer;
ch2: char;
begin
Codi:=1;
SetNormalCursor;
win(1,1,80,25,1,0);
Clrscr;
{repeat }
ClrScr;
TextAttr:=Norm;
Codi:=1;
middle('Ввод данных с клавиатуры',1);
GotoXY(1,3);
repeat
Write(' Введите число элементов массива n=');
ReadINT(p0,Codi); { анализируется тип вводимых данных }
if codi<>0 then
writeln (' Ошибка типа вводимых данных. Задайте новое значение:');
until (Codi=0); { тип соответствует описанному в блоке var }
Codi:=1;
writeln;
Writeln(' Введите элементы массива ');
For y0:=1 to p0 do
begin
repeat
write (' A[',y0,']=');
ReadInt(vector[y0],codi);
if Codi<>0 then writeln('Ошибка типа вводимых данных. Задайте новое значение:');
until (Codi=0)
end;
ClrScr;
window(1,1,80,25);
Assign(f,'res.txt');
Rewrite(f);
writeln(f,' Исходный массив: ');
for y0:=1 to p0 do
write(f,vector[y0],' ');
Reshenie;
writeln(f,' ');
WriteLn(f,' Сортированный массив');
for i0:=1 to p0 do
Write(f,vector[i0],' ');
writeln(f,' ');
close(f);
middle('Назад - <ESC>',24);
SetNocursor; { Выход по нажатию клавиши <ESC> }
repeat
ch2:=ReadKey;
keypressed until ch2=chr(27);
ClrKeyBuf;
end;
{
------------ Пункт 3: считывание данных из файла-----------
}
PROCEDURE VFile;
VAR
stop,codi1:integer;
ch2:char;
LABEL
METKA;
BEGIN
metka:
repeat
SetNormalCursor;
window(1,1,80,25);
TextAttr:=NORM;
ClrScr;
Middle('Считывание данных из файла',1);
GotoXY(3,3);
writeln ('Введите путь к файлу со значениями элементов массива');
gotoxy(3,5);
readln(ss);
{$I-}
Assign(inf, ss);
Reset(inf);
{$I+}
if (IOResult<>0) or (ss='')
then { Файл не найден }
begin
stop:=0;
Win(1,1,80,25,0,0);
clrscr;
Win(19,8,61,12,4,14);
Signal;
SetNoCursor;
writeln;
writeln(' Файл не найден или неверно указано имя ');
writeln(' Для продолжения нажмите любую клавишу ');
writeln(' Для выхода нажмите клавишу <ESC> ');
ch2:=readkey;
if ch2=chr(27) then exit else goto metka;
end
else { Файл найден }
begin
for y0:=1 to p0 do
begin
ReadIntM(inf, v1[y0], codi1);
if codi1<>0 then
begin
stop:=0;
Win(1,1,80,25,0,0);
clrscr;
Win(19,8,61,12,4,14);
SetNoCursor;
writeln;
writeln(' Ошибка типа данных в файле ');
writeln(' Для продолжения нажмите любую клавишу ');
writeln(' Для выхода нажмите клавишу <ESC> ');
ch2:=readkey;
if ch2=chr(27) then exit else stop:=0; {stop - флаг выхода из цикла}
goto metka;
end;
end;
end;
close(inf); {}
clrscr;
TextAttr:=Norm;
codi1:=1;
repeat
write (' Введите количество элементов n=');
readInt(p0,codi1);
if codi1<>0 then writeln (' Ошибка типа вводимых данных. Задайте новое значение:');
until (codi1=0);
codi1:=1;
reset(inf);
for y0:=1 to p0 do
Readln(inf, vector[y0]);
close(inf);
Assign(f,'res.txt');
Rewrite(f);
writeln(f,' Исходный массив: ');
for y0:=1 to p0 do
write(f,vector[y0],' ');
Reshenie;
writeln(f,' ');
WriteLn(f,' Сортированный массив');
for i0:=1 to p0 do
Write(f,vector[i0],' ');
writeln(f,' ');
close(f);
middle('Назад - <ESC>',24);
SetNocursor;
ch2:=ReadKey;
if ch2=Chr(27) then stop:=1 else stop:=0;
until stop=1; {флаг выхода из цикла}
ClrKeyBuf;
End;
BEGIN
END.
Файл ServiZZ.PAS
UNIT ServiZZ;
interface
Uses
Crt,Dos;
{------------------------------------------------------------------}
PROCEDURE Signal;
PROCEDURE SetNoCursor;
PROCEDURE SetNormalCursor;
PROCEDURE ClrKeyBuf;
PROCEDURE ReadInt(var invar:integer; var Codior:integer);
PROCEDURE Wait;
PROCEDURE WaitDos(WaitTime : word);
PROCEDURE Middle(Stroka: string; Y:integer);
PROCEDURE Frame (X1,Y1,X2,Y2,FrameColor,TypeLine : integer);
PROCEDURE ReadIntM(var fa:text; var invar:integer; var Codior:integer);
PROCEDURE Win (x1,y1,x2,y2,tb,tc:integer);
{------------------------------------------------------------------}
implementation
{ --------------------------------------------------------------------------
Процедура формирует звуковой сигнал фиксированных частоты и длительности
--------------------------------------------------------------------------- }
PROCEDURE Signal;
begin
Sound(3000); { Частота }
Delay(200); { Длительность }
NoSound;
end;
{---------------------------------------------------------------------------
Процедура отменяет курсор (делает его невидимым)
---------------------------------------------------------------------------}
PROCEDURE SetNoCursor;
VAR
Regs:registers;
CONST
c_Start=32;
c_End=0;
BEGIN
with Regs do begin
AH:=$01;
CH:=c_Start;
CL:=c_End;
end;
Intr ($10,Regs);
END;
{---------------------------------------------------------------------------
Процедура устанавливает нормальную форму курсора
---------------------------------------------------------------------------}
PROCEDURE SetNormalCursor;
VAR
SE:word;
Regs:registers;
BEGIN
if (LastMode >=Font8x8)
then
SE:=$0507
else
if (LastMode =Mono) then SE:=$0B0C
else SE:=$0607;
with Regs do begin
AH:=$01;
CH:=Hi (SE);
CL:=Lo (SE);
end;
Intr ($10,Regs);
END;
{----------------------------------------------------------------------------
Процедура очистка буфера клавиатуры
---------------------------------------------------------------------------}
PROCEDURE ClrKeyBuf;
VAR
ch : char;
BEGIN
while KeyPressed do ch := ReadKey;
END;
{ ПРОЦЕДУРА: ReadInt
-----------Процедура ввода целого числа с контролем типа "integer"-----------
---------------------Локально используется процедура Signal------------------
}
PROCEDURE ReadInt(var invar:integer; {Вводимое число}
var Codior:integer);
BEGIN
{$I-} {Режим проверки ввода-вывода отключен}
Readln(invar);
{$I+} {Режим проверки ввода-вывода включен}
Codior :=IOResult; {Codior<>0 при:вводе нецелого числа,нецифрового
символа,комбинации цифрового и нецифрового
символов,при выходе из диапазона}
if (Codior <>0) then Signal; {выдается звуковой сигнал ошибки}
END;
{----------------------------------------------------------------------------
Процедура ожидания нажатия любой клавиши.
Буфер клавиатуры очищается при входе в процедуру и при выходе из процедуры
---------------------------------------------------------------------------}
PROCEDURE Wait;
VAR
ch : char;
BEGIN
while KeyPressed do ch := ReadKey; { очистка буфура клавиатуры }
repeat until KeyPressed; { ожидание нажатия любой клавиши }
while KeyPressed do ch := ReadKey; { очистка буфура клавиатуры }
END;
{---------------------------------------------------------------------------
Процедура приостановки выполнения программы на заданный отрезок
времени в секундах (от 0 до 59).
WaitTime - число секунд приостановки выполнения
---------------------------------------------------------------------------}
PROCEDURE WaitDos(WaitTime : word);
VAR
House , { час - 0..23 }
Minute , { минута - 0..59 }
Second , { секунда - 0..59 }
Sec100 , { сотые доли секунды 0..99 }
Second_0 : word;
BEGIN
GetTime(House,Minute,Second,Sec100);
if WaitTime+Second>=59
then Second_0:=WaitTime+Second-59
else Second_0:=Second+WaitTime;
repeat
GetTime(House,Minute,Second,Sec100);
until Second=Second_0;
END;
{---------------------------------------------------------------------------
Процедура выводит "строку текста",центрируя ее на строке
Stroka - вводимая "строка текста"
Y - координата строки
Локально используются процедура WaitDos(...)
--------------------------------------------------------------------------}
PROCEDURE Middle(Stroka:string; Y:integer);
VAR
X:integer;
BEGIN
if Length(Stroka)>80
then
begin
GotoXY(18,8);
WriteLn('Текст сообщения в строке начинающийся с : ');
GotoXY(21,10);
Write('"',Copy(Stroka,1,30),'..."');
GotoXY(29,12);
Write('превысил 80 символов ! ');
GotoXY(18,14);
Write('Уменьшите длину текста на ');
Write(Length(Stroka)-80,' символов(ла)');
WaitDos(6);
Halt;
end;
X:=(80-Length(Stroka)) div(2);
GotoXY(X,Y);
WriteLn(Stroka);
END;
{---------------------------------------------------------------------------
Процедура построения рамки
X1,Y1,X2,Y2 - координаты соответственно левого верхнего и правого нижнего
углов
FrameColor - цвет рамки
TypeLine - тип рамки : 1-одинарная линия
2-двойная линия
3-"крапчатая"
4-толстая одинарная
---------------------------------------------------------------------------}
PROCEDURE Frame (X1,Y1,X2,Y2,FrameColor,TypeLine : integer);
CONST
{ --------- Коды символов псевдографики,формирующие рамку типа 1 ----------}
A1=#179; B1=#191; C1=#217;
D1=#192; E1=#218; F1=#196;
{ --------- Коды символов псевдографики,формирующие рамку типа 2 ----------}
A2=#186; B2=#187; C2=#188;
D2=#200; E2=#201; F2=#205;
{ --------- Коды символов псевдографики,формирующие рамку типа 3 ----------}
A3=#176; B3=#176; C3=#176;
D3=#176; E3=#176; F3=#176;
{ --------- Коды символов псевдографики,формирующие рамку типа 4 ----------}
A4=#219; B4=#220; C4=#219;
D4=#219; E4=#220; F4=#220;
VAR
i,j : integer;
A,B,C,D,E,F : char;
BEGIN
Case TypeLine of
1:begin
A:=A1; B:=B1; C:=C1;
D:=D1; E:=E1; F:=F1;
end;
2:begin
A:=A2; B:=B2; C:=C2;
D:=D2; E:=E2; F:=F2;
end;
3:begin
A:=A3; B:=B3; C:=C3;
D:=D3; E:=E3; F:=F3;
end;
4:begin
A:=A4; B:=B4; C:=C4;
D:=D4; E:=E4; F:=F4;
end;
end;
TextColor(FrameColor);
GotoXY(X1,Y1);
Write(E);
for i:=(X1+1) to (X2-1) do Write(F);
Write(B);
for i:=(Y1+1) to (Y2-1) do
begin
GotoXY(X1,i);
Write(A);
GotoXY(X2,i);
Write(A);
end;
GotoXY(X1,Y2);
Write(D);
for i:=(X1+1) to (X2-1) do Write(F);
Write(C);
END;
{ ПРОЦЕДУРА: ReadIntM
--------Процедура ввода целого числа из файла с контролем типа "integer"-----------
---------------------Локально используется процедура Signal------------------
}
PROCEDURE ReadIntM(var fa:text;
var invar:integer; {Вводимое число}
var Codior:integer);
BEGIN
{$I-} {Режим проверки ввода-вывода отключен}
Readln(fa, invar);
{$I+} {Режим проверки ввода-вывода включен}
Codior :=IOResult; {Codior<>0 при:вводе нецелого числа,нецифрового
символа,комбинации цифрового и нецифрового
символов,при выходе из диапазона}
if (Codior <>0) then Signal; {выдается звуковой сигнал ошибки}
END;
{ ПРОЦЕДУРА: Win
---------------------------Процедура вывода окна----------------------------
----------------Задается размер окна, цвет фона и цвет текста------------------
}
procedure win (x1,y1,x2,y2,tb,tc:integer);
begin
window (x1,y1,x2,y2);
textbackground(tb);
textcolor(tc);
clrscr;
end;
BEGIN
END.