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.