unit Umain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Buttons, Grids, ExtCtrls, UDerevo;

type
TForm1 = class(TForm)
Panel1: TPanel;
StringGrid1: TStringGrid;
bitkol: TBitBtn;
edkol: TEdit;
Label1: TLabel;
Panel2: TPanel;
TreeView1: TTreeView;
mmOutput: TMemo;
bbadd: TBitBtn;
prym: TBitBtn;
obrat: TBitBtn;
pokluchu: TBitBtn;
Panel3: TPanel;
edfind: TEdit;
Edit1: TEdit;
Edit2: TEdit;
Label2: TLabel;
Label3: TLabel;
bitadd: TBitBtn;
BitBtn1: TBitBtn;
edDelete: TEdit;
bbDelete: TBitBtn;
Panel4: TPanel;
Edit3: TEdit;
BBSolve: TBitBtn;
Label4: TLabel;
procedure FormCreate(Sender: TObject);
procedure bitkolClick(Sender: TObject);
procedure bbaddClick(Sender: TObject);
procedure prymClick(Sender: TObject);
procedure obratClick(Sender: TObject);
procedure pokluchuClick(Sender: TObject);
procedure bitaddClick(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure bbDeleteClick(Sender: TObject);
procedure BBSolveClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
prymoi = 1;
obratnyi = 2;
pokluchiku = 3;
var
Form1: TForm1;
Derevo : TTree;
k : integer;
bb : boolean;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
bb := false;
edkol.Text := '10';
K := 0;
derevo := TTree.Create();
with stringgrid1 do
begin
cells[0, 0] := 'Фамилия';
cells[1, 0] := 'Номер';
Cells[0, 1] := 'Бобров Д.В.';
Cells[1, 1] := '1050';
Cells[0, 2] := 'Воробьёва Ю.В.';
Cells[1, 2] := '1040';
Cells[0, 3] := 'Григорович А.А.';
Cells[1, 3] := '1060';
Cells[0, 4] := 'Давыденко О.П.';
Cells[1, 4] := '1055';
Cells[0, 5] := 'Ермаков К.С.';
Cells[1, 5] := '1100';
Cells[0, 6] := 'Кихилевич Е.В.';
Cells[1, 6] := '1030';
Cells[0, 7] := 'Кузнецов А.С.';
Cells[1, 7] := '1070';
Cells[0, 8] := 'Осипенко А.Д.';
Cells[1, 8] := '1020';
Cells[0, 9] := 'Панасюк И.А.';
Cells[1, 9] := '1110';
Cells[0, 10] := 'Русская Е.С.';
Cells[1, 10] := '1052';
end;
end;

procedure TForm1.bitkolClick(Sender: TObject);
var
N : integer;
begin
N := strtoint(edkol.text);
stringgrid1.RowCount := N + 1;
end;

procedure TForm1.bbaddClick(Sender: TObject);
var
tmp : Tinf;
i : integer;
N : integer;
begin
derevo.Clear();
mmOutput.Clear();
N := strtoint(edkol.text);
derevo.inf.FIO := stringgrid1.cells[0,1];
derevo.inf.nomer := strtoint(stringgrid1.Cells[1, 1]);
for i := 2 to N do
begin
tmp.nomer := strtoint(stringgrid1.cells[1, i]);
tmp.FIO := stringgrid1.Cells[0,i];
derevo.Add(tmp);
end;
TreeView1.Items.clear();
derevo.View(TreeView1);
TreeView1.FullExpand;
derevo.Write(mmOutput, prymoi);
bb := true;
end;

procedure TForm1.prymClick(Sender: TObject);
begin
mmOutput.clear();
Derevo.Write(mmOutput, prymoi);
end;

procedure TForm1.obratClick(Sender: TObject);
begin
mmOutput.Clear();
derevo.Write(mmOutput, obratnyi);
end;

procedure TForm1.pokluchuClick(Sender: TObject);
begin
mmOutput.Clear();
derevo.Write(mmOutput, pokluchiku);
end;

procedure TForm1.bitaddClick(Sender: TObject);
var
tmp : Tinf;
begin
tmp.nomer := strtoint(edit2.Text);
tmp.FIO := edit1.text;
derevo.Add(tmp);
TreeView1.Items.Clear();
mmOutput.Clear();
derevo.View(TreeView1);
derevo.Write(mmOutput, prymoi);
TreeView1.FullExpand;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
tmp : TTree;
key : integer;
begin
tmp := nil;
key := strtoint(edfind.text);
tmp := derevo.KeyFind(key);
if tmp <> nil then
MessageBox(0,(Pchar('По вашему запросу найден: ' + tmp.inf.fio + ' ' + inttostr(tmp.inf.nomer))),'',MB_OK)
else
MessageDlg('Проверь то что ты вводишь Человек - Молекула', mtWarning, mbYesNoCancel, 0);
end;


procedure TForm1.bbDeleteClick(Sender: TObject);
var
tmp : TTree;
key : integer;
pred : TTree;
tek : TTree;
b : boolean;
begin

pred := nil;
tek := nil;
key := strtoint(edDelete.Text);
pred := derevo.KeyFindPred(key); // содержит предыдущий элемент
tek := derevo.KeyFind(key); // Содержит то который нужно удалять
// НЕЛЬЗЯ УДАЛЯТЬ КОРЕНЬ ДЕРЕВА
if (tek = derevo) then
begin
MessageBox(0, 'Нельзя удалять Корень дерева ', 'Oшибка', MB_ICONERROR);
exit;
end;

// сама процедура удаления
if tek <> nil then
begin
if pred.L <> nil then
b := (pred.L.inf.nomer = key);
if pred.R <> nil then
b := not(pred.R.inf.nomer = key);
tek.Destroy();
if b = true then
pred.L := nil
else
pred.R := nil;
end
else
MessageBox(0,'Ничего не найдено','Попробуй еще раз',MB_ICONEXCLAMATION);
// ЗАКОНЧИЛИ УДАЛЕНИЕ

// РАСПЕЧАТЫВАЕМ УДАЛЕННОЕ ДЕРЕВО
mmOutput.clear();
TreeView1.Items.clear();
derevo.View(TreeView1);
derevo.Write(mmOutput, prymoi);
TreeView1.FullExpand;
b := true;
end;

procedure TForm1.BBSolveClick(Sender: TObject);
begin
derevo.Solve(edit3);
end;
end.
Соседние файлы в папке макс глубина, поиск удаление по клбючу
  • #
    15.06.20145.17 Кб12Uderevo.dcu
  • #
    15.06.20144.12 Кб12Uderevo.pas
  • #
    15.06.20144.11 Кб12Uderevo.~pas
  • #
    15.06.201410.59 Кб12Umain.dcu
  • #
    15.06.20145.62 Кб12Umain.dfm
  • #
    15.06.20145.43 Кб13Umain.pas
  • #
    15.06.20145.62 Кб12Umain.~dfm
  • #
    15.06.20145.42 Кб13Umain.~pas