Деревья, нужно построить Опции

[cooler]

Здравствуйте товарищи программисты.

Дан список.Необходимо сформировать бинарное дерево, упорядоченное по возрасту, вывести инфу о клиентах старше указанного возраста. (список клиентов клиники : город, диагноз, возраст)

Код

program spisok_patientov;
{$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 - 16.05.2007 18:58