old/PAS/!SPbSTU/5th/BINTREE.PAS

Program BinTree;
{�ணࠬ¬  ¤«ï £¥­¥à æ¨¨, ¬®¤¨ä¨æ¨à®¢ ­¨ï, ®â®¡à ¦¥­¨ï ¡¨­ à­®£® ¤¥à¥¢  ¯®¨áª .}
Uses CRT;
type
 PTree = ^TTree;
 TTree = record
   key  : integer;
   L, R : PTree;
 end;
{-------------------------}
Procedure Add(aKey : integer; var aP : PTree);
begin
  if aP = nil then
   begin
    New(aP);
    with aP^ do
     begin
      key := aKey;
      l:=nil;
      r:=nil;
     end;
   end
  else
   begin
     if aKey > aP^.Key then Add(aKey,aP^.R) else
     if aKey < aP^.Key then Add(aKey,aP^.L);
   end;
end;{Add}
{-------------------------}
Procedure Delete( aKey : integer; var aP:PTree);
var
 q : PTree;
{-}
 procedure Del(var aP:PTree);
 begin
   if aP^.R <> nil then Del(aP^.R)
   else
    begin
      q^.Key := aP^.Key;
      q := aP;
      aP := aP^.L;
    end;
 end;
{}
begin
 if aP = nil then WriteLn('�«-â  ',aKey, ' ­¥â ¢ ¤¥à¥¢¥!') else
 if aKey > aP^.Key then Delete(aKey,aP^.R) else
 if aKey < aP^.Key then Delete(aKey,aP^.L) else
  begin
   q := aP;
   if q^.L = nil then aP := q^.L else
   if q^.R = nil then aP := q^.R else Del(q^.L);
   Dispose(q);
  end;
end;{Delete}
{----------------------------}
Procedure DelAll(var r : PTree);
begin
 if r <> nil then begin
  if (R^.L = nil ) and (R^.R = nil ) then
  begin
   Dispose(r);
   r:=nil;
  end
  else
   begin
    DelAll(r^.L);
    DelAll(r^.R);
    Dispose(r);
    r:=nil;
   end;
  end;
end;
{-----------------------}
Procedure Draw(P:PTree; x , h : word);
var
 i : byte;
begin
  GotoXY(x, 1 + h * 2);
  Write(P^.Key:2);
  if P^.L <> nil then
  begin
    GotoXY(x - (1 shl (4-h))+1,2+h*2);
    Write(#218);
    for i:=1 to (1 shl (4-h)-2) do Write(#196);
    Write(#217);
    Draw(P^.L, x - (1 shl (4-h)), h+1);
  end;
  if P^.R <> nil then
  begin
    GotoXY(x+1,2+h*2);
    Write(#192);
    for i:=1 to (1 shl (4-h)-2) do Write(#196);
    Write(#191);
    Draw(P^.R, x + (1 shl (4-h)), h+1);
  end;
end; {Draw}
{-------------------}
var
  c : integer;
  INP : TEXT;
  root : PTree;
begin
  Assign(INP,'treeval.txt');
  Reset(INP);
  root := nil;
  while (NOT EOF(INP)) do
  begin
   Read(INP,c);
   Add(c,Root);
  end;
  ClrScr;
  Draw(root,40,0);
  GotoXY(1,24);
  Write('‚¢¥¤¨â¥ ª®£® 㤠«¨âì: ');
  Read(c);
  Delete(c,root);
  ClrScr;
  Draw(root,40,0);
  ReadLn;
  ReadLn;
  DelAll(Root);
end.