Advertisement
Ewerlost

Lab5.2(Delphi)

Mar 24th, 2024
254
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 12.46 KB | None | 0 0
  1. unit MainUnit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.Menus, Vcl.StdCtrls, Clipbrd;
  8.  
  9. type
  10.   TPointer = ^TNode;
  11.   TNode = Record
  12.     Value : Integer;
  13.     Left, Right : TPointer;
  14.   End;
  15.  
  16.   TPointerList = ^TNodeList;
  17.   TNodeList = record
  18.     Node: TPointer;
  19.     Value : Integer;
  20.     Next: TPointerList;
  21.   end;
  22.  
  23.   TMainForm = class(TForm)
  24.     ScrollBox1: TScrollBox;
  25.     TreeImage: TImage;
  26.     Label1: TLabel;
  27.     ValueEdit: TEdit;
  28.     AddButton: TButton;
  29.     PathLabel: TLabel;
  30.     ProcessingButton: TButton;
  31.     ExitButton: TButton;
  32.     PathEdit: TEdit;
  33.     MainMenu: TMainMenu;
  34.     N1: TMenuItem;
  35.     ManualMenuItem: TMenuItem;
  36.     AboutDeveloperMenuItem: TMenuItem;
  37.     N4: TMenuItem;
  38.     N5: TMenuItem;
  39.     SaveDialog: TSaveDialog;
  40.     OpenDialog: TOpenDialog;
  41.     CopyPastePopupMenu: TPopupMenu;
  42.     CopyButton: TMenuItem;
  43.     CutButton: TMenuItem;
  44.     PasteButton: TMenuItem;
  45.     procedure FormCreate(Sender: TObject);
  46.     procedure AboutDeveloperMenuItemClick(Sender: TObject);
  47.     procedure ValueEditChange(Sender: TObject);
  48.     procedure CopyButtonClick(Sender: TObject);
  49.     procedure PasteButtonClick(Sender: TObject);
  50.     procedure CutButtonClick(Sender: TObject);
  51.     procedure CopyPastePopupMenuPopup(Sender: TObject);
  52.     procedure ValueEditDblClick(Sender: TObject);
  53.     procedure ValueEditKeyDown(Sender: TObject; var Key: Word;
  54.       Shift: TShiftState);
  55.     procedure ValueEditKeyPress(Sender: TObject; var Key: Char);
  56.     procedure ExitButtonClick(Sender: TObject);
  57.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  58.     procedure ManualMenuItemClick(Sender: TObject);
  59.     procedure AddButtonClick(Sender: TObject);
  60.     procedure ProcessingButtonClick(Sender: TObject);
  61.   private
  62.     { Private declarations }
  63.   public
  64.     { Public declarations }
  65.   end;
  66.  
  67. var
  68.   MainForm: TMainForm;
  69.  
  70. implementation
  71.  
  72. {$R *.dfm}
  73.  
  74. const
  75.     kBACKSPACE = #8;
  76.     kINSERT = 45;
  77.     MIN_VALUE = 1;
  78.     MAX_VALUE = 9999;
  79.  
  80. var
  81.     TreeStart: TPointer;
  82.     Path : TArray<TPointer>;
  83.     ListHeader: TPointerList;
  84.  
  85. function InitializeList(): TPointerList;
  86. var
  87.     Header: TPointerList;
  88. begin
  89.     New(Header);
  90.     Header^.Next := nil;
  91.     Header^.Node := nil;
  92.     InitializeList := Header;
  93. end;
  94.  
  95. procedure AddElementToList(Header: TPointerList; Node: TPointer);
  96. var
  97.     Curr, Temp: TPointerList;
  98. begin
  99.     Curr := Header;
  100.     while (Curr^.Next <> nil) do
  101.         Curr := Curr^.Next;
  102.  
  103.     New(Temp);
  104.     Temp^.Next := Curr^.Next;
  105.     Curr^.Next := Temp;
  106.     Temp^.Node := Node;
  107.     Temp^.Value := Node^.Value;
  108. end;
  109.  
  110. procedure DisposeList (Header: TPointerList);
  111. var
  112.     Curr, Temp: TPointerList;
  113. begin
  114.     if Header^.Next <> nil then
  115.     begin
  116.         Curr := Header^.Next;
  117.  
  118.         while Curr^.Next <> nil do
  119.         begin
  120.             Temp := Curr^.Next;
  121.             Dispose(Curr);
  122.             Curr := Temp;
  123.         end;
  124.         Dispose(Curr);
  125.         Header^.Next := nil;
  126.     end;
  127. end;
  128.  
  129. Function NormalizeList(Header : TPointerList; Number : Integer) : TPointerList;
  130. Var
  131.     Curr, ReverseList: TPointerList;
  132.     I, J, TempNumber : Integer;
  133. Begin
  134.     TempNumber := Number;
  135.     ReverseList := InitializeList();
  136.     for I := 1 to Number do
  137.     Begin
  138.         Curr := Header;
  139.         for J := 1 to TempNumber do
  140.         Begin
  141.             Curr := Curr^.Next;
  142.         End;
  143.         AddElementToList(ReverseList, Curr^.Node);
  144.         Dec(TempNumber);
  145.     End;
  146.  
  147.     NormalizeList := ReverseList;
  148. End;
  149.  
  150. function CreateEmptyTree(): TPointer;
  151. begin
  152.   CreateEmptyTree := nil;
  153. end;
  154.  
  155. procedure AddElemToTree(const Numb : Integer; Var TreeStart : TPointer);
  156. Begin
  157.     if TreeStart <> nil then
  158.     Begin
  159.         if TreeStart^.Value > Numb then
  160.             AddElemToTree(Numb, TreeStart^.Left)
  161.         else
  162.             if TreeStart^.Value < Numb then
  163.                 AddElemToTree(Numb, TreeStart^.Right);
  164.     End
  165.     else
  166.     Begin
  167.         New(TreeStart);
  168.         TreeStart^.Value := Numb;
  169.         TreeStart^.Left := nil;
  170.         TreeStart^.Right := nil;
  171.     End;
  172. End;
  173.  
  174. procedure SwapChildren(TreeStart: TPointer);
  175. var
  176.     Temp: TPointer;
  177. begin
  178.     if TreeStart <> nil then
  179.     Begin
  180.         Temp := TreeStart^.Left;
  181.         TreeStart^.Left := TreeStart^.Right;
  182.         TreeStart^.Right := Temp;
  183.     End;
  184. end;
  185.  
  186. function IsNodeInList(Header : TPointerList; TreeStart: TPointer): Boolean;
  187. var
  188.     I: Integer;
  189.     Res : Boolean;
  190.     Curr : TPointerList;
  191. begin
  192.     Res := False;
  193.     Curr := Header;
  194.     while (Curr^.Next <> Nil) And (Not Res) do
  195.     Begin
  196.         Curr := Curr^.Next;
  197.         if Curr^.Node = TreeStart then
  198.             Res := True;
  199.     End;
  200.  
  201.     IsNodeInList := Res;
  202. end;
  203.  
  204. procedure MirrorTreeRelativeToPath(TreeStart: TPointer; PathList: TPointerList);
  205. begin
  206.     if TreeStart <> nil then
  207.     Begin
  208.  
  209.         MirrorTreeRelativeToPath(TreeStart^.Left, PathList);
  210.         MirrorTreeRelativeToPath(TreeStart^.Right, PathList);
  211.  
  212.         if IsNodeInList(PathList, TreeStart) then
  213.         begin
  214.             SwapChildren(TreeStart);
  215.         end;
  216.     End;
  217. end;
  218.  
  219. function GetMax (A, B: Integer): Integer;
  220. begin
  221.     if A > B then
  222.         GetMax := A
  223.     else
  224.         GetMax := B;
  225. end;
  226.  
  227. function FindLongestPath(TreeStart: TPointer; var PathList: TPointerList): Integer;
  228. Var
  229.     LeftPathLength, RightPathLength, Res : Integer;
  230.     LeftPathList, RightPathList: TPointerList;
  231. begin
  232.     if TreeStart = nil then
  233.     begin
  234.         Res := 0;
  235.     end
  236.     Else
  237.     Begin
  238.         LeftPathList := InitializeList();
  239.         RightPathList := InitializeList();
  240.         LeftPathLength := FindLongestPath(TreeStart^.Left, LeftPathList);
  241.         RightPathLength := FindLongestPath(TreeStart^.Right, RightPathList);
  242.  
  243.         if LeftPathLength > RightPathLength then
  244.         begin
  245.             PathList := LeftPathList;
  246.             AddElementToList(PathList, TreeStart);
  247.             Res := LeftPathLength + 1;
  248.         end
  249.         else
  250.         begin
  251.             PathList := RightPathList;
  252.             AddElementToList(PathList, TreeStart);
  253.             Res := RightPathLength + 1;
  254.         end;
  255.     End;
  256.  
  257.     FindLongestPath := Res;
  258. end;
  259.  
  260. function PowerNum (Num, Pow: Integer): Integer;
  261. var
  262.     I, Sum: Integer;
  263. begin
  264.     Sum := 1;
  265.     for I := Pow downto 1 do
  266.         Sum := Sum * Num;
  267.  
  268.     PowerNum := Sum;
  269. end;
  270.  
  271. function FindLeftNodeLevel (TreeStart: TPointer): Integer;
  272. var
  273.     Coef, MaxR, MaxL: Integer;
  274. begin
  275.     if TreeStart = nil then
  276.         Coef := 1
  277.     else
  278.     begin
  279.         MaxR := FindLeftNodeLevel(TreeStart^.Right) Div 4;
  280.         MaxL := 2 * FindLeftNodeLevel(TreeStart^.Left);
  281.  
  282.         Coef := GetMax(MaxL, MaxR);
  283.     end;
  284.     FindLeftNodeLevel := Coef;
  285. end;
  286.  
  287. function FindRightNodeLevel (TreeStart: TPointer): Integer;
  288. var
  289.     Coef, MaxR, MaxL: Integer;
  290. begin
  291.     if TreeStart = nil then
  292.         Coef := 1
  293.     else
  294.     begin
  295.         MaxR := 2 * FindRightNodeLevel(TreeStart^.Right);
  296.         MaxL := FindRightNodeLevel(TreeStart^.Left) Div 4;
  297.  
  298.         Coef := GetMax(MaxL, MaxR);
  299.     end;
  300.     FindRightNodeLevel := Coef;
  301. end;
  302.  
  303. procedure DrawTree(TreeRoot: TPointer; X, Y: Integer);
  304. var
  305.     Coef: Integer;
  306. begin
  307.     with MainForm.TreeImage do
  308.     begin
  309.         if TreeRoot <> nil then
  310.         begin
  311.             if TreeRoot^.Right <> nil then
  312.             begin
  313.                 Coef := FindLeftNodeLevel(TreeRoot^.Right);
  314.                 DrawTree(TreeRoot^.Right, X + Coef * 30, Y+45);
  315.                 Canvas.MoveTo(X+25, Y);
  316.                 Canvas.LineTo(X + Coef * 30, Y+20);
  317.             end;
  318.             if TreeRoot^.Left <> nil then
  319.             begin
  320.  
  321.                 Coef := FindRightNodeLevel(TreeRoot^.Left);
  322.                 DrawTree(TreeRoot^.Left, X - Coef * 30, Y+45);
  323.                 Canvas.MoveTo(X-25, Y);
  324.                 Canvas.LineTo(X - Coef * 30, Y+20);
  325.             end;
  326.             Canvas.Ellipse(X-25, Y-25, X+25, Y+25);
  327.             Canvas.TextOut(X-5, Y-9, IntToStr(TreeRoot^.Value));
  328.         end;
  329.     end;
  330. end;
  331.  
  332. procedure TMainForm.AboutDeveloperMenuItemClick(Sender: TObject);
  333. begin
  334.      MessageBox(Handle, 'Разработчик: Костюков Алексей Олегович, гр. 351004', 'О разработчике', MB_OK Or MB_ICONINFORMATION);
  335. end;
  336.  
  337. procedure EditButtonEnabled();
  338. begin
  339.     with MainForm do
  340.     begin
  341.         AddButton.Enabled := ValueEdit.Text <> '';
  342.     end;
  343. end;
  344.  
  345. procedure TMainForm.AddButtonClick(Sender: TObject);
  346. begin
  347.     AddElemToTree(StrToInt(ValueEdit.Text), TreeStart);
  348.     ValueEdit.Text := '';
  349.     PathLabel.Visible := False;
  350.     PathEdit.Text := '';
  351.     PathEdit.Visible := False;
  352.     TreeImage.Picture := nil;
  353.     DrawTree(TreeStart, 300, 70);
  354.     ProcessingButton.Enabled := True;
  355. end;
  356.  
  357. procedure TMainForm.CopyButtonClick(Sender: TObject);
  358. begin
  359.      ValueEdit.CutToClipboard;
  360. end;
  361.  
  362. procedure TMainForm.CopyPastePopupMenuPopup(Sender: TObject);
  363. var
  364.     IValue: Integer;
  365.     Buffer: String;
  366.     IsCorrect: Boolean;
  367. begin
  368.     Buffer := Clipboard.AsText;
  369.     IsCorrect := TryStrToInt(Buffer, IValue);
  370.     PasteButton.Enabled := IsCorrect;
  371. end;
  372.  
  373. procedure TMainForm.CutButtonClick(Sender: TObject);
  374. begin
  375.     ValueEdit.CutToClipboard;
  376. end;
  377.  
  378. procedure TMainForm.ExitButtonClick(Sender: TObject);
  379. begin
  380.     MainForm.Close;
  381. end;
  382.  
  383. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  384. begin
  385.     CanClose := MessageBox(Handle, 'Вы действительно хотите выйти?', 'Вы уверены?', MB_YESNO Or MB_ICONQUESTION) = IDYES;
  386. end;
  387.  
  388. procedure TMainForm.FormCreate(Sender: TObject);
  389. begin
  390.     TreeImage.Width := 1000;
  391.     TreeStart := CreateEmptyTree;
  392. end;
  393.  
  394. procedure TMainForm.ManualMenuItemClick(Sender: TObject);
  395. begin
  396.     MessageBox(Handle, '1. Введите значение (от 1 до 9999) нового узла в поле и нажмите кнопку "Добавить". Постройте таким образом бинарное дерево' + #13#10 + '2. Нажмите кнопку "Обработать" и получите результат!'+ #13#10 + '3. В случае ввода из файла убедитесь, что файл содержит значение каждого узла в новой строке.', 'Инструкция', MB_OK Or MB_ICONINFORMATION);
  397. end;
  398.  
  399. procedure TMainForm.PasteButtonClick(Sender: TObject);
  400. begin
  401.     ValueEdit.PasteFromClipboard;
  402. end;
  403.  
  404. procedure TMainForm.ProcessingButtonClick(Sender: TObject);
  405. Var
  406.     LengthMaxPath, I : Integer;
  407.     ReversePathList, PathList, CurrList: TPointerList;
  408. begin
  409.     ReversePathList := InitializeList();
  410.     PathEdit.Text := '';
  411.     LengthMaxPath := FindLongestPath(TreeStart, ReversePathList);
  412.     PathLabel.Caption := IntToStr(LengthMaxPath);
  413.     PathLabel.Visible := True;
  414.     PathList := NormalizeList(ReversePathList, LengthMaxPath);
  415.     CurrList := PathList;
  416.     while (CurrList^.Next <> Nil) do
  417.     Begin
  418.         CurrList := CurrList^.Next;
  419.         PathEdit.Text := PathEdit.Text + IntToStr(CurrList^.Value) + ' ';
  420.     End;
  421.     PathEdit.Visible := True;
  422.     MirrorTreeRelativeToPath(TreeStart, PathList);
  423.     TreeImage.Picture := Nil;
  424.     DrawTree(TreeStart, 300, 70);
  425. end;
  426.  
  427. procedure TMainForm.ValueEditChange(Sender: TObject);
  428. var
  429.     CursPos: Byte;
  430.     TempStr: String;
  431.     IValue: Integer;
  432. begin
  433.     with ValueEdit do
  434.     begin
  435.         if Text = '0' then
  436.             Text := ''
  437.         else
  438.             if (Length(Text) > 0) then
  439.             begin
  440.                 CursPos := SelStart;
  441.                 TempStr := Text;
  442.  
  443.                 if not TryStrToInt(TempStr, IValue) then
  444.                 begin
  445.                     Delete (TempStr, SelStart, 1);
  446.                     Text := TempStr;
  447.                     SelStart := CursPos-1;
  448.                 end
  449.                 else
  450.                 begin
  451.                     Text := IntToStr(IValue);
  452.                     SelStart := CursPos;
  453.                 end;
  454.             end;
  455.     end;
  456.     EditButtonEnabled;
  457. end;
  458.  
  459. procedure TMainForm.ValueEditDblClick(Sender: TObject);
  460. begin
  461.     ValueEdit.Text := '';
  462. end;
  463.  
  464. procedure TMainForm.ValueEditKeyDown(Sender: TObject; var Key: Word;
  465.   Shift: TShiftState);
  466. begin
  467.     if Key = kINSERT then
  468.         Key := 0;
  469. end;
  470.  
  471. procedure TMainForm.ValueEditKeyPress(Sender: TObject; var Key: Char);
  472. begin
  473.     if Not (Key in ['0'..'9', kBACKSPACE]) then
  474.         Key := #0;
  475. end;
  476.  
  477. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement