Дан список.Необходимо сформировать бинарное дерево, упорядоченное по возрасту, вывести инфу о клиентах старше указанного возраста. (список клиентов клиники : город, диагноз, возраст)
{$D+,L+}
uses crt;
type pat=record
n:integer;
c,d,fam:string[25];
end;
patptr=^patdin;
patdin=record
dat:pat;
next:patptr;
end;
var fpat:file of pat;
first:patptr;
st:pat;
Procedure Createfile; {ᮧ¤ ЁҐ д ©« }
var sym:char;
i:integer;
begin
clrscr;
rewrite(fpat);
repeat
with st do
begin
write('‚®§а бв - ');
readln(n);
write('” ¬Ё«Ёп - ');
readln(fam);
write('„Ё Ј®§ - ');
readln(d);
write('ѓ®а®¤ - ');
readln(c);
end;
write(fpat,st);
write('Џа®¤®«¦Ёвм ? [„/Ќ]');
readln(sym);
until sym in ['','Ќ'];
close(fpat);
end;
Procedure List_Create(var first:patptr); {ᮧ¤ ЁҐ Ґ®вб®авЁа®ў ®Ј® бЇЁбЄ
б ¤®Ў ў«ҐЁҐ¬ н«Ґ¬Ґв®ў ў Є®Ґж бЇЁбЄ }
var tek,last:patptr;
begin
reset(fpat);
first:=nil;
last:=nil;
while not(eof(fpat)) do
begin
new(tek); {ўл¤Ґ«ҐЁҐ Ї ¬пвЁ}
read(fpat,tek^.dat);
{з⥨Ґ Ёд®а¬ жЁЁ Ё§ д ©« Ё а §¬ҐйҐЁҐ ҐҐ ў Ї®«Ґ dat н«-в бЇЁбЄ }
tek^.next:=nil;
if first=nil
then first:=tek
else last^.next:=tek;
last:=tek;
end;
end;
Procedure Sort_List_Create(var first:patptr);
{ᮧ¤ ЁҐ ®б®авЁа бЇЁбЄ }
var tek,tek1,pred:patptr;
begin
reset(fpat);
first:=nil;
while not(eof(fpat)) do
begin
new(tek); {ўл¤Ґ«ҐЁҐ Ї ¬пвЁ}
read(fpat,tek^.dat);
tek^.next:=nil;
if first=nil
then first:=tek
else
begin
tek1:=first; {Ї®ЁбЄ ¬Ґбв ¤«п ўбв ўЄЁ}
pred:=nil;
while (tek1<>nil) and
(tek^.dat.fam>tek1^.dat.fam) do
begin
pred:=tek1;
tek1:=tek1^.next;
end;
if tek1=first then {ўбв ўЄ ў з «®}
begin
tek^.next:=first;
first:=tek;
end
else {ўбв ўЄ Ї®б«Ґ pred}
begin
tek^.next:=pred^.next;
pred^.next:=tek;
end;
end;
end;
end;
Procedure Print(first:patptr); {Їа®жҐ¤га ўлў®¤ бЇЁбЄ нЄа }
var i:integer;
tek:patptr;
begin
clrscr;
tek:=first;
while tek<>nil do
begin
with tek^.dat do
begin
write(n:3,' ',fam,' ':20-length(fam),' ',d:15,' ',c);
writeln;
end;
tek:=tek^.next {ЇҐаҐе®¤ Є б«Ґ¤ н«Ґ¬Ґвг}
end;
writeln;
writeln('Ќ ¦¬ЁвҐ ENTER');
readln;
end;
Procedure DeleteList(var first:patptr);
{г¤ «ҐЁҐ бЇЁбЄ }
var tek:patptr;
begin
while first<>nil do
begin
tek:=first;
first:=first^.next;
dispose(tek);
end;
end;
Procedure Del(var first:patptr); {“¤ «ҐЁҐ н«Ґ¬Ґв }
var fam:string;
tek,pred:patptr;
begin
writeln('‚ўҐ¤ЁвҐ ” ¬Ё«Ёо ¤«п г¤ «ҐЁп');
readln(fam);
tek:=first;
while tek<>nil do
if tek^.dat.fam=fam then
begin
if tek=first
then first:=tek^.next
else pred^.next:=tek^.next;
dispose(tek);
exit
end
else begin
pred:=tek;
tek:=tek^.next
end;
writeln('” ¬Ё«Ёп ',fam,' Ґ ©¤Ґ ');
end;
begin
assign(fpat,'pat.dat');
{$I-}
reset(fpat);
{$I+}
if IOresult<>0 then
Createfile;
List_Create(first);
writeln('*************************************');
writeln(' Ќ…Ћ’‘Ћђ’?ђЋ‚ЂЌЌ›‰ ‘Џ?‘ЋЉ ');
print(first);
writeln('*************************************');
deletelist(first);
Sort_List_Create(first);
writeln('*************************************');
writeln(' Ћ’‘Ћђ’?ђЋ‚ЂЌЌ›‰ ‘Џ?‘ЋЉ ');
print(first);
writeln('*************************************');
del(first);
writeln('*************************************');
writeln(' Ћ’ЉЋђђ…Љ’?ђЋ‚ЂЌЌ›‰ ‘Џ?‘ЋЉ ');
print(first);
writeln('*************************************');
deletelist(first);
end.
Извините русские буквы не отображаются
Как строить это самое дерево.
Помогите пожалуйста с написание программы.
Сообщение отредактировано: cooler -