Lab5_2 DELPHI

unit MainUnit;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Menus, Clipbrd;

type
  TMainForm = class(TForm)
    ValueEdit: TEdit;
    AddButton: TButton;
    ProcessingButton: TButton;
    DeleteButton: TButton;
    ExitButton: TButton;
    TreeImage: TImage;
    MainMenu: TMainMenu;
    FileMenuItem: TMenuItem;
    OpenMenuItem: TMenuItem;
    SaveMenuItem: TMenuItem;
    SaveAsMenuItem: TMenuItem;
    ManualMenuItem: TMenuItem;
    AboutDeveloperMenuItem: TMenuItem;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    CopyPastePopupMenu: TPopupMenu;
    CopyButton: TMenuItem;
    PasteButton: TMenuItem;
    CutButton: TMenuItem;
    ConditionLabel: TLabel;
    ScrollBox1: TScrollBox;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ExitButtonClick(Sender: TObject);
    procedure ManualMenuItemClick(Sender: TObject);
    procedure AboutDeveloperMenuItemClick(Sender: TObject);
    procedure CopyButtonClick(Sender: TObject);
    procedure PasteButtonClick(Sender: TObject);
    procedure CutButtonClick(Sender: TObject);
    procedure CopyPastePopupMenuPopup(Sender: TObject);
    procedure ValueEditChange(Sender: TObject);
    procedure ValueEditKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ValueEditDblClick(Sender: TObject);
    procedure ValueEditKeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
    procedure AddButtonClick(Sender: TObject);
    procedure DeleteButtonClick(Sender: TObject);
    procedure ProcessingButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation
uses
    BinaryTreeUnit;

const
    kBACKSPACE = #8;
    kINSERT = 45;
    MIN_VALUE = 1;
    MAX_VALUE = 9999;

var
    TreeStart: TPointer;

{$R *.dfm}

procedure TMainForm.AboutDeveloperMenuItemClick(Sender: TObject);
begin
    MessageBox(Handle, 'Разработчик: Наривончик Александр Михайлович, гр. 351004', 'О разработчике', MB_OK Or MB_ICONINFORMATION);
end;

procedure TMainForm.CopyButtonClick(Sender: TObject);
begin
    ValueEdit.CopyToClipboard;
end;

procedure TMainForm.CopyPastePopupMenuPopup(Sender: TObject);
var
    IValue: Integer;
    Buffer: String;
    IsCorrect: Boolean;
begin
    Buffer := Clipboard.AsText;
    IsCorrect := TryStrToInt(Buffer, IValue);
    PasteButton.Enabled := IsCorrect;
end;

procedure TMainForm.CutButtonClick(Sender: TObject);
begin
    ValueEdit.CutToClipboard;
end;

procedure TMainForm.PasteButtonClick(Sender: TObject);
begin
    ValueEdit.PasteFromClipboard;
end;

procedure EditButtonEnabled();
begin
    with MainForm do
    begin
        AddButton.Enabled := ValueEdit.Text <> '';
        DeleteButton.Enabled := ValueEdit.Text <> '';
    end;
end;

procedure TMainForm.ValueEditChange(Sender: TObject);
var
    CursPos: Byte;
    TempStr: String;
    IValue: Integer;
begin
    with ValueEdit do
    begin
        if Text = '0' then
            Text := ''
        else
            if (Length(Text) > 0) then
            begin
                CursPos := SelStart;
                TempStr := Text;

                if not TryStrToInt(TempStr, IValue) then
                begin
                    Delete (TempStr, SelStart, 1);
                    Text := TempStr;
                    SelStart := CursPos-1;
                end
                else
                begin
                    Text := IntToStr(IValue);
                    SelStart := CursPos;
                end;
            end;
    end;
    EditButtonEnabled;
end;

procedure TMainForm.ValueEditDblClick(Sender: TObject);
begin
    ValueEdit.Text := '';
end;

procedure TMainForm.ValueEditKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    if Key = kINSERT then
        Key := 0;
