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.Menus, Vcl.StdCtrls;

type
    TMainForm = class(TForm)
        HeadLabel: TLabel;
        Create: TButton;
        AddElem: TButton;
        Delete: TButton;
        Show: TButton;
        MainMenu1: TMainMenu;
        PopupMenu1: TPopupMenu;
        N1: TMenuItem;
        N2: TMenuItem;
        N3: TMenuItem;
        N4: TMenuItem;
        N5: TMenuItem;
        OpenDialog1: TOpenDialog;
        SaveDialog1: TSaveDialog;
        N6: TMenuItem;
        procedure N3Click(Sender: TObject);
        procedure N2Click(Sender: TObject);
        procedure AddElemClick(Sender: TObject);
        procedure ShowClick(Sender: TObject);
        procedure CreateClick(Sender: TObject);
        procedure N4Click(Sender: TObject);
        procedure N5Click(Sender: TObject);
        procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
        procedure FormActivate(Sender: TObject);
        procedure DeleteClick(Sender: TObject);
        procedure N6Click(Sender: TObject);
    private
        { Private declarations }
    public
        { Public declarations }
    end;

Type
    TArray = Array Of Integer;
    PNode = ^TTree;

    TTree = Record
        Key: Integer;
        Left, Right: PNode;
    End;

var
    MainForm: TMainForm;
    Head, NodeForDeleting: PNode;
    Path, SaveResult, StrWithNum: String;
    IsFileOpen, WasTreeInitialized, ShowNumbers: Boolean;
    Keys: TArray;

implementation

uses Add, Show;

{$R *.dfm}

procedure TMainForm.AddElemClick(Sender: TObject);
begin
    AddNode.ShowModal;
end;

procedure DeleteTree(var Head: PNode);
begin
    if Head <> nil then
    begin
        DeleteTree(Head.Left);
        DeleteTree(Head.Right);
        Dispose(Head);
        Head := nil;
    end;
    SetLength(Keys, 0);
end;

procedure InitializeTree();
Begin
    WasTreeInitialized := True;
    Head := nil;
    SetLength(Keys, 0);
End;

procedure TMainForm.CreateClick(Sender: TObject);
begin
    DeleteTree(Head);
    InitializeTree();
    Application.MessageBox('Пустое дерево создано!', 'Информация', 0);
end;

procedure DeleteNode(var Root: PNode; Key: Integer);
var
    Current, Parent, Temp: PNode;
    IsLeftChild: Boolean;
begin
    Current := Root;
    Parent := nil;
    IsLeftChild := False;

    while (Current <> nil) and (Current^.Key <> Key) do
    begin
        Parent := Current;
        if Key < Current^.Key then
        begin
            Current := Current^.Left;
            IsLeftChild := True;
        end
        else
        begin
            Current := Current^.Right;
            IsLeftChild := False;
        end;
    end;

    if (Current^.Left = nil) and (Current^.Right = nil) then
    begin
        if Current = Root then
            Root := nil
        else if IsLeftChild then
            Parent^.Left := nil
        else
            Parent^.Right := nil;
        Dispose(Current);
        Application.MessageBox('Элемент удален!', 'Информация', 0);
    end

    else if Current^.Right = nil then
    begin
        if Current = Root then
            Root := Current^.Left
        else if IsLeftChild then
            Parent^.Left := Current^.Left
        else
            Parent^.Right := Current^.Left;
        Dispose(Current);
        Application.MessageBox('Элемент удален!', 'Информация', 0);
    end
    else if Current^.Left = nil then
    begin
        if Current = Root then
            Root := Current^.Right
        else if IsLeftChild then
            Parent^.Left := Current^.Right
        else
            Parent^.Right := Current^.Right;
        Dispose(Current);
        Application.MessageBox('Элемент удален!', 'Информация', 0);
    end

    else
    begin
        Temp := Current^.Right;
        Parent := Current;
        while Temp^.Left <> nil do
        begin
            Parent := Temp;
            Temp := Temp^.Left;
        end;
        Current^.Key := Temp^.Key;
        if Parent^.Left = Temp then
            Parent^.Left := Temp^.Right
        else
            Parent^.Right := Temp^.Right;
        Dispose(Temp);
        Application.MessageBox('Элемент удален!', 'Информация', 0);
    end;
end;

function CheckUserChoise(Num: Integer): Boolean;
Var
    IsInvalid: Boolean;
    I: Integer;
Begin
    IsInvalid := True;
    For I := Low(Keys) To High(Keys) Do
        If Num = Keys[I] then
        begin
            IsInvalid := False;
            Break;
        end;
    CheckUserChoise := IsInvalid;
End;

procedure TMainForm.DeleteClick(Sender: TObject);
var
    NumForDeleting: Integer;
    IsCorrect: Boolean;
begin
    If (WasTreeInitialized) and (Head <> nil) then
    Begin
        IsCorrect := True;
        ShowNumbers := True;
        ShowTree.ShowModal;
        with AddNode Do
        Begin
            Caption := 'Удаление элемента';
            Meeting.Caption := 'Введите элемент:';
            N1.Enabled := False;
            ShowModal;
        End;
        try
            NumForDeleting := StrToInt(StrWithNum);
        except
            AddNode.Data.Text := '';
            IsCorrect := False;
            Application.MessageBox
              ('В этом окне следует вводить удаляемый элемент.', 'Ошибка',
              MB_ICONSTOP);
        end;
        If CheckUserChoise(NumForDeleting) and (IsCorrect) then
        begin
            AddNode.Data.Text := '';
            IsCorrect := False;
            Application.MessageBox
              ('В этом окне следует вводить удаляемый элемент.', 'Ошибка',
              MB_ICONSTOP);
        end;
        If IsCorrect then
        begin
            DeleteNode(Head, NumForDeleting);
        end;
    End
    else if Not(WasTreeInitialized) then
    begin
        Application.MessageBox('Дерева не существует. Создайте его!',
          'Информация', 0);
    end
    else
    begin
        Application.MessageBox
          ('Дерево пустое. Добавьте в него элементы, чтобы было что удалять.',
          'Информация', 0);
    end;
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
    WasTreeInitialized := False;
    SetLength(Keys, 0);
end;

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

procedure TMainForm.N2Click(Sender: TObject);
Const
    INFO = 'Дерево — одна из наиболее широко распространённых структур данных в информатике, эмулирующая древовидную структуру в виде набора связанных узлов. Является связным графом, не содержащим циклы.';
    INFO2 = #13#10 + #13#10 +
      'Текстовый файл должен представлять из себя 1 строчку с числами, введенными через пробел. Информация из файла будет дополнять существующую.';

begin
    Application.MessageBox(INFO + INFO2, 'Инструкция', 0);
end;

procedure TMainForm.N3Click(Sender: TObject);
begin
    Application.MessageBox('Сымоник Вадим гр. 251004', 'Разработчик', 0);
end;

procedure TMainForm.ShowClick(Sender: TObject);
begin
    If (WasTreeInitialized) and (Head <> nil) then
    Begin
        ShowTree.ShowModal;
    End
    else if Not(WasTreeInitialized) then
    begin
        Application.MessageBox('Дерева не существует. Создайте его!',
          'Информация', 0);
    end
    else
    begin
        Application.MessageBox
          ('Дерево пустое. Добавьте в него элементы, чтобы оно отобразилось.',
          'Информация', 0);
    end;
end;

Function Open(): String;
Begin
    With MainForm Do
    Begin
        If OpenDialog1.Execute Then
        Begin
            Path := OpenDialog1.FileName;
            IsFileOpen := True;
        End
        Else
            IsFileOpen := False;
    End;
    Open := Path;
End;

Function Save(): String;
Begin
    With MainForm Do
    Begin
        If SaveDialog1.Execute Then
        Begin
            Path := SaveDialog1.FileName;
            IsFileOpen := True;
        End
        Else
            IsFileOpen := False;
    End;
    Save := Path;
End;

Function GetString(Var FileOutput: TextFile): String; Stdcall;
  External 'My1stLib.dll';

type
    TStr = Array of String;

function SeparateString(Str: String): TStr; Stdcall; External 'My1stLib.dll';

Function CreateNewNode(Data: Integer; Node: PNode): PNode;
Begin
    New(Result);
    Result.Key := Data;
    Result.Right := Nil;
    Result.Left := Nil;
End;

Procedure InsertNode(Node: PNode; Data: Integer);
Begin
    If (Data < Node.Key) Then
    Begin
        If (Node.Left <> Nil) Then
            InsertNode(Node.Left, Data)
        Else
            Node.Left := CreateNewNode(Data, Node);
    End
    Else
    Begin
        If (Node.Right <> Nil) Then
            InsertNode(Node.Right, Data)
        Else
            Node.Right := CreateNewNode(Data, Node);
    End;
End;

Procedure AddNodeInTree(Data: Integer);
Var
    Node: PNode;
Begin
    SetLength(Keys, (Length(Keys) + 1));
    Keys[High(Keys)] := Data;
    If (Head <> Nil) Then
        InsertNode(Head, Data)
    Else
        Head := CreateNewNode(Data, Nil);
End;

function CheckRepetitions(Num: Integer): Boolean;
Var
    IsCorrect: Boolean;
    I: Integer;
Begin
    IsCorrect := True;
    For I := Low(Keys) To High(Keys) Do
        If Num = Keys[I] then
        begin
            IsCorrect := False;
            Break;
        end;
    CheckRepetitions := IsCorrect;
End;

function CheckFile(Arr: TStr): Boolean;
Var
    IsCorrect: Boolean;
    I, J: Integer;
Begin
    IsCorrect := True;
    For I := Low(Keys) To High(Keys) Do
        For J := I + 1 To High(Keys) Do
            If Arr[I] = Arr[J] then
            begin
                IsCorrect := False;
                Break
            end;
    I := 0;
    While ((I <= High(Keys)) and (IsCorrect)) Do
    begin
        IsCorrect := CheckRepetitions(StrToInt(Arr[I]));
        Inc(I);
    end;
    CheckFile := IsCorrect;
End;

procedure TMainForm.N4Click(Sender: TObject);
Var
    FileInput: TextFile;
    StrWithNodes: String;
    Arr: TStr;
    I: Integer;
    NewNode, Node: PNode;
    WillContinue: Boolean;
begin
    IsFileOpen := False;
    Path := Open();
    AssignFile(FileInput, Path);
    If ExtractFileExt(Path) <> '.txt' then
        raise Exception.Create
          ('Файл должен быть текстовым. Проверьте исходные данные.');
    Reset(FileInput);
    If (IsFileOpen) then
        StrWithNodes := GetString(FileInput);
    CloseFile(FileInput);
    If (StrWithNodes <> '') then
    Begin
        Arr := SeparateString(StrWithNodes);
        WillContinue := True;
        For I := 0 To High(Arr) Do
            If (Arr[I].Length > 3) then
            begin
                WillContinue := False;
                raise Exception.Create
                  ('Длина одного элемента не должна превышать 3 символов. Проверьте исходные данные.');
            end;
        If WillContinue then
        Begin
            If CheckFile(Arr) then
            Begin
                For I := Low(Arr) to High(Arr) Do
                begin
                    If Arr[I] <> '' then
                        AddNodeInTree(StrToInt(Arr[I]));
                end;
                WasTreeInitialized := True;
                Application.MessageBox('Готово!', 'Информация', 0);
            End
            else
            begin
                Application.MessageBox
                  ('В файле есть повторяющиеся элементы или в файле есть уже существующие элементы.',
                  'Ошибка', MB_ICONSTOP);
            end;
        End;
    End;
end;

procedure CreateStringToSave(var Head: PNode);
begin
    if Head <> nil then
    begin
        CreateStringToSave(Head.Left);
        CreateStringToSave(Head.Right);
        SaveResult := SaveResult + IntToStr(Head.Key) + ' ';
    end;
end;

procedure TMainForm.N5Click(Sender: TObject);
Var
    FileOutput: TextFile;
    IsCorrect: Boolean;
    CurrNode: PNode;
begin
    If Head = nil then
    begin
        Application.MessageBox('Дерево пустое.', 'Информация', 0);
        Exit
    end;
    SaveResult := '';
    IsCorrect := True;
    Path := Save();
    If (IsFileOpen) Then
    Begin
        CreateStringToSave(Head);
        try
            AssignFile(FileOutput, Path);
            Rewrite(FileOutput);
            Write(FileOutput, SaveResult);
            CloseFile(FileOutput);
        except
            IsCorrect := False;
            Application.MessageBox('Запись в файл не удалась.', 'Ошибка',
              MB_ICONSTOP);
        end;

        If IsCorrect then
        Begin
            Application.MessageBox('Запись файла выполнена успешно.',
              'Результат', 0);
        End;
    End;
end;

procedure TMainForm.N6Click(Sender: TObject);
begin
    Application.MessageBox
      ('Вывести номера вершин, для которых высота левого поддерева не равна высоте  правого поддерева.',
      'Задание', 0);
end;

end.



unit Add;

interface

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

type
    TAddNode = class(TForm)
        Data: TEdit;
        Meeting: TLabel;
        MainMenu1: TMainMenu;
        N1: TMenuItem;
        procedure DataKeyPress(Sender: TObject; var Key: Char);
        procedure FormKeyPress(Sender: TObject; var Key: Char);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
        procedure N1Click(Sender: TObject);
        procedure FormDeactivate(Sender: TObject);
    private
        { Private declarations }
    public
        { Public declarations }
    end;

var
    AddNode: TAddNode;

implementation

{$R *.dfm}

Uses MainUnit;

Function CreateNewNode(Data: Integer; Node: PNode): PNode;
Begin
    New(Result);
    Result.Key := Data;
    Result.Right := Nil;
    Result.Left := Nil;
End;

Procedure InsertNode(Node: PNode; Data: Integer);
Begin
    If (Data < Node.Key) Then
    Begin
        If (Node.Left <> Nil) Then
            InsertNode(Node.Left, Data)
        Else
            Node.Left := CreateNewNode(Data, Node);
    End
    Else
    Begin
        If (Node.Right <> Nil) Then
            InsertNode(Node.Right, Data)
        Else
            Node.Right := CreateNewNode(Data, Node);
    End;
End;

Procedure AddNodeInTree(Data: Integer);
Var
    Node: PNode;
Begin
    SetLength(Keys, (Length(Keys) + 1));
    Keys[High(Keys)] := Data;
    If (Head <> Nil) Then
        InsertNode(Head, Data)
    Else
        Head := CreateNewNode(Data, Nil);
End;

function CheckContent(Str: String): Boolean;
var
    IsCorrect: Boolean;
    NumberForTest: Integer;
begin
    IsCorrect := True;
    Try
        NumberForTest := StrToInt(Str);
    Except
        IsCorrect := False;

    End;
    CheckContent := IsCorrect;
end;

function CheckRepetitions(Num: Integer): Boolean;
Var
    IsCorrect: Boolean;
    I: Integer;
Begin
    IsCorrect := True;
    For I := Low(Keys) To High(Keys) Do
        If Num = Keys[I] then
        begin
            IsCorrect := False;
            Break;
        end;
    CheckRepetitions := IsCorrect;
End;

procedure TAddNode.DataKeyPress(Sender: TObject; var Key: Char);
var
    IsOverFlow: Boolean;
begin
    If (Key = #13) and (Data.Text <> '') and (N1.Enabled) then
    begin
        If (CheckContent(Data.Text)) then
        Begin
            If CheckRepetitions(StrToInt(Data.Text)) then
            begin
                AddNodeInTree(StrToInt(Data.Text));
                Application.MessageBox('Элемент добавлен!',
                  'Предупреждение', 0);
                WasTreeInitialized := True;
            end
            else
            begin
                Application.MessageBox
                  ('К сожалению, нельзя добавлять повторяющиеся элементы. Повторите ввод.',
                  'Ошибка', MB_ICONSTOP);
            end;
        End
        else
        begin
            Application.MessageBox
              ('Разрешено вводить только целочисленные значения.', 'Ошибка',
              MB_ICONSTOP);
        end;
        Data.Text := '';
    end;
    If (Key = #13) and (Data.Text <> '') and Not(N1.Enabled) then
    begin
        StrWithNum := Data.Text;
        Data.Text := '';
        AddNode.Close;
    end
end;

procedure TAddNode.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    AddNode.TabStop := True;
end;

procedure TAddNode.FormDeactivate(Sender: TObject);
begin
    AddNode.Caption := 'Добавить';
    AddNode.Meeting.Caption := 'Введите элемент:';
    AddNode.N1.Enabled := True;
end;

procedure TAddNode.FormKeyPress(Sender: TObject; var Key: Char);
begin
    Data.TabStop := True;
end;

procedure TAddNode.N1Click(Sender: TObject);
begin
    Application.MessageBox
      ('Узлами дерева являются целочисленные значения в диапазоне [-9..99]',
      'Информация', 0);
end;

end.



unit Show;

interface

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

type
    TShowTree = class(TForm)
        TreeImage: TImage;
        procedure FormActivate(Sender: TObject);
        procedure FormDeactivate(Sender: TObject);
    private
        { Private declarations }
    public
        { Public declarations }
    end;

var
    ShowTree: TShowTree;
    str: String;

implementation

{$R *.dfm}

uses MainUnit;

Function max(A: Integer; B: Integer): Integer;
Begin
    if A >= B Then
        Result := A
    Else
        Result := B
End;

Function FindHeight(const Head: PNode): Integer;
var
    Curr: PNode;
begin
    Curr := Head;

    if Curr = nil then
    Begin
        Result := 0;
        Exit;
    End;

    If ((Curr.Left <> nil) And (Curr.Left.Right = Curr) And (Curr.Right <> nil)
      And (Curr.Right.Left = Curr)) Then
    Begin
        Result := 1;
        Exit;
    End;

    Result := 1 + max(FindHeight(Curr.Left), FindHeight(Curr.Right));

end;

procedure DrawBranch(X1, Y1, X2, Y2: Integer);
Begin
    ShowTree.TreeImage.Canvas.MoveTo(X1, Y1);
    ShowTree.TreeImage.Canvas.LineTo(X2, Y2);
End;

Procedure DrawTree(Head: PNode; X1, Y1, X2, Y2, Shift: Integer);
Var
    Tree: PNode;
    Cord: Integer;
Const
    OffSetTextByX = 8;
    OffSetTextByY = 10;
Begin
    Tree := Head;
    With (ShowTree.TreeImage.Canvas) Do
    Begin
        Pen.Width := 3;
        Font.Size := 12;
        Ellipse(X1, Y1, X2, Y2);
        TextOut(X1 + OffSetTextByX, Y1 + OffSetTextByY, IntToStr((Tree^.Key)));
    End;
    If (Tree <> Nil) Then
    Begin
        If (FindHeight(Tree.Left) <> FindHeight(Tree.Right)) Then
        Begin
            str := str + IntToStr(Tree^.Key) + ' ';
        End;
        If (Tree.Left <> Nil) Then
        Begin
            DrawBranch(X1, Y1 + 24, X1 - Shift, Y2 + 24);
            DrawTree(Tree.Left, X1 - Shift, Y1 + 48, X2 - Shift, Y2 + 48,
              (Shift Div 2));
        End;
        If (Tree.Right <> Nil) Then
        Begin
            DrawBranch(X2, Y1 + 24, X2 + Shift, Y2 + 24);
            DrawTree(Tree.Right, X1 + Shift, Y2, X2 + Shift, Y2 + 48,
              (Shift Div 2));
        End;
    End;

End;

procedure TShowTree.FormActivate(Sender: TObject);
const
    Shift = 120;
    INFO1 = 'Выберите вершину, которую хотите удалить.';
    INFO2 = 'Далее закройте окно и введите число с этой вершины';
    INFO3 = 'в соответствующее поле.';
    INFO4 = 'Вершины: ';
begin
    TreeImage.Picture := nil;
    DrawTree(Head, ShowTree.TreeImage.Width Div 2, 8,
      ShowTree.TreeImage.Width Div 2 + 48, 56, Shift);
    ShowTree.TreeImage.Canvas.TextOut(0, 200, INFO4 + str);
    If ShowNumbers then
    begin
        with ShowTree.TreeImage.Canvas Do
        begin
            Pen.Width := 2;
            Font.Size := 8;
            TextOut(0, 0, INFO1);
            TextOut(0, 20, INFO2);
            TextOut(0, 40, INFO3);
        end;
    end;
end;

procedure TShowTree.FormDeactivate(Sender: TObject);
begin
    ShowNumbers := False;
    str := '';

end;

end.