library TreeDll;

uses
  System.SysUtils,
  System.Classes,
  WinApi.Windows;

type
   Adrzv = ^Node;
   Node = record
      Key: Integer;
      Left, Right: Adrzv;
   end;

{$R *.res}


procedure CreateTreeLib(var Head: Adrzv);
begin
   New(Head);
   Head^.Key := 0;
   Head^.Left := nil;
   Head^.Right := nil;
end;

function PoiskLib(K: Integer; var Head, Rez: Adrzv; var Height: Integer): Boolean;
var
   P, Q: Adrzv;
   IsFind: Boolean;
begin
   P := Head;
   IsFind := False;
   Height := 0;

   Q := Nil;
   if Head <> nil then
   repeat
      Q := P;
      Inc(Height);
      if P^.Key = K then
         IsFind := True
      else
         if K < P^.Key then
            P := P^.Left
         else
            P := P^.Right;
   until IsFind or (P = nil);
   Rez := Q;
   PoiskLib := IsFind;
end;

procedure AddNodeLib(var Head: Adrzv; K: Integer);
const
   MessageLimitHeight = 'Достигнута максимальная высота дерева';
   MaxTreeHeight = 6;
var
   Q, S: Adrzv;
   Height: Integer;
begin
   if not PoiskLib(K, Head, Q, Height) then//Q - узел к которому нужно добавить новый эл.
   begin
      if Height < MaxTreeHeight then
      begin
         New(S);
         S^.Key := K;
         S^.Left := nil;
         S^.Right := nil;
         if Head = nil then
            Head := S
         else
            if K < Q^.Key then
               Q^.Left := S
            else
               Q^.Right := S
      end
      else
         MessageBox(GetDesktopWindow, MessageLimitHeight, '', MB_OK);
   end
   else
      MessageBox(GetDesktopWindow, 'Звено с таким ключом уже существует!', '', MB_OK);
end;

procedure DeleteSubtreeLib(var D: Adrzv; K: Integer);
begin
   if D = nil then//Выпадение из дерева
      MessageBox(GetDesktopWindow, 'Поддерева с таким звеном не найдено', '', MB_OK)
   else
      if (D^.Left = nil) and (D^.Right = nil) then//Попадание в листь двоичного дерева
         MessageBox(GetDesktopWindow, 'Поддерева с таким звеном не найдено', '', MB_OK)
      else
         if (D^.Left <> nil) and (D^.Left^.Key = K) then//Если в Left искомое поддерево
            D^.Left := nil
         else
            if (D^.Right <> nil) and (D^.Right^.Key = K) then//Если в Right искомое поддерево
               D^.Right := nil
            else
               if (K < D^.Key) then//Спуститься в левую ветвь и расмотреть то же самое для нее
                  DeleteSubtreeLib(D^.Left, K)
               else
                  if (K > D^.Key) then //Спуститься в правую ветвь и рассмотреть ее
                     DeleteSubtreeLib(D^.Right, K);
end;

procedure DeleteNodeLib(var D: Adrzv; K: Integer);
var
   Q: Adrzv;
procedure DeleteWithTwoLeaves(var R: Adrzv);//При первом вызове R - адрес первой после удаляемой;
begin
   if R^.Right = nil then
   begin
      Q^.Key := R^.Key;
      Q := R;
      Dispose(Q);
      R := R^.Left;
   end
   else
      DeleteWithTwoLeaves(R^.Right);
end;
begin
   if D = nil then
      MessageBox(GetDesktopWindow, 'Звена с заданным ключом в дереве нет', '', MB_OK)
   else
      if K < D^.Key then
         DeleteNodeLib(D^.Left, K)
      else
         if K > D^.Key then
            DeleteNodeLib(D^.Right, K)
         else
         begin
            Q := D;   //D - адр. уд. звена (взят из Left или Right предшеств.
            if Q^.Right = nil then
            begin
               D := Q^.Left;
               Dispose(Q);
            end
            else
               if Q^.Left = nil then
               begin
                  D := Q^.Right;
                  Dispose(Q);
               end
               else
                  DeleteWithTwoLeaves(Q^.Left);
         end;
end;

exports CreateTreeLib, PoiskLib, AddNodeLib, DeleteSubtreeLib, DeleteNodeLib;

begin
end.