5.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;
    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);
  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', 'Разработ4ик', 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]));
    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;

end.



==============================================Add========================================================
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.

===============================================Show=============================================================
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;

implementation

{$R *.dfm}

uses MainUnit;


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;
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)));
        {If ShowNumbers then
        Begin
            Brush.Style := bsClear;
            Font.Color := clRed;
            Pen.Width := 1;
            Font.Size := 8;
            TextOut(X1 - 25, Y1 + OffSetTextByY, '№'+ IntToStr(Tree^.SequenceNumber));

            Brush.Style := bsSolid;
            Font.Color := clBlack;
            Pen.Width := 3;
            Font.Size := 12
        End;   }
    End;
    If(Tree <> Nil) Then
    Begin
        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 = 'в соответствующее поле.';
begin
    TreeImage.Picture := nil;
    DrawTree(Head, ShowTree.TreeImage.Width Div 2, 8, ShowTree.TreeImage.Width Div 2 + 48, 56, Shift);
    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;
end;

end.


===============================================Library======================================================
library My1stLib;
uses
  System.SysUtils,
  System.Classes;

{$R *.res}

Function GetString(Var FileOutput: TextFile): String; stdcall;
Var
    IsRight : Boolean;
    Str : String;
Begin
    IsRight := True;
    Try
        Readln(FileOutput, Str);
        Str := Trim (Str);
    Except
        IsRight := False;
    End;
    If IsRight then
        GetString := Str;
End;

type
    TStr = Array of String;

function SeparateString (Str : String) : TStr; stdcall;
Var
    StrArr : TStr;
    I, K : Integer;
    Flag : Boolean;
Begin
    K := 0;
    SetLength(StrArr, (Str.Length div 2) + 1);
    For I := 0 To Str.Length div 2 do
        StrArr[i] := '';
    I := 1;
    While I <= Str.Length Do
    begin
        Flag := True;
        While (Str[I] <> ' ') and (I <= Str.Length) Do
        Begin
            StrArr[K] := StrArr[K] + Str[I];
            Inc(I);
            Flag := False;
        End;
        If Not(Flag) then
            Inc(K);
        If Flag then
            Inc(I);
    end;
    I := 1;
    K := 0;
    While Str[I] <> '' Do
    Begin
        If Str[I] = ' ' then
            Inc(K);
        Inc(I);
    End;
    SetLength(StrArr, K + 2);
    Result := StrArr;
End;

Exports GetString, SeparateString;

end.