Программа
USES Crt; { Подключение модуля Crt }
VAR Exit:boolean; { Флаг "Выход" }
FUNCTION Menu:byte; { Функция вывода меню и получения ответа }
Const QuantityMenuPoint=6; { Количество пунктов меню }
ExitPoint=QuantityMenuPoint; { Пункт меню "Выход" }
MaxLengthMenuPoint=53; { Максимальная длина пункта меню }
MenuList:array[1..QuantityMenuPoint] of string[MaxLengthMenuPoint] =
('[1] Создание базы ',
'[2] Просмотр базы ',
'[3] Поиск игрушек для возраста от 1 до 3 лет ',
'[4] Поиск самых дорогих игрушек ',
'[5] Поиск игрушек по ценовому и возрастному критериям',
'[6] ВЫХОД ');
Var MenuMeter,i:integer; { Счетчики }
Point:integer; { Текущий пункт меню }
X_Left,Y_Left,X_Right,Y_Right:Byte; { Координаты окна }
Begin
ClrScr; { Очистка экрана }
TextBackground(Blue); { Установка цвета фона }
TextColor(Yellow); { Установка цвета тона }
{ Расчет координат окна: }
X_Left:=39-MaxLengthMenuPoint div 2;
X_Right:=X_Left+MaxLengthMenuPoint+1;
Y_Left:=(25-QuantityMenuPoint) div 2-1;
Y_Right:=Y_Left+QuantityMenuPoint+2;
Window(X_Left,Y_Left,X_Right,Y_Right); { Задание размеров окна }
{ Прорисовка рамки и меню: }
Write('╔');
for i:=1 to MaxLengthMenuPoint do Write('═');
Write('╗');
for MenuMeter:=1 to QuantityMenuPoint do Write('║',MenuList[MenuMeter],'║');
{ Цикл прорисовки меню }
Write('╚');
for i:=1 to MaxLengthMenuPoint do Write('═');
Write('╝');
repeat { Цикл чтения клавиатуры }
Point:=Ord(ReadKey); { Чтение клавиатуры }
if Point<>27 { Если нажатая клавиша не Esc, }
then Point:=Point-Ord('0') { то - вычисление введенного пункта меню }
else Point:=ExitPoint { иначе - переопределение пункта под "Выход" }
until (0<Point) and (Point<=QuantityMenuPoint);
{ Выход из цикла при пролучении корректного ответа }
{ Определение значения функции: }
if Point=ExitPoint then Menu:=255
else Menu:=Point;
Window(1,1,80,25); { Востановление размеров окна }
NormVideo; { Востановление первоночальных атрибутов текста }
ClrScr { Очистка экрана }
End;
PROCEDURE Stop; { Процедура остановки программы до нажатия клавиши }
Var Ch:char; { Переменная для чтения клавиатуры }
Begin
GoToXY(32,25); { Позиционирование курсора }
Write('НАЖМИТЕ КЛАВИШУ'); { Вывод приглашения нажать клавишу }
while KeyPressed do Ch:=ReadKey; { Цикл чтения (сброса) символов из буфера }
Ch:=ReadKey; { Чтение символа ( ожидание нажатия ) }
while KeyPressed do Ch:=ReadKey; { Цикл чтения (сброса) символов из буфера }
End;
CONST BaseNameFile='TOY.DAT'; { Имя файла базы игрушек }
TYPE ToyType=record { Тип - Игрушка }
Name:string[10]; { Название }
Quantity:integer; { Количество }
Age:record { Возрастные границы }
Lo,Hi:byte
end;
Cost:integer { Цена }
end;
Base=file of ToyType; { Тип файловой переменной }
VAR F:base; { Файловая переменная }
X:integer; { Максимальная цена искомых игрушек }
A,B:byte; { Возрастные границы искомых игрушек }
PROCEDURE CreateBase(var F:Base); { Процедура создания базы }
Var Toy:ToyType; { Буферная переменная - Игрушка }
i:integer; { Счетчик цикла }
Begin
Randomize; { Инициализация генератора случайных чисел }
Assign(F,BaseNameFile); { Связывание файловой переменной с именем файла }
Rewrite(F); { Открытие файла (создание) }
for i:=1 to Random(25) do { Цикл создания базы }
begin
with Toy do { Определение полей записи Toy }
begin
Str(i,Name); { Определение названия игрушки значением счетчика }
Quantity:=Random(99)+1; { Определение количества }
{ Определение возрастного диапазона: }
Age.Lo:=Random(13)+1;
Age.Hi:=Age.Lo * 6 div 5 + 1;
Cost:=Random(1000)+1; { Определение цены }
end;
Write(F,Toy) { Запись в файл }
end;
Close(F) { Закрытие файла }
End;
PROCEDURE ViewBase(var F:Base); { Процедура просмотра базы }
Var Toy:ToyType; { Буферная переменная - Игрушка }
i:integer; { Счетчик }
Begin
{ Шапка таблицы: }
WriteLn('БАЗА ИГРУШЕК:');
WriteLn('╔════════════╤═══╤═════════════╤══════╗╔════════════╤═══╤═════════════╤══════╗');
WriteLn('║Наименование│Кол│ Возраст │ Цена ║║Наименование│Кол│ Возраст │ Цена ║');
WriteLn('╠════════════╪═══╪═════════════╪══════╣╠════════════╪═══╪═════════════╪══════╣');
Assign(F,BaseNameFile); { Связывание файловой переменной с именем файла }
Reset(F); { Открытие файла (чтение) }
while not EOF(F) do { Цикл просмотра базы }
begin
for i:=1 to 2 do { Цикл вывода пары записей }
begin
if not EOF(F) { Если не достигнут конец файла }
then begin { то чтение из файла и вывод записи }
Read(F,Toy); { Чтение из файла }
with Toy do { Вывод полей записи Toy }
Write('║ ',Name:10,' │ ',Quantity:2,'│ от ',Age.Lo:2,' до ',Age.Hi:2,' │ ',Cost:4,' ║')
end
else Write('║ │ │ │ ║') { иначе - вывод пустой строки }
end;
WriteLn { Завершение строки }
end;
Close(F); { Закрытие файла }
WriteLn('╚════════════╧═══╧═════════════╧══════╝╚════════════╧═══╧═════════════╧══════╝') { Закрытие таблицы }
End;
PROCEDURE GetAgeToy(var F:Base; Lo,Hi:byte);
{ Процедура вывода игрушек подходящих по возрасту }
Var Toy:ToyType; { Буферная переменная - Игрушка }
Flag:boolean; { Флаг - подходящая по возрасту игрушка найдена }
Begin
Assign(F,BaseNameFile); { Связывание файловой переменной с именем файла }
Reset(F); { Открытие файла (чтение) }
Flag:=FALSE; { Сброс флага }
Write('Игрушки подходящие для возраста от ',Lo,' до ',Hi,' лет');
{ Вывод заголовка списка }
while not EOF(F) do { Цикл просмотра базы }
begin
Read(F,Toy); { Чтение компоненты файла }
if (((Lo<=Toy.Age.Hi)and(Toy.Age.Hi<=Hi))or((Lo<=Toy.Age.Lo)and(Toy.Age.Lo<=Hi))) then
begin { Проверка соответствия игрушки возрастным границам }
if Flag { Если игрушки найдены раньше }
then Write(', ') { то вывод разделителя имен }
else begin { иначе }
Write(': '); { вывод ':' }
Flag:=TRUE { подъем флага }
end;
Write(Toy.Name) { Вывод названия игрушки }
end
end;
if Flag then WriteLn('.') { Если игрушки найдены то завершение списка }
else WriteLn(' не найдены.'); { иначе вывод сообщения об отсутствии игрушек }
Close(F) { Закрытие файла }
End;
PROCEDURE GetDearToy(var F:Base); { Процедура вывода самых дорогих игрушек }
Var Toy:ToyType; { Буферная переменная - Игрушка }
MaxCost:integer; { Цена наиболее дорогой игрушки }
Begin
MaxCost:=0; { Сброс цены }
Assign(F,BaseNameFile); { Связывание файловой переменной с именем файла }
Reset(F); { Открытие файла (чтение) }
while not EOF(F) do { Цикл просмотра файла }
begin
Read(F,Toy); { Чтение компоненты файла }
if Toy.Cost>MaxCost then MaxCost:=Toy.Cost
{ Если цена игрушки превосходит максимальную цену
предыдущих игрушек то переопределение максимальной цены }
end;
if MaxCost>0 { Если игрушки найдены, }
then begin { то поиск игрушек по цене }
Write('Самые дорогие игрушки (цена ',MaxCost,' р.): ');
Seek(F,0); { Установка указателя на начало файла }
while not EOF(F) do { Цикл просмотра файла }
begin
Read(F,Toy); { Чтение компоненты файла }
if Toy.Cost=MaxCost then Write(Toy.Name,', ') { Если прочитанная
запись соответствует по цене, то вывод названия игрушкии }
end;
WriteLn(#8,#8,'.')
{ Затирание последнего пробела, запятой и вывод точки }
end
else WriteLn('Самых дорогих игрушек нет.');
{ иначе вывод сообщения об отсутствии игрушек }
Close(F) { Закрытие файла }
End;
PROCEDURE GetSuitableToy(var F:Base; X:integer; Lo,Hi:byte);
{ Процедура вывода игрушек подходящих по возрасту и цене }
Var Toy:ToyType; { Буферная переменная - Игрушка }
Flag:boolean; { Флаг - подходящая по возрасту игрушка найдена }
Begin
Assign(F,BaseNameFile); { Связывание файловой переменной с именем файла }
Reset(F); { Открытие файла (чтение) }
Flag:=FALSE; { Сброс флага }
Write('Игрушки для возраста от ',Lo,' до ',Hi,' с ценой до ',X,' р.');
{ Вывод заголовка списка }
while not EOF(F) do { Цикл просмотра базы }
begin
Read(F,Toy); { Чтение из файла }
if (((Lo<=Toy.Age.Hi)and(Toy.Age.Hi<=Hi))or((Lo<=Toy.Age.Lo)and(Toy.Age.Lo<=Hi)))and(Toy.Cost<=X)
then begin { Проверка соответствия игрушки возрастным и ценовым границам }
if Flag { Если игрушки найдены раньше }
then Write(', ') { то вывод разделителя имен }
else begin { иначе }
Write(': '); { вывод ':' }
Flag:=TRUE { подъем флага }
end;
Write(Toy.Name) { Вывод названия игрушки }
end
end;
if Flag then WriteLn('.') { Если игрушки найдены то завершение списка }
else WriteLn(' не найдены.'); { иначе вывод сообщения об отсутствии игрушек }
Close(F) { Закрытие файла }
End;
BEGIN
Exit:=FALSE; { Сброс флага "Выход" }
repeat
case Menu of { Выбор действия по ответу на меню }
1:begin { Создание базы }
CreateBase(F); { Создание базы }
ViewBase(F); { Просмотр базы }
Stop { Остановка программы }
end;
2:begin
ViewBase(F); { Просмотр базы }
Stop { Остановка программы }
end;
3:begin
ViewBase(F); { Просмотр базы }
GetAgeToy(F,1,3); { Поиск игрушек по возрастному критерию }
Stop { Остановка программы }
end;
4:begin
ViewBase(F); { Просмотр базы }
GetDearToy(F); { Поиск игрушек по ценовому критерию }
Stop { Остановка программы }
end;
5:begin
ViewBase(F); { Просмотр базы }
{ Ввод ценового и возрастного критерия для поиска игрушек: }
Write('Введите максимальную цену игрушки '); ReadLn(X);
Write('Введите нижнюю возрастную границу '); ReadLn(A);
Write('Введите вехнюю возрастную границу '); ReadLn(B);
GetSuitableToy(F,X,A,B);{ Поиск игрушек по ценовому и возрастному критериям }
Stop { Остановка программы }
end;
255:Exit:=TRUE { Подъем флага "Выход" }
end
until Exit;
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию