Бинарное упорядоченное дерево

interface 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ComCtrls, StdCtrls, Buttons; 

type

  TInfo = Integer;

  PItem = ^Item;

  Item = Record

     Key: TInfo;

     Left, Right: PItem;

  end; 

  TForm1 = class(TForm)

    TreeView: TTreeView;

    ButtonOfAdd: TButton;

    ComboBoxOfAdd: TComboBox;

    ButtonOfDel: TButton;

    EditOfDel: TEdit;

    ButtonOfCheck: TButton;

    EditOfCheck: TEdit;

    ButtonOfExit: TBitBtn;

    ButtonOfFind: TButton;

    EditOfFind: TEdit;

    procedure ButtonOfAddClick(Sender: TObject);

    procedure Prosmotr(P:PItem;Item:TTreeNode);

    procedure ButtonOfDelClick(Sender: TObject);

    procedure ButtonOfCheckClick(Sender: TObject);

    procedure ButtonOfExitClick(Sender: TObject);

    procedure FormActivate(Sender: TObject);

    procedure ButtonOfFindClick(Sender: TObject);

    procedure EditOfFindClick(Sender: TObject);

    private

      { Private declarations }

    public

      { Public declarations }

  end; 

  TTree = class

    private

      Root:PItem;

   public

      constructor Create;

      procedure Add (var p:PItem; Key:TInfo);

      procedure Del (var P:PItem; Key:TInfo);

      function Check (var P:PItem):String;

      function Find (key:Tinfo):ShortInt;

      destructor Destroy (P: PItem);

  end; 

var

  Form1: TForm1;

  Tree: TTree;

  Key: TInfo; 
 

implementation

constructor TTree.Create;

   begin

     Root := nil;

end;

procedure TTree.Add(var p:PItem;Key: TInfo); // Процедура добавляет элемент

 // в дерево

begin

  if p=Nil then // Если узел пуст

     begin

         New(p); // создаем новый узел

          p^.Left:=nil; // Левый указатель на Nil

         p^.Right:=nil; // Правый указателт на Nil

         p^.key:=key;

     end

  else // Если узал не пуст, то

     if key<p^.key then // Если доб. элемент меньше

       Add(p^.Left,key) // Добавляем его слева

     еlse // Если больше

        Add(p^.Right,key); // Добавляем справа

end; 

procedure TTree.Del(var P:PItem; Key: TInfo); // Удаление узла

  var Q: PItem; 

     procedure Delete(var R: PItem);

     // процедура удаляет узел имеющий двух потомков, заменяя его на самый правый

     // узел левого поддерева

     begin

       if R^.Right <> nil then // обойти дерево справа

         Delete(R^.Right)

        else begin

         // дошли до самого правого узла

         // заменить этим узлом удаляемый

         Q^.Key := R^.Key;

         Q := R;

         R := R^.Left;

       end;

     end; // Delete 

begin // Del

    if P <> nil then // искать удаляемый узел

      if Key < P^.Key then // Если Уд.Элемент меньше

        Del(P^.Left, Key) // Искать в левом поддереве

      else // Если больше

        if Key > P^.Key then

          Del(P^.Right, Key) // искать в правом поддереве

        else begin

          // узел найден, надо его удалить

          // сохранить ссылку на удаленный узел

          Q := P;

          if Q^.Right = nil then

            // справа nil

            // и ссылку на узел надо заменить ссылкой на этого потомка

            P := Q^.Left

          else

            if Q^.Left = nil then

              // слева nil

              // и ссылку на узел надо заменить ссылкой на этого потомка

              P := P^.Right

            else // узел имеет двух потомков

              Delete(Q^.Left);

          Dispose(Q);

        end;

end; 

procedure TForm1.Prosmotr(P:PItem;Item:TTreeNode); // Просмотр дерева

  var

    TmpItem:TTreeNode;

begin

   if P <> nil then

      begin

         TmpItem:=TreeView.Items.AddChild(Item,IntToStr(P^.Key));

         Prosmotr(P^.Left,TmpItem);

         Prosmotr(P^.Right,TmpItem);

         TreeView.FullExpand;

      end;

end; 

function TTree.Check(var P:PItem):String; // Проверяет, есть ли в дереве

  var //одинаковые элементы

    i,n:byte; Elem,Str:String; 

  function Recording(P:PItem):String; // Записивает все элементы дерева в строку

      begin

        if P<>nil then

          Recording:=Recording(p^.Left)+IntToStr(p^.key)+' '+Recording(p^.Right)

      end; 

begin // Check

  n:=0;

  Str:=Recording(Root);

  i:=Pos(' ',Str);

  while i<>0 do

   begin

     Elem:=Copy(Str,1,i);

     n:=n+Pos((' '+Elem),Str);

     Delete(Str,1,i);

     i:=Pos(' ',Str);

   end;

  if n<>0 then

    Check:='В  дереве есть одинаковые элементы'

    else

    Check:='В  дереве нет одинаковых элементов';

end;

function TTree.Find(key:Tinfo):ShortInt; // Функция ноходит в дереве длину пути

  var n:shortint;//от корня до ближайшей вершины с заданным значением 

  procedure Search(var p:PItem;x:Tinfo);

   begin

     if p=nil then n:=-1

       else

        if x=p^.Key then n:=n+1

         else

           if x>p^.Key then

             begin

               n:=n+1;

               Search(p^.right,x);

             end

           else

            begin

              n:=n+1;

              Search(p^.Left,x);

           end;

   end;//Search 

begin//Find

  n:=-1;

  Search(Root,key);

  Find:=n;

end;

destructor TTree.Destroy(P: PItem); // Удаляет узел и всех его потомков в дереве

 begin

    if P <> nil then begin

      if P^.Left <> nil then

        Destroy(P^.Left);

      if P^.Right <> nil then

        Destroy(P^.Right);

      Dispose(P);

    end;

end; 

{$R *.dfm} 
 

procedure TForm1.ButtonOfAddClick(Sender: TObject); // Добавить элемент

var

  Item:TTreeNode;

begin

  Item:=nil;

  Key:=StrToInt(ComboBoxOfAdd.Text);

  Tree.Add(Tree.Root,Key);

  TreeView.Items.Clear;

  Prosmotr(Tree.Root,Item);

end;

procedure TForm1.ButtonOfDelClick(Sender: TObject); // Удалить элемент

  var

   Item:TTreeNode;

begin

  Item:=nil;

  Key:=StrToInt(EditOfDel.Text);

  Tree.Del(Tree.Root,Key);

  EditOfDel.Clear;

  TreeView.Items.Clear;

  Prosmotr(Tree.Root,Item);

end; 

procedure TForm1.ButtonOfCheckClick(Sender: TObject); // Проверка

begin

EditOfCheck.Text:=Tree.Check(Tree.Root)

end; 

procedure TForm1.ButtonOfExitClick(Sender: TObject); // Выход

begin

Close;

Tree.Destroy(Tree.Root);

end; 
 
 

procedure TForm1.FormActivate(Sender: TObject); // Инициализация дерева

begin

Tree:= TTree.Create;

end; 

procedure TForm1.ButtonOfFindClick(Sender: TObject); // Поиск

begin

key:=StrToInt(EditOfFind.Text);

EditOfFind.Text:=FloatToStr(Tree.Find(key));

end; 

procedure TForm1.EditOfFindClick(Sender: TObject);

begin

EditOfFind.Clear;

end; 

end.