Программа Регистратура

program Registratura;
 
uses
crt;
type
Tlocation =record
Ftown:string[15];
FStreat:string[20];
Fhouse:byte;
Fflat:byte;
end;
 
type
TChild = record
FSurname: string[15];
Loc:Tlocation;
gender:char;
KDP:word;
end;
 
var
Child: array[1..100] of TChild;
Zap: TChild;
f: file of TChild;
vibor: byte;
fami: string[30];
n, t: integer;
 
{------------------------------------------------------------------------------------}
procedure vvod;
var
i: integer;
begin
clrscr;
Assign(f, 'rebenok.dat');
rewrite(f);
Write('Введите количество детей: ');
readln(n);
for i := 1 to n do 
begin
writeln('Введите', ' ', i, ' ', 'ребенка ');
with Zap do
begin
 
write('|Введите фамилию ребенка................|- '); readln(Fsurname);
write('|Введите город...........................|- '); readln(Loc.Ftown);
write('|Введите название улицы.................|- '); readln(Loc.FStreat);
write('|Введите номер дома......................|- '); readln(Loc.Fhouse);
write('|Введите номер квартиры..................|- '); readln(Loc.Fflat);
write('|Введите пол ребенка(м/ж)................|- '); readln(gender);
write('|Введите количество дней посещения...|- '); readln(KDP);
writeln;
 
write(f, Zap);
end;
end;
close(f);
end;
{----------------------------------------------------------------------------------------}
procedure chten;
var
i: integer;
begin
clrscr;
assign(f, 'rebenok.dat');
reset(f);
i := 1;
while not (eof(f)) do 
begin
read(f, Child[i]);
writeln('____________________________________________________________________________');
writeln(i,Child[i].FSurname:15,'|',Child[i].Loc.Ftown:8,'|',Child[i].Loc.FStreat:8,'|',Child[i].Loc.Fhouse:12,'|',Child[i].Loc.Fflat:10,'|',Child[i].gender:5,'|',Child[i].KDP:3,'|');
i := i + 1;
 
end;
close(f);
 
n := i - 1;
end;
{-------------------------------------------------------------------------------------------------------------------------------------------}
procedure dobav;
var
i: integer;
begin
clrscr;
rewrite(f);
 
for i := 1 to n do
write(f, Child[i]); //Записываем в массив записей
 
Writeln('Введите ', ' ', n + 1, ' ', 'ребенка');
with Zap do
begin
write('|Введите фамилию ребенка................|- '); readln(Fsurname);
write('|Введите город...........................|- '); readln(Loc.Ftown);
write('|Введите название улицы.................|- '); readln(loc.FStreat);
write('|Введите номер дома......................|- '); readln(Loc.Fhouse);
write('|Введите номер квартиры..................|- '); readln(Loc.Fflat);
write('|Введите пол ребенка(м/ж)................|- '); readln(gender);
write('|Введите количество дней посещения...|- '); readln(KDP);
writeln;
write(f, Zap);
end;
close(f);
 
 
end;
{-------------------------------------------------------------------------------------------------------------------------------------------}
 
procedure delete;
var
i: integer;
begin
clrscr;
i := 1;
assign(f, 'rebenok.dat');
reset(f);
 
 
while not eof(f) do
begin
read(f, Child[i]);
i := i + 1
end;
 
close(f);
write('Выберите номер удаляемой записи которую вы хотите: ');
readln(n);
reset(f);
seek(f, filesize(f) - 1);{ Ставим указатель перед последним компонентом }
read(f, Child[i]);
seek(f, n - 1); { Ставим указатель перед удаляемым файлом }
write(f, Child[i]);{ Записываем конечный компонент вместо удаляемого }
{ убираем последний элемент файла }
seek(f, filesize(f) - 1);{ Ставим указатель перед последним компонентом }
 
truncate(f);{ Отсекаем последний компонент }
 
Writeln('Удаление прошло успешно!!!'); 
 
end;
{----------------------------------------------------------------------------------------------------------------------}
procedure poisk;
 
begin
clrscr;
 
write('Введите фамилию ребенка: ');
readln(fami);
reset(f);
t := 0;
while not eof(f) do
begin
read(f, Zap);
if Zap.FSurname = fami then{если фамилия совпала}
begin
t := 1;{фиксируем}
writeln('Найдент ребенок с такой фамилией!!!');
Writeln('Выводим запись');
writeln(Zap.FSurname:10,'|',Zap.Loc.Ftown:8,'|',Zap.Loc.FStreat:8,'|',Zap.Loc.Fhouse:12,'|',Zap.Loc.Fflat:10,'|',Zap.gender:5,'|',Zap.KDP:15,'|');
end;
end;
if t = 0 then writeln('Такого ребенка нету!!!');{если нет совпадений}
close(f);
end;
 
{------------------------------------------------------------------------------------------------------------------------------------------} 
procedure ill_child;
var i:integer;
min_d:integer;
maxid:integer;
begin
ClrScr;
maxid:=1;
min_d:=365;
for i:=2 to n do
begin
if (Child[i].KDP<min_d) then
begin
maxid:=i;
min_d:=Child[i].KDP;
end;
end;
if min_d=365 then writeln('Детей нет')
else
writeln('Самый больной ребенок: '+Child[maxid].FSurname);
 
end;
//---------------------------------------------------------
procedure disease;//процедура болезнь
var i,s_day_mal,s_day_dev:integer;
begin
s_day_mal:=0;
s_day_dev:=0;
 
for i:=1 to n do begin
if Child[i].gender='м' then
s_day_mal:=s_day_mal+Child[i].KDP
else s_day_dev:=s_day_dev+Child[i].KDP;
end;
if s_day_dev<s_day_mal then writeln('Девочки болеют больше');
if s_day_dev>s_day_mal then writeln('Мальчики болеют больше');
if s_day_dev=s_day_mal then writeln('Девочки и мальчики болеют одинаково');
end;
procedure streat;
var str:string[35];
i:integer;
Key:boolean;
begin
Write('Введите название улицы: ');
Readln(str);
//Key:=true;
for i:=1 to n do 
 
if Pos(Child[i].Loc.FStreat,str)>0 then
begin 
writeln(Child[i].FSurname);
Key:=true;
end;
if (Key=false)or(Pos(Child[i].Loc.FStreat,str)<>0)then 
begin
writeln('Дети не проживают на этой улице');
end;
end;
begin
repeat
Writeln('Выбор действия');
Writeln('1-Ввод новых данных');
Writeln('2-Чтение данных');
Writeln('3-Добавление записей');
Writeln('4-Удаление записи');
Writeln('5-Поиск информации');
Writeln('6-Самый больной ребенок');
Writeln('7-Кто больше болеет - мальчики или девочки');
writeln('8-Cписок детей, проживающих на заданной улице');
writeln('9-Выход');
readln(vibor);
case vibor of
1: vvod;
2: chten;
3: dobav;
4: delete;
5: poisk;
6: ill_child;
7:disease;
8:streat;
9:begin
writeln('Нажмите Enter для выхода');
Readln;
exit;
end
else 
begin
writeln('Нажмите Enter и повторите ваш ввод');
Readln; end;
end
until (vibor=9);
 
 
end.