SHARE
TWEET

Untitled

a guest May 9th, 2019 124 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. library TreeDll;
  2.  
  3. uses
  4.   System.SysUtils,
  5.   System.Classes,
  6.   WinApi.Windows;
  7.  
  8. type
  9.    Adrzv = ^Node;
  10.    Node = record
  11.       Key: Integer;
  12.       Left, Right: Adrzv;
  13.    end;
  14.  
  15. {$R *.res}
  16.  
  17.  
  18. procedure CreateTreeLib(var Head: Adrzv);
  19. begin
  20.    New(Head);
  21.    Head^.Key := 0;
  22.    Head^.Left := nil;
  23.    Head^.Right := nil;
  24. end;
  25.  
  26. function PoiskLib(K: Integer; var Head, Rez: Adrzv; var Height: Integer): Boolean;
  27. var
  28.    P, Q: Adrzv;
  29.    IsFind: Boolean;
  30. begin
  31.    P := Head;
  32.    IsFind := False;
  33.    Height := 0;
  34.  
  35.    Q := Nil;
  36.    if Head <> nil then
  37.    repeat
  38.       Q := P;
  39.       Inc(Height);
  40.       if P^.Key = K then
  41.          IsFind := True
  42.       else
  43.          if K < P^.Key then
  44.             P := P^.Left
  45.          else
  46.             P := P^.Right;
  47.    until IsFind or (P = nil);
  48.    Rez := Q;
  49.    PoiskLib := IsFind;
  50. end;
  51.  
  52. procedure AddNodeLib(var Head: Adrzv; K: Integer);
  53. const
  54.    MessageLimitHeight = 'Достигнута максимальная высота дерева';
  55.    MaxTreeHeight = 6;
  56. var
  57.    Q, S: Adrzv;
  58.    Height: Integer;
  59. begin
  60.    if not PoiskLib(K, Head, Q, Height) then//Q - узел к которому нужно добавить новый эл.
  61.    begin
  62.       if Height < MaxTreeHeight then
  63.       begin
  64.          New(S);
  65.          S^.Key := K;
  66.          S^.Left := nil;
  67.          S^.Right := nil;
  68.          if Head = nil then
  69.             Head := S
  70.          else
  71.             if K < Q^.Key then
  72.                Q^.Left := S
  73.             else
  74.                Q^.Right := S
  75.       end
  76.       else
  77.          MessageBox(GetDesktopWindow, MessageLimitHeight, '', MB_OK);
  78.    end
  79.    else
  80.       MessageBox(GetDesktopWindow, 'Звено с таким ключом уже существует!', '', MB_OK);
  81. end;
  82.  
  83. procedure DeleteSubtreeLib(var D: Adrzv; K: Integer);
  84. begin
  85.    if D = nil then//Выпадение из дерева
  86.       MessageBox(GetDesktopWindow, 'Поддерева с таким звеном не найдено', '', MB_OK)
  87.    else
  88.       if (D^.Left = nil) and (D^.Right = nil) then//Попадание в листь двоичного дерева
  89.          MessageBox(GetDesktopWindow, 'Поддерева с таким звеном не найдено', '', MB_OK)
  90.       else
  91.          if (D^.Left <> nil) and (D^.Left^.Key = K) then//Если в Left искомое поддерево
  92.             D^.Left := nil
  93.          else
  94.             if (D^.Right <> nil) and (D^.Right^.Key = K) then//Если в Right искомое поддерево
  95.                D^.Right := nil
  96.             else
  97.                if (K < D^.Key) then//Спуститься в левую ветвь и расмотреть то же самое для нее
  98.                   DeleteSubtreeLib(D^.Left, K)
  99.                else
  100.                   if (K > D^.Key) then //Спуститься в правую ветвь и рассмотреть ее
  101.                      DeleteSubtreeLib(D^.Right, K);
  102. end;
  103.  
  104. procedure DeleteNodeLib(var D: Adrzv; K: Integer);
  105. var
  106.    Q: Adrzv;
  107. procedure DeleteWithTwoLeaves(var R: Adrzv);//При первом вызове R - адрес первой после удаляемой;
  108. begin
  109.    if R^.Right = nil then
  110.    begin
  111.       Q^.Key := R^.Key;
  112.       Q := R;
  113.       Dispose(Q);
  114.       R := R^.Left;
  115.    end
  116.    else
  117.       DeleteWithTwoLeaves(R^.Right);
  118. end;
  119. begin
  120.    if D = nil then
  121.       MessageBox(GetDesktopWindow, 'Звена с заданным ключом в дереве нет', '', MB_OK)
  122.    else
  123.       if K < D^.Key then
  124.          DeleteNodeLib(D^.Left, K)
  125.       else
  126.          if K > D^.Key then
  127.             DeleteNodeLib(D^.Right, K)
  128.          else
  129.          begin
  130.             Q := D;   //D - адр. уд. звена (взят из Left или Right предшеств.
  131.             if Q^.Right = nil then
  132.             begin
  133.                D := Q^.Left;
  134.                Dispose(Q);
  135.             end
  136.             else
  137.                if Q^.Left = nil then
  138.                begin
  139.                   D := Q^.Right;
  140.                   Dispose(Q);
  141.                end
  142.                else
  143.                   DeleteWithTwoLeaves(Q^.Left);
  144.          end;
  145. end;
  146.  
  147. exports CreateTreeLib, PoiskLib, AddNodeLib, DeleteSubtreeLib, DeleteNodeLib;
  148.  
  149. begin
  150. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top