end;

procedure TMainForm.ValueEditKeyPress(Sender: TObject; var Key: Char);
begin
    if Not (Key in ['0'..'9', kBACKSPACE]) then
        Key := #0;
end;

procedure TMainForm.ExitButtonClick(Sender: TObject);
begin
    MainForm.Close;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
    CanClose := MessageBox(Handle, 'Вы действительно хотите выйти?', 'Вы уверены?', MB_YESNO Or MB_ICONQUESTION) = IDYES;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
    TreeStart := CreateEmptyTree;
end;

procedure TMainForm.ManualMenuItemClick(Sender: TObject);
begin
    MessageBox(Handle, '1. Введите значение (от 1 до 9999) нового узла в поле и нажмите кнопку "Добавить". Постройте таким образом бинарное дерево' + #13#10 + '2. Чтобы удалить узел, введите его значение в поле и нажмите удалить.' + #13#10 + '3. Нажмите кнопку "Обработать" и получите результат!'+ #13#10 + '4. В случае ввода из файла убедитесь, что файл содержит значение каждого узла в новой строке.', 'Инструкция', MB_OK Or MB_ICONINFORMATION);
end;

function PowerNum (Num, Pow: Integer): Integer;
var
    I, Sum: Integer;
begin
    Sum := 1;
    for I := Pow downto 1 do
        Sum := Sum * Num;

    PowerNum := Sum;
end;

function GetMax (A, B: Integer): Integer;
begin
    if A > B then
        GetMax := A
    else
        GetMax := B;
end;

function FindLeftNodeLevel (TreeStart: TPointer): Integer;
var
    Coef, MaxR, MaxL: Integer;
begin
    if TreeStart = nil then
        Coef := 1
    //else if (TreeStart^.NextLeft = nil) and (TreeStart^.NextRight = nil) then
      //  MaxDepth := 1
    else
    begin
        MaxR := FindLeftNodeLevel(TreeStart^.NextRight) Div 4;
        MaxL := 2 * FindLeftNodeLevel(TreeStart^.NextLeft);

        Coef := GetMax(MaxL, MaxR);
    end;
    FindLeftNodeLevel := Coef;
end;

function FindRightNodeLevel (TreeStart: TPointer): Integer;
{var
    MaxDepth, MaxR, MaxL: Integer;
begin
    if TreeStart = nil then
        MaxDepth := 0
    //else if (TreeStart^.NextLeft = nil) and (TreeStart^.NextRight = nil) then
      //  MaxDepth := 1
    else
    begin
        MaxR := 1 + FindRightNodeLevel(TreeStart^.NextRight);
        MaxL := -2 + FindRightNodeLevel(TreeStart^.NextLeft);

        MaxDepth := GetMax(MaxL, MaxR);
    end;
    FindRightNodeLevel := MaxDepth;
end;}
var
    Coef, MaxR, MaxL: Integer;
begin
    if TreeStart = nil then
        Coef := 1
    //else if (TreeStart^.NextLeft = nil) and (TreeStart^.NextRight = nil) then
      //  MaxDepth := 1
    else
    begin
        MaxR := 2 * FindRightNodeLevel(TreeStart^.NextRight);
        MaxL := FindRightNodeLevel(TreeStart^.NextLeft) Div 4;

        Coef := GetMax(MaxL, MaxR);
    end;
    FindRightNodeLevel := Coef;
end;

procedure DrawTree(TreeRoot: TPointer; X, Y: Integer);
var
    Coef: Integer;
begin
    with MainForm.TreeImage do
    begin
        if TreeRoot <> nil then
        begin
            if TreeRoot^.NextRight <> nil then
            begin
                //if TreeRoot^.NextLeft = nil then
                //    Coef := 1
                //else
                    Coef := FindLeftNodeLevel(TreeRoot^.NextRight);

                //Coef := PowerNum(2,Coef);

                DrawTree(TreeRoot^.NextRight, X + Coef * 30, Y+45);
                Canvas.MoveTo(X+25, Y);
                Canvas.LineTo(X + Coef * 30, Y+20);
            end;
            if TreeRoot^.NextLeft <> nil then
            begin
                //if TreeRoot^.NextRight = nil then
                //    Coef := 1
                //else
                    Coef := FindRightNodeLevel(TreeRoot^.NextLeft);

                //Coef := PowerNum(2,Coef);

                DrawTree(TreeRoot^.NextLeft, X - Coef * 30, Y+45);
                Canvas.MoveTo(X-25, Y);
                Canvas.LineTo(X - Coef * 30, Y+20);
            end;
            Canvas.Ellipse(X-25, Y-25, X+25, Y+25);
            Canvas.TextOut(X, Y, IntToStr(TreeRoot^.Value));
        end;
    end;
end;

procedure TMainForm.AddButtonClick(Sender: TObject);
begin
    AddElemToTree(StrToInt(ValueEdit.Text), TreeStart);
    TreeImage.Picture := nil;
    ValueEdit.Text := '';
    DrawTree(TreeStart, 300, 70);
end;

procedure TMainForm.DeleteButtonClick(Sender: TObject);
begin
    DeleteElemInTree(StrToInt(ValueEdit.Text), TreeStart);
    ValueEdit.Text := '';
    TreeImage.Picture := nil;
    DrawTree(TreeStart, 300, 70);
end;

procedure TMainForm.ProcessingButtonClick(Sender: TObject);
begin
    EditTree(TreeStart);
    TreeImage.Picture := nil;
    DrawTree(TreeStart, 300, 70);
end;
end.




























unit BinaryTreeUnit;

interface
type
    TPointer= ^Elem;
    Elem = record
        Value: Integer;
        NextLeft, NextRight: TPointer;
    end;

function CreateEmptyTree(): TPointer;
procedure AddElemToTree(const N: Integer; Var TreeStart: TPointer);
procedure DeleteElemInTree(Const N: Integer; Var TreeStart: TPointer);
function FindMinDepth(TreeStart: TPointer): Integer;
procedure EditTree(var TreeStart: TPointer);
function GetCentralNode(TreeStart: TPointer; Depth: Integer; const LeafValue: Integer): Integer;
procedure GetLeafValue(TreeStart: TPointer; Depth: Integer; var LeafValue:Integer);
function FindMaxDepth(TreeStart: TPointer): Integer;

implementation

function CreateEmptyTree(): TPointer;
begin
    CreateEmptyTree := nil;
end;

procedure AddElemToTree(const N: Integer; Var TreeStart: TPointer);
begin
    if TreeStart <> nil then
    begin
        if TreeStart^.Value > N then
            AddElemToTree(N, TreeStart^.NextLeft)
        else
            if TreeStart^.Value < N then
                AddElemToTree(N, TreeStart^.NextRight);
    end
    else
    begin
        New(TreeStart);
        TreeStart^.Value := N;
        TreeStart^.NextRight := nil;
        TreeStart^.NextLeft := nil;
    end;
end;

procedure FindMinElemInRightSubtree(var StartSubtree: TPointer);
begin
    while StartSubtree^.NextLeft <> nil do
        StartSubtree := StartSubtree^.NextLeft;
end;

procedure DeleteElemInTree(const N: Integer; var TreeStart: TPointer);
var
    Temp: TPointer;
begin
    if TreeStart <> nil then
    begin
        if TreeStart^.Value = N then
        begin
            Temp := TreeStart;
            if TreeStart^.NextRight <> nil then
            begin
                if TreeStart^.NextLeft = nil then
                begin
                    TreeStart := TreeStart^.NextRight;
                    Dispose(Temp);
                end
                else
                begin
                    Temp := TreeStart^.NextRight;
                    FindMinElemInRightSubtree(Temp); //найдем минимальный в правом поддереве
                    TreeStart^.Value := Temp^.Value;
                    DeleteElemInTree (Temp^.Value, TreeStart^.NextRight);
                end;
            end
            else
                if TreeStart^.NextLeft <> nil then
                begin
                    TreeStart := TreeStart^.NextLeft;
                    Dispose(Temp);
                end
                else
                begin
                    TreeStart := nil;
                    Dispose(Temp);
                end;
        end
        else
        begin
            if TreeStart^.Value > N then
                DeleteElemInTree(N, TreeStart^.NextLeft)
            else
                DeleteElemInTree(N, TreeStart^.NextRight);
        end;
    end;
end;

function GetMin (A, B: Integer): Integer;
begin
    if A < B then
        GetMin := A
    else
        GetMin := B;
end;

function GetMax (A, B: Integer): Integer;
begin
    if A > B then
        GetMax := A
    else
        GetMax := B;
end;

function FindMinDepth(TreeStart: TPointer): Integer;
var
    MinDepth: Integer;
begin
    if TreeStart = nil then
        MinDepth := 0
    else if (TreeStart^.NextLeft = nil) and (TreeStart^.NextRight = nil) then
        MinDepth := 1
    else if TreeStart^.NextLeft = nil then
        MinDepth := 1 + FindMinDepth(TreeStart^.NextRight)
    else if TreeStart^.NextRight = nil then
        MinDepth := 1 + FindMinDepth(TreeStart^.NextLeft)
    else
        MinDepth := 1 + GetMin(FindMinDepth(TreeStart^.NextLeft), FindMinDepth(TreeStart^.NextRight));

    FindMinDepth := MinDepth;
end;

function FindMaxDepth(TreeStart: TPointer): Integer;
var
    MaxDepth, MaxR, MaxL: Integer;
begin
    if TreeStart = nil then
        MaxDepth := 0
    //else if (TreeStart^.NextLeft = nil) and (TreeStart^.NextRight = nil) then
        //MaxDepth := 1
    else
    begin
        MaxR := 1 + FindMaxDepth(TreeStart^.NextRight);
        MaxL := 1 + FindMaxDepth(TreeStart^.NextLeft);

        MaxDepth := GetMax(MaxL, MaxR);
    end;
    FindMaxDepth := MaxDepth;
end;

procedure GetLeafValue(TreeStart: TPointer; Depth: Integer; var LeafValue:Integer);
begin
    if TreeStart <> nil then
    begin
        if (Depth = 1) and (TreeStart^.NextLeft = nil) and (TreeStart^.NextRight = nil) then
        begin
          LeafValue := TreeStart^.Value;
        end
        else
        begin
            GetLeafValue(TreeStart^.NextLeft, Depth - 1, LeafValue);
            GetLeafValue(TreeStart^.NextRight, Depth - 1, LeafValue);
        end;
    end;
end;

function GetCentralNode(TreeStart: TPointer; Depth: Integer; const LeafValue: Integer): Integer;
var
    CentralNode: Integer;
begin
    if TreeStart <> nil then
    begin
        if Depth = 1 then
        begin
          CentralNode := TreeStart^.Value;
        end
        else
        begin
            if LeafValue < TreeStart^.Value then
                CentralNode := GetCentralNode(TreeStart^.NextLeft, Depth - 1, LeafValue)
            else
                CentralNode := GetCentralNode(TreeStart^.NextRight, Depth - 1, LeafValue);
        end;
    end;

    GetCentralNode := CentralNode;
end;

procedure EditTree(var TreeStart: TPointer);
var
    Temp, MinDepth, LeafValue, CentralNode: Integer;
begin
    MinDepth := FindMinDepth(TreeStart);
    if Odd(MinDepth) then
    begin
        GetLeafValue(TreeStart, MinDepth, LeafValue);
        repeat
            CentralNode := GetCentralNode(TreeStart, (MinDepth + 1) div 2, LeafValue);
            DeleteElemInTree(CentralNode, TreeStart);

            Temp := LeafValue;
            GetLeafValue(TreeStart, MinDepth, LeafValue);

        until LeafValue = Temp;
    end;
end;

end.