Программа
USES Crt; { Подключение модуля Crt }
CONST FileName='DATA'; { Имя файла с данными }
TYPE SubscriberType=record { Тип абонент }
Number:integer;
FamilyName:string[10];
Address:record
Street:string[10];
house:integer;
Apart:integer
end;
NewReading:real;
OldReading:real;
Tariff:real
end;
VAR Exit:boolean; { Флаг "Выход" }
TextAttrBuf:Byte; { Переменная для сохранения атрибутов текста }
Subscriber:SubscriberType; { Абонент }
F:file of SubscriberType; { Файл абонентов }
FUNCTION Question(S:string):boolean; { Функция получения ответа на вопрос }
Var Ch:char; { Буфер }
Begin
Write(S,' [Y/N] '); { Вывод вопроса }
repeat
Ch:=ReadKey { Чтение нажатия клавиши }
until Ch in ['Y','y','N','n'];
{ Выход из цикла при получении коректного ответа }
Question:=Ch in ['Y','y'];
WriteLn(Ch)
End;
FUNCTION Menu:byte; { Функция вывода меню и получения ответа }
Const QuantityMenuPoint=3; { Количество пунктов меню }
ExitPoint=QuantityMenuPoint; { Пункт меню "Выход" }
Point:byte=ExitPoint; { Текущий пункт меню }
MaxLengthMenuPoint=17; { Максимальная длина пункта меню }
{ Положение верхнего левого угла меню: }
XStart=(80-MaxLengthMenuPoint) div 2 -2;
YStart=(24-QuantityMenuPoint) div 2 -1;
MenuList:array[1..QuantityMenuPoint] of string[MaxLengthMenuPoint] =
('Создание файла ',
'Вывод стоимости ',
'ВЫХОД ');
Var ExitMenu:boolean; { Флаг "Выход" }
MenuMeter:integer; { Счетчик }
Procedure PointON(Point:byte); { Процедура подсветки пункта меню }
begin
TextAttr:=White; { Установка белого цвета }
GoToXY(XStart+1,YStart+Point); { Позиционирование курсора }
Write(#16,MenuList[Point],#17); { Вывод пункта меню с указателями }
TextAttr:=LightGray; { Установка серого цвета }
end;
Procedure PointOFF(Point:byte); { Процедура гашения пункта меню }
begin
TextAttr:=LightGray; { Установка серого цвета }
GoToXY(XStart+1,YStart+Point); { Позиционирование курсора }
Write(' ',MenuList[Point],' ') { Вывод пункта меню }
end;
Begin
ClrScr; { Очистка экрана }
begin { Вывод статус строки: }
GoToXY(8,25); { Позиционирование курсора }
TextAttr:=White;
Write(#24,#25);
TextAttr:=LightGray;
Write(' Выбор пункта меню');
TextAttr:=White;
GoToXY(38,25); { Позиционирование курсора }
Write(#17,#196,#217);
TextAttr:=LightGray;
Write(' Активизация выбранного пункта');
ExitMenu:=FALSE { Сброс флага "Выход" }
end;
begin { Прорисовка меню: }
GoToXY(XStart,YStart); { Позиционирование курсора }
Write('╔');
for MenuMeter:=1 to MaxLengthMenuPoint+2 do Write('═');
Write('╗');
for MenuMeter:=1 to QuantityMenuPoint do
begin
GoToXY(XStart,YStart+MenuMeter);
Write('║ ',MenuList[MenuMeter],' ║')
end;
GoToXY(XStart,YStart+QuantityMenuPoint+1);
Write('╚');
for MenuMeter:=1 to MaxLengthMenuPoint+2 do Write('═');
Write('╝');
end;
PointON(Point); { Подсветить пункт меню }
repeat
case ReadKey of
#72:begin
PointOFF(Point); { Погасить пункт меню }
{ Переопределение пункта меню: }
begin
Point:=Point-1;
if Point<1 then Point:=QuantityMenuPoint
end;
PointON(Point); { Подсветить пункт меню }
end;
#80:begin
PointOFF(Point); { Погасить пункт меню }
{ Переопределение пункта меню: }
begin
Point:=Point+1;
if Point>QuantityMenuPoint then Point:=1
end;
PointON(Point); { Подсветить пункт меню }
end;
#13:begin
ExitMenu:=TRUE; { Подъем флага "Выход" }
Menu:=Point
end;
#27:begin
ExitMenu:=TRUE; { Подъем флага "Выход" }
Menu:=ExitPoint
end
end
until ExitMenu
End;
FUNCTION UpCaseStr(S:String):string;
{ Функция перевода строчных букв строки в прописные }
Var SBuf:string; { Буферная переменная }
Meter:byte; { Счетчик }
Begin
SBuf:=''; { Сброс буфера }
for Meter:=1 to Length(S) do SBuf:=SBuf+UpCase(S[Meter]);
{ Цикл преобразования букв }
UpCaseStr:=Sbuf { Определение значения функции }
End;
PROCEDURE MakeFile;
Begin
ClrScr; { Очистка экрана }
Rewrite(F); { Открытие файла под запись }
while Question('Создать запись?') do
begin
with Subscriber do
begin
Write('Введите номер абонента ');
ReadLn(Number);
Write('Введите фамилию ');
ReadLn(FamilyName);
FamilyName:=UpCaseStr(FamilyName);
{ Перевод строчных букв в прописные }
WriteLn('Введите адрес: ');
with Address do
begin
Write(' улица ');
ReadLn(Street);
Write(' дом ');
ReadLn(house);
Write(' квартира ');
ReadLn(Apart);
end;
Write('Введите показание счетчика ');
ReadLn(NewReading);
Write('Введите предыдущее показание');
ReadLn(OldReading);
Write('Введите тариф ');
ReadLn(Tariff)
end;
Write(F,Subscriber);
end;
Close(F) { Закрытие файла }
End;
PROCEDURE ProcessFile;
Var Fam:string[10]; { Искомая фамилия }
FamIsFinding:boolean; { Флаг "Фамилия - найдена" }
Begin
repeat
ClrScr; { Очистка экрана }
Reset(F); { Открытие файла под чтение }
{ Ввод искомой фамилии: }
Write('Введите фамилию ');
ReadLn(Fam);
Fam:=UpCaseStr(Fam); { Перевод строчных букв в прописные }
FamIsFinding:=FALSE; { Сброс флага }
while not FamIsFinding and not EOF(F) do
begin
Read(F,Subscriber); { Чтение записи из файла }
FamIsFinding:=Subscriber.FamilyName=Fam
{ Сравнивание фамилии в записи с искомой фамилией }
end;
if FamIsFinding then
with Subscriber do
begin
Write('Номер абонента ');
WriteLn(Number);
Write('Фамилия ');
WriteLn(FamilyName);
WriteLn('Адрес: ');
with Address do
begin
Write(' улица ');
WriteLn(Street);
Write(' дом ');
WriteLn(house);
Write(' квартира ');
WriteLn(Apart);
end;
Write('Показание счетчика ');
WriteLn(NewReading);
Write('Предыдущее показание');
WriteLn(OldReading);
Write('Тариф ');
WriteLn(Tariff);
WriteLn('Стоимость: ',
(OldReading-NewReading)*Tariff)
end
else WriteLn('Фамилия ненайдена');
Close(F) { Закрытие файла }
until Question('Выйти в меню?');
End;
BEGIN
TextAttrBuf:=TextAttr; { Сохранение начальных атрибутов текста }
Exit:=FALSE; { Сброс флага "Выход" }
Assign(F,FileName); { Связывание файловой переменной с именем файла }
repeat
case Menu of { Выбор действия по ответу на меню }
1:MakeFile; { Создание файла }
2:ProcessFile; { Обработка файла }
3:Exit:=TRUE { Подъем флага "Выход" }
end
until Exit;
TextAttr:=TextAttrBuf; { Востановление начальных атрибутов текста }
ClrScr { Очистка экрана }
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию