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

type
  TPointer = ^TNode;
  TNode = Record
    Value : Integer;
    Left, Right : TPointer;
  End;

  TPointerList = ^TNodeList;
  TNodeList = record
    Node: TPointer;
    Value : Integer;
    Next: TPointerList;
  end;

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

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

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

var
    TreeStart: TPointer;
    Path : TArray<TPointer>;
    ListHeader: TPointerList;

function InitializeList(): TPointerList;
var
    Header: TPointerList;
begin
    New(Header);
    Header^.Next := nil;
    Header^.Node := nil;
    InitializeList := Header;
end;

procedure AddElementToList(Header: TPointerList; Node: TPointer);
var
    Curr, Temp: TPointerList;
begin
    Curr := Header;
    while (Curr^.Next <> nil) do
        Curr := Curr^.Next;

    New(Temp);
    Temp^.Next := Curr^.Next;
    Curr^.Next := Temp;
    Temp^.Node := Node;
    Temp^.Value := Node^.Value;
end;

procedure DisposeList (Header: TPointerList);
var
    Curr, Temp: TPointerList;
begin
    if Header^.Next <> nil then
    begin
        Curr := Header^.Next;

        while Curr^.Next <> nil do
        begin
            Temp := Curr^.Next;
            Dispose(Curr);
            Curr := Temp;
        end;
        Dispose(Curr);
        Header^.Next := nil;
    end;
end;

Function NormalizeList(Header : TPointerList; Number : Integer) : TPointerList;
Var
    Curr, ReverseList: TPointerList;
    I, J, TempNumber : Integer;
Begin
    TempNumber := Number;
    ReverseList := InitializeList();
    for I := 1 to Number do
    Begin
        Curr := Header;
        for J := 1 to TempNumber do
        Begin
            Curr := Curr^.Next;
        End;
        AddElementToList(ReverseList, Curr^.Node);
        Dec(TempNumber);
    End;

    NormalizeList := ReverseList;
End;

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

procedure AddElemToTree(const Numb : Integer; Var TreeStart : TPointer);
Begin
    if TreeStart <> nil then
    Begin
        if TreeStart^.Value > Numb then
            AddElemToTree(Numb, TreeStart^.Left)
        else
            if TreeStart^.Value < Numb then
                AddElemToTree(Numb, TreeStart^.Right);
    End
    else
    Begin
        New(TreeStart);
        TreeStart^.Value := Numb;
        TreeStart^.Left := nil;
        TreeStart^.Right := nil;
    End;
End;

procedure SwapChildren(TreeStart: TPointer);
var
    Temp: TPointer;
begin
    if TreeStart <> nil then
    Begin
        Temp := TreeStart^.Left;
        TreeStart^.Left := TreeStart^.Right;
        TreeStart^.Right := Temp;
    End;
end;

function IsNodeInList(Header : TPointerList; TreeStart: TPointer): Boolean;
var
    I: Integer;
    Res : Boolean;
    Curr : TPointerList;
begin
    Res := False;
    Curr := Header;
    while (Curr^.Next <> Nil) And (Not Res) do
    Begin
        Curr := Curr^.Next;
        if Curr^.Node = TreeStart then
            Res := True;
    End;

    IsNodeInList := Res;
end;

procedure MirrorTreeRelativeToPath(TreeStart: TPointer; PathList: TPointerList);
begin
    if TreeStart <> nil then
    Begin

        MirrorTreeRelativeToPath(TreeStart^.Left, PathList);
        MirrorTreeRelativeToPath(TreeStart^.Right, PathList);

        if IsNodeInList(PathList, TreeStart) then
        begin
            SwapChildren(TreeStart);
        end;
    End;
end;

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

function FindLongestPath(TreeStart: TPointer; var PathList: TPointerList): Integer;
Var
    LeftPathLength, RightPathLength, Res : Integer;
    LeftPathList, RightPathList: TPointerList;
begin
    if TreeStart = nil then
    begin
        Res := 0;
    end
    Else
    Begin
        LeftPathList := InitializeList();
        RightPathList := InitializeList();
        LeftPathLength := FindLongestPath(TreeStart^.Left, LeftPathList);
        RightPathLength := FindLongestPath(TreeStart^.Right, RightPathList);

        if LeftPathLength > RightPathLength then
        begin
            PathList := LeftPathList;
            AddElementToList(PathList, TreeStart);
            Res := LeftPathLength + 1;
        end
        else
        begin
            PathList := RightPathList;
            AddElementToList(PathList, TreeStart);
            Res := RightPathLength + 1;
        end;
    End;

    FindLongestPath := Res;
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 FindLeftNodeLevel (TreeStart: TPointer): Integer;
var
    Coef, MaxR, MaxL: Integer;
begin
    if TreeStart = nil then
        Coef := 1
    else
    begin
        MaxR := FindLeftNodeLevel(TreeStart^.Right) Div 4;
        MaxL := 2 * FindLeftNodeLevel(TreeStart^.Left);

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

function FindRightNodeLevel (TreeStart: TPointer): Integer;
var
    Coef, MaxR, MaxL: Integer;
begin
    if TreeStart = nil then
        Coef := 1
    else
    begin
        MaxR := 2 * FindRightNodeLevel(TreeStart^.Right);
        MaxL := FindRightNodeLevel(TreeStart^.Left) 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^.Right <> nil then
            begin
                Coef := FindLeftNodeLevel(TreeRoot^.Right);
                DrawTree(TreeRoot^.Right, X + Coef * 30, Y+45);
                Canvas.MoveTo(X+25, Y);
                Canvas.LineTo(X + Coef * 30, Y+20);
            end;
            if TreeRoot^.Left <> nil then
            begin

                Coef := FindRightNodeLevel(TreeRoot^.Left);
                DrawTree(TreeRoot^.Left, 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-5, Y-9, IntToStr(TreeRoot^.Value));
        end;
    end;
end;

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

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

procedure TMainForm.AddButtonClick(Sender: TObject);
begin
    AddElemToTree(StrToInt(ValueEdit.Text), TreeStart);
    ValueEdit.Text := '';
    PathLabel.Visible := False;
    PathEdit.Text := '';
    PathEdit.Visible := False;
    TreeImage.Picture := nil;
    DrawTree(TreeStart, 300, 70);
    ProcessingButton.Enabled := True;
end;

procedure TMainForm.CopyButtonClick(Sender: TObject);
begin
     ValueEdit.CutToClipboard;
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.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
    TreeImage.Width := 1000;
    TreeStart := CreateEmptyTree;
end;

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

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

procedure TMainForm.ProcessingButtonClick(Sender: TObject);
Var
    LengthMaxPath, I : Integer;
    ReversePathList, PathList, CurrList: TPointerList;
begin
    ReversePathList := InitializeList();
    PathEdit.Text := '';
    LengthMaxPath := FindLongestPath(TreeStart, ReversePathList);
    PathLabel.Caption := IntToStr(LengthMaxPath);
    PathLabel.Visible := True;
    PathList := NormalizeList(ReversePathList, LengthMaxPath);
    CurrList := PathList;
    while (CurrList^.Next <> Nil) do
    Begin
        CurrList := CurrList^.Next;
        PathEdit.Text := PathEdit.Text + IntToStr(CurrList^.Value) + ' ';
    End;
    PathEdit.Visible := True;
    MirrorTreeRelativeToPath(TreeStart, PathList);
    TreeImage.Picture := Nil;
    DrawTree(TreeStart, 300, 70);
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;

end.