Исследование бинарных деревьев / 1

Пояснительная записка к курсовой работе

Исходная постановка задачи:

Исследование Treap бинарных деревьев.

Анализ задачи:

Задача должна быть решена при помощи динамических структур данных, реализующих деревья. В роли входных данных выступает символьная последовательность, задающая добавленные и удаленные элементы дерева.

Формальная постановка задачи:

1. Исходные данные: Так как в роли входных данных выступает символьная последовательность, то единственным, что необходимо знать – это сама последовательность. Информационное поле для каждого элемента дерева имеет 5 полей: значение, ссылки на “сыновей”, ссылка на “отца” и приоритет элемента.

2. Ограничения на исходные данные: Ограничений на длину последовательности нет. Ограничения на элементы последовательности и их приоритеты: они не могут превышать 60000. Данные ограничения могут быть устранены или изменены использованием другого базового типа. Глубина дерева не должна превышать 65000.

3. Выходные данные: В роли выходных данных служит изображение дерева, либо ответ на поиск элемента в дереве.

4. Связь выходных данных с исходными данными: Прямой связи выходных данных с исходными нет.

Спецификация программы:

1. Исходные данные: Ограничения на входные данные рассматривались в ФПЗ, поэтому в данном разделе мы рассмотрим формат представления этих входных данных в файлах. Здесь и в дальнейшем используются только текстовые файлы. В файле должна содержаться последовательность в следующем формате(считывается только указанное в 1 строке количество операций):

i ключ приоритет

или

d ключ

Пример:

1-ая строка:15

2-ая строка:i 25 1

3-ая строка:d 15

2. Функции программы при обработке исключительных ситуаций: Во всех случаях будет выдано соответствующее сообщение.

Сценарий диалога:

1. Общая схема диалога:

Вид интерфейса программы:

Интерфейс программы прост и понятен в обращении. Для удобства пользования и безопасности работы программы доступность клавиш и пунктов меню ограничена на разных стадиях работы программы. В любой момент работы программы пользователь может перезагрузить программу из главного меню и начать работу заново.

Рис. 1

Общий вид окна программы

Программа имеет разветвленную систему меню, что видно из следующих трех рисунков.

Рис. 2, 3, 4

Меню программы.

Иерархия меню может быть представлена в графическом виде:

Также в любой момент времени доступны такие пункты меню как: “О программе”, “Помощь”, “Выход”, “Записать входной файл”, “Перезапуск’.

Разработка структур данных и алгоритмов:

Алгоритмы:

Для удобства тестирования программы, в ней присутствуют два вида ввода данных. Решение данной задачи можно разбить на этапы, которые могут быть реализованы и отлажены по отдельности, но в определенном порядке.

1. Введение последовательности из файла или дерева непосредственно при работе программы

2. Обработка введенных команд

3. Проверка свойств пирамидальности дерева и соответствия его структуры структуре дерева поиска

4. Вывод результатов символьной последовательностью

Дополнительные задачи:

• также программа должна иметь удобный и доступный в освоении интерфейс

• в программе должны быть учтены всевозможные нестандартные ситуации и крайние значения входных данных

• при возможности размер исполняемого файла должен быть уменьшен, путем исключения неиспользуемых, стандартных библиотек

• реализовать графический вывод деревьев с возможность редактирования

Модель структур данных:

Рассмотрим модель элемента дерева на примере.

Каждый элемент с 5 полями имеет следующую структуру:

Интерфейс модуля программы:

type

tInfo=word;

tGlub=word;

tPRT=word;

//--------------------------------

tNode=class

Private

up:tNode;

val:tInfo;

prt:tPRT;

LSub:tNode;

RSub:tNode;

public

constructor Create(up1:tNode;val1:tInfo;prt1:tPRT;LSub1,RSub1:tNode);

function Getval():tInfo;

procedure SetVal(zn:tInfo);

function Getprt():tPRT;

procedure Setprt(zn:tPRT);

function GetLSub():tNode;

procedure SetLSub(zn:tNode);

function GetRSub():tNode;

procedure SetRSub(zn:tNode);

function GetUp():tNode;

procedure SetUp(zn:tNode);

destructor Free();

end;

//--------------------------------

tBT=class

Private

BTree:tNode;

Cur:tNode;

Public

constructor Create(btree1,cur1:tNode);

function GetBTree():tNode;

procedure SetBTree(zn:tNode);

function GetCur():tNode;

procedure SetCur(zn:tNode);

destructor Free();

procedure GoBOT();

function NullT():boolean;

procedure GoUp();

procedure GoLSub();

Procedure GoRSub();

end;

//--------------------------------

Procedure PaintBT(Bt:tBT;mash:real);

Procedure MaxGlub(Bt:tBT;const cur_el:tNode;Cur_glub:tGlub);

Procedure AddEl(Var BT:tBT;x:tInfo;prt:tPRT);

Procedure Addel1(Var bt:tBT;x:tInfo;prt:tPRT);

Procedure Sv_vo(Var bt:tBT);

Procedure RotateR(Var bt:tBT);

Procedure RotateL(Var bt:tBT);

Procedure ReadBT(Var bt:tBT;Var vxod:text);

procedure Searchel(Var bt:tBT;x:tInfo);

procedure udalenie(Var bt:tBT;x:tInfo);

Procedure Windows();

Procedure Enab(code:byte);

Таблица параметров процедур и функций программы:

Имя процедуры (функции)	Назначение	Параметры			Внешние эффекты
		Входные	Выходные	Транзитные
ReadBT	Считывает бинарное дерево	Vxod	Bt	-	-
WriteBT	Записывает бинарное дерево	Bt	Vixod	-	-
PaintBt	Рисует бинарное дерево	Bt	-	-	Изображение дерева
Sv_vo	Проверяет свойство пирамидальности	Bt	-	-	-
RotateR(L)	Перекрутка	Bt	-	-	-
SearchEl	Поиск элемента	Bt, x	-	-	Указывает на элемент и выводит данные об элементе
udalenie	Удаление элемента	Bt, x	-	-	-
Addel	Добавление элемента	Bt, x, prt	-	-	-

Текст программы на Delphi 7 Enterprise:

program Project2;

uses

Forms,

Unit1 in 'Unit1.pas' {MainForm},

Unit2 in 'Unit2.pas' {Vvod},

Unit3 in 'Unit3.pas' {About};

{$R *.res}

begin

Application.Initialize;

Application.Title := 'Курсач ч.1';

Application.CreateForm(TMainForm, MainForm);

Application.CreateForm(TVvod, Vvod);

Application.CreateForm(TAbout, About);

mashT:=1;

BT:=tBT.Create(nil,nil);

Application.Run;

end.

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, ExtCtrls, StdCtrls, OleCtnrs, ComCtrls, ToolWin, ImgList,

Mask, Buttons;

type

tInfo=word;

tGlub=word;

tPRT=word;

//--------------------------------

tNode=class

Private

up:tNode;

val:tInfo;

prt:tPRT;

LSub:tNode;

RSub:tNode;

public

constructor Create(up1:tNode;val1:tInfo;prt1:tPRT;LSub1,RSub1:tNode);

function Getval():tInfo;

procedure SetVal(zn:tInfo);

function Getprt():tPRT;

procedure Setprt(zn:tPRT);

function GetLSub():tNode;

procedure SetLSub(zn:tNode);

function GetRSub():tNode;

procedure SetRSub(zn:tNode);

function GetUp():tNode;

procedure SetUp(zn:tNode);

destructor Free();

end;

//--------------------------------

tBT=class

Private

BTree:tNode;

Cur:tNode;

Public

constructor Create(btree1,cur1:tNode);

function GetBTree():tNode;

procedure SetBTree(zn:tNode);

function GetCur():tNode;

procedure SetCur(zn:tNode);

destructor Free();

procedure GoBOT();

function NullT():boolean;

procedure GoUp();

procedure GoLSub();

Procedure GoRSub();

end;

//--------------------------------

TMainForm = class(TForm)

MainMenu1: TMainMenu;

Timer1: TTimer;

OpenDialog1: TOpenDialog;

PaintBox1: TPaintBox;

ScrollBox1: TScrollBox;

GroupBox1: TGroupBox;

ImageList1: TImageList;

N1: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

Open1: TMenuItem;

N2: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

N12: TMenuItem;

N13: TMenuItem;

N19: TMenuItem;

N20: TMenuItem;

N21: TMenuItem;

N22: TMenuItem;

N23: TMenuItem;

N24: TMenuItem;

N25: TMenuItem;

N26: TMenuItem;

N29: TMenuItem;

N30: TMenuItem;

N14: TMenuItem;

N15: TMenuItem;

N16: TMenuItem;

N17: TMenuItem;

N18: TMenuItem;

N27: TMenuItem;

N28: TMenuItem;

N210: TMenuItem;

N31: TMenuItem;

N32: TMenuItem;

N33: TMenuItem;

N34: TMenuItem;

N35: TMenuItem;

GroupBox2: TGroupBox;

MaskEdit1: TMaskEdit;

Button1: TButton;

GroupBox3: TGroupBox;

GroupBox4: TGroupBox;

Label1: TLabel;

MaskEdit2: TMaskEdit;

MaskEdit3: TMaskEdit;

Button2: TButton;

GroupBox5: TGroupBox;

Label2: TLabel;

Edit2: TEdit;

UpDown1: TUpDown;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

GroupBox6: TGroupBox;

SpeedButton1: TSpeedButton;

SpeedButton2: TSpeedButton;

SpeedButton3: TSpeedButton;

N36: TMenuItem;

GroupBox7: TGroupBox;

Button3: TButton;

MaskEdit4: TMaskEdit;

CheckBox1: TCheckBox;

N37: TMenuItem;

CheckBox2: TCheckBox;

N38: TMenuItem;

N39: TMenuItem;

Label3: TLabel;

Edit1: TEdit;

procedure Timer1Timer(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure ScrollBox1CanResize(Sender: TObject; var NewWidth,

NewHeight: Integer; var Resize: Boolean);

procedure ScrollBox1Click(Sender: TObject);

procedure PaintBox1Click(Sender: TObject);

procedure Open1Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure N3Click(Sender: TObject);

procedure N7Click(Sender: TObject);

procedure N2Click(Sender: TObject);

procedure N11Click(Sender: TObject);

procedure N20Click(Sender: TObject);

procedure N21Click(Sender: TObject);

procedure N22Click(Sender: TObject);

procedure N30Click(Sender: TObject);

procedure N23Click(Sender: TObject);

procedure N16Click(Sender: TObject);

procedure N18Click(Sender: TObject);

procedure N27Click(Sender: TObject);

procedure N28Click(Sender: TObject);

procedure N210Click(Sender: TObject);

procedure N15Click(Sender: TObject);

procedure N33Click(Sender: TObject);

procedure N35Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure SpeedButton1Click(Sender: TObject);

procedure SpeedButton3Click(Sender: TObject);

procedure SpeedButton2Click(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);

procedure Edit2Change(Sender: TObject);

procedure N36Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure N37Click(Sender: TObject);

procedure CheckBox1Click(Sender: TObject);

procedure N39Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

MainForm: TMainForm;

Vxod,vixod:text;

BT:tBT;

mashT:real;

{max:boolean;}

max_glub:tGlub;

Procedure PaintBT(Bt:tBT;mash:real);

Procedure MaxGlub(Bt:tBT;const cur_el:tNode;Cur_glub:tGlub);

Procedure AddEl(Var BT:tBT;x:tInfo;prt:tPRT);

Procedure Addel1(Var bt:tBT;x:tInfo;prt:tPRT);

Procedure Sv_vo(Var bt:tBT);

Procedure RotateR(Var bt:tBT);

Procedure RotateL(Var bt:tBT);

Procedure ReadBT(Var bt:tBT;Var vxod:text);

procedure Searchel(Var bt:tBT;x:tInfo);

procedure udalenie(Var bt:tBT;x:tInfo);

Procedure Windows();

Procedure Enab(code:byte);

implementation

uses Unit2, Unit3;

{$R *.dfm}

{-----------------------------------------

начало методов}

constructor tNode.Create(up1:tNode;val1:tInfo;prt1:tPRT;LSub1,RSub1:tNode);

begin

up:=up1;

val:=val1;

prt:=prt1;

LSub:=LSub1;

RSub:=RSub1;

end;

function tNode.GetVal():tInfo;

begin

getval:=val;

end;

procedure tNode.SetVal(zn:tInfo);

begin

val:=zn;

end;

function tNode.Getprt():tPRT;

begin

getprt:=prt;

end;

procedure tNode.Setprt(zn:tPRT);

begin

prt:=zn;

end;

function tNode.GetLSub():tNode;

begin

getLSub:=LSub;

end;

procedure tNode.SetLSub(zn:tNode);

begin

LSub:=zn;

end;

function tNode.GetRSub():tNode;

begin

getRSub:=RSub;

end;

procedure tNode.SetRSub(zn:tNode);

begin

RSub:=zn;

end;

function tNode.GetUp():tNode;

Begin

getup:=up;

end;

procedure tNode.SetUp(zn:tNode);

Begin

up:=zn;

end;

destructor tNode.Free();

Begin

If LSub<>nil then LSub.Free;

If RSub<>nil then RSub.Free;

end;

constructor tBT.Create(BTree1,cur1:tNode);

begin

BTree:=Btree1;

cur:=cur1;

end;

function tBT.GetBTree():tNode;

begin

getbtree:=btree;

end;

procedure tBT.SetBTree(zn:tNode);

begin

btree:=zn;

end;

function tBT.GetCur():tNode;

Begin

getcur:=cur;

end;

procedure tBT.SetCur(zn:tNode);

Begin

cur:=zn;

end;

destructor tBT.Free();

Begin

BTree.Free;

cur:=nil;

BTree:=nil;

end;

procedure tBT.GoBOT();

Begin

cur:=BTree;

end;

function tBT.NullT():boolean;

Begin

NullT:=BTree=nil;

end;

procedure tBT.GoUp();

Begin

If Cur.Up<>nil then

Cur:=Cur.Up;

end;

procedure tBT.GoLSub();

Begin

If Cur.LSub<>nil then

Cur:=Cur.LSub;

end;

procedure tBT.GoRSub();

Begin

If Cur.RSub<>nil then

Cur:=Cur.RSub;

end;

{-----------------------------------------

конец методов}

{-----------------------------------------

начало моего}

Procedure PaintBT(Bt:tBT;mash:real);

Var dlin:LongInt;

g:tGlub;

h:LongInt;

curx,cury:LongInt;

function HeWi(Gl:tGlub;dlin:LongInt;mash:real):LongInt;

var i:word; sum:real;

begin

sum:=0;

For i:=1 To Gl+1 Do sum:=sum+((dlin*mash)/(exp(Ln(2)*i)));

HeWi:=Trunc(sum);

end;

procedure DrowRecur(Xx,Yy:integer; Ccur:TNode; count:integer; dlin:integer;mash:real);

var coef:integer;

list:boolean;

cvet:Tcolor;

procedure DrowLine(x1,y1,x2,y2:integer);

var poin:array [1..2] of TPoint;

begin

with mainForm.PaintBox1.Canvas do

begin

Brush.Color:=clBlack;

poin[1].X:=x1;

poin[1].y:=y1;

poin[2].X:=x2;

poin[2].y:=y2;

Polyline(poin);

end;

end;

procedure DrowEl(X,Y:integer; val1:tInfo; prt1:tPRT; colorium:TColor; list:boolean;mash:real);

Var a,b:integer;

begin

with MainForm.PaintBox1.Canvas do

begin

Brush.Color:=colorium;

a:=Trunc(8*mash);

b:=Trunc(8*mash);

If list then

Rectangle(x-a,y-b,x+a,y+b)

else

Ellipse(x-a,y-b,x+a,y+b);

Font.Name:='Arial';

Font.Size:=2+Trunc(mash*5);

Font.Style:=[];

Font.Color:=clBlack;

TextOut(x-3*(a div 8),y-3*(b div 4),inttostr(val1));

TextOut(x-3*(a div 8)+10*(a div 8),y-3*(b div 4)+10*(b div 8),floattostr(prt1));

end;

end;

begin

inc(count);

coef:=Trunc((dlin*mash)/(exp(Ln(2)*count)));

If Ccur.GetLSub<>nil Then

begin

DrowLine(Xx,Yy,Xx-coef,Yy+coef);

DrowRecur(Xx-coef,Yy+coef,Ccur.GetLSub,count,dlin,mash);

end;

If Ccur.GetRSub<>nil Then

begin

DrowLine(Xx,Yy,Xx+coef,Yy+coef);

DrowRecur(Xx+coef,Yy+coef,Ccur.GetRSub,count,dlin,mash);

end;

{If (ccur.GetLSub=nil) and (ccur.GetRSub=nil) then

Begin

list:=true;

cvet:=clRed;

end

else

Begin}

list:=false;

cvet:=clLime;

{end;}

If ccur<>bt.GetCur Then

DrowEl(Xx,Yy,Ccur.GetVal,ccur.Getprt,cvet,list,mash)

else

Begin

DrowEl(Xx,Yy,Ccur.GetVal,ccur.Getprt,clYellow,list,mash);

curx:=Xx-trunc(8*masht)-253;

cury:=Yy-trunc(8*masht)-209;

end;

end;

{рисуем дерево}

begin

If Trim(mainform.Edit2.Text)<>'' then

masht:=StrToInt(Trim(mainform.Edit2.Text))/100;

If (bt.GetBTree<>nil) and (mainform.CheckBox1.Checked) then

Begin

maxglub(bt,bt.BTree,0);

g:=Max_glub+1;

max_glub:=0;

dlin:=Trunc(8*(exp(Ln(2)*g)));

h:=HeWi(g,dlin,mash);

mainform.PaintBox1.Height:=h+Trunc(23*mash)+6;

mainform.PaintBox1.Width:=h*2+Trunc(9*mash)+6;

mainform.PaintBox1.Repaint;

DrowRecur(MainForm.PaintBox1.Width div 2,Trunc(10*mash)+5,bt.GetBtree,0,dlin,mash);

If mainform.CheckBox2.Checked then

Begin

mainform.ScrollBox1.VertScrollBar.Position:=cury;

mainform.ScrollBox1.HorzScrollBar.Position:=curx;

end;

end

else

mainform.PaintBox1.Repaint;

mainform.updown1.Position:=round(masht*100);

end;

Procedure MaxGlub(BT:tBt;const cur_el:tNode;Cur_glub:tGlub);

Begin

If Cur_glub>max_glub then max_glub:=cur_glub;

If Cur_el.LSub<>nil then

Begin

maxglub(bt,cur_el.LSub,cur_glub+1);

end;

If cur_el.RSub<>nil then

Begin

maxglub(bt,cur_el.RSub,cur_glub+1);

end;

end;

Procedure AddEl(Var BT:tBT;x:tInfo;prt:tPRT);

Var cur_el:tNode;

Begin

If BT.BTree=nil then

Begin

bt.SetBTree(tNode.Create(nil,x,prt,nil,nil));

bt.SetCur(bt.GetBTree);

end

else

Begin

BT.GoBOT;

If BT.Cur.val<x then

if bt.Cur.RSub<>nil then

Begin

bt.GoRSub;

addel1(bt,x,prt);

end

else

Begin

cur_el:=tNode.Create(bt.Cur,x,prt,nil,nil);

bt.Cur.SetRSub(cur_el);

sv_vo(bt);

end

else

if bt.Cur.val>x then

If bt.Cur.LSub<>nil then

begin

bt.GoLSub;

addel1(bt,x,prt);

end

else

begin

cur_el:=tNode.Create(bt.Cur,x,prt,nil,nil);

bt.Cur.SetLSub(cur_el);

sv_vo(bt);

end

else {уже есть x}

Begin

bt.Cur.prt:=bt.Cur.prt+prt;

bt.GoUp;

sv_vo(bt);

end;

end;

End;

Procedure Addel1(Var bt:tBT;x:tInfo;prt:tPRT);

Var cur_el:tNode;

Begin

If BT.Cur.val<x then

if bt.Cur.RSub<>nil then

Begin

bt.GoRSub;

addel1(bt,x,prt);

end

else

Begin

cur_el:=tNode.Create(bt.Cur,x,prt,nil,nil);

bt.Cur.SetRSub(cur_el);

sv_vo(bt);

end

else

if bt.Cur.val>x then

If bt.Cur.LSub<>nil then

begin

bt.GoLSub;

addel1(bt,x,prt);

end

else

begin

cur_el:=tNode.Create(bt.Cur,x,prt,nil,nil);

bt.Cur.SetLSub(cur_el);

sv_vo(bt);

end

else {уже есть x}

Begin

bt.Cur.prt:=bt.Cur.prt+prt;

bt.GoUp;

sv_vo(bt);

end;

end;

Procedure Sv_vo(Var bt:tBT);

Begin

If mainform.N29.Checked then

Begin

paintbt(bt,masht);

MessageBox(mainform.Handle,'Дальше','Пошагово',MB_OK);

end;

If bt.Cur<>nil then

Begin

If (bt.Cur.RSub<>nil) and (bt.Cur.prt<bt.Cur.RSub.prt) then

Begin

RotateL(bt);

if bt.Cur<>bt.BTree then

Begin

bt.GoUp;

sv_vo(bt);

end;

end;

If (bt.Cur.LSub<>nil) and (bt.Cur.prt<bt.Cur.LSub.prt) then

Begin

RotateR(bt);

if bt.Cur<>bt.BTree then

Begin

bt.GoUp;

sv_vo(bt);

end;

end;

end;

end;

Procedure RotateR(Var bt:tBT);

Var cur_el,up:tNode;

Begin

cur_el:=bt.Cur.LSub;

If bt.Cur.up<>nil then

if bt.Cur=bt.Cur.up.LSub then

bt.Cur.up.SetLSub(cur_el)

else

bt.Cur.up.SetRSub(cur_el);

up:=bt.Cur.up;

bt.Cur.SetUp(cur_el);

cur_el.SetUp(up);

bt.Cur.SetLSub(cur_el.RSub);

If bt.Cur.LSub<>nil then

bt.Cur.LSub.SetUp(bt.Cur);

{If cur_el.RSub<>nil then}

cur_el.SetRSub(bt.Cur);

If bt.Cur=bt.BTree then

bt.SetBTree(cur_el);

bt.SetCur(cur_el);

end;

Procedure RotateL(Var bt:tBT);

Var cur_el,up:tNode;

Begin

cur_el:=bt.Cur.RSub;

If bt.Cur.up<>nil then

if bt.Cur=bt.Cur.up.LSub then

bt.Cur.up.SetLSub(cur_el)

else

bt.Cur.up.SetRSub(cur_el);

up:=bt.Cur.up;

bt.Cur.SetUp(cur_el);

cur_el.SetUp(up);

bt.Cur.SetRSub(cur_el.LSub);

If bt.Cur.RSub<>nil then

bt.Cur.RSub.SetUp(bt.Cur);

{If cur_el.LSub<>nil then}

cur_el.SetLSub(bt.Cur);

If bt.Cur=bt.BTree then

bt.SetBTree(cur_el);

bt.SetCur(cur_el);

end;

Procedure ReadBT(Var bt:tBT;Var vxod:text);

Var kolvo:word;

x:tInfo;

prt:tPRT;

tmp:char;

Begin

readln(vxod,kolvo);

While (kolvo<>0) and (not EOF(vxod)) do

Begin

read(vxod,tmp);

case tmp of

'i':

Begin

read(vxod,x,prt);

addel(bt,x,prt);

end;

'd':

Begin

read(vxod,x);

udalenie(bt,x);

end;

end;

kolvo:=kolvo-1;

readln(vxod);

end;

end;

procedure Searchel(Var bt:tBT;x:tInfo);

Begin

If bt.Cur.Getval<x then

If bt.Cur.RSub<>nil then

Begin

bt.GoRSub;

searchel(bt,x);

end

else bt.SetCur(nil)

else

If bt.Cur.Getval>x then

If bt.Cur.LSub<>nil then

Begin

bt.GoLSub;

searchel(bt,x);

end

else bt.SetCur(nil)

end;

procedure udalenie(Var bt:tBT;x:tInfo);

Var tmp,tmp1:tNode;

{Procedure golevoesprava(Var bt:tBT);

Begin

tmp.up.LSub:=bt.Cur.LSub;

If bt.cur.lsub<>nil then

bt.cur.lsub.up:=bt.cur.up;

bt.GoUp;

If bt.Cur.RSub<>nil then

Begin

bt.GoRSub;

While bt.Cur.LSub<>nil do

bt.GoLSub;

bt.Cur.LSub:=tmp.RSub;

If tmp.rsub<>nil then

tmp.rsub.up:=bt.cur;

bt.GoLSub;

end

else

Begin

bt.Cur.RSub:=tmp.RSub;

If tmp.rsub<>nil then

tmp.rsub.up:=bt.cur;

bt.GoRSub;

end;

tmp.Destroy;

end;

Procedure gopravoesleva(Var bt:tBT);

Begin

tmp.up.RSub:=bt.Cur.RSub;

If bt.cur.rsub<>nil then

bt.cur.rsub.up:=bt.cur.up;

bt.GoUp;

If bt.Cur.LSub<>nil then

Begin

bt.GoLSub;

While bt.Cur.RSub<>nil do

bt.GoRSub;

bt.Cur.RSub:=tmp.LSub;

If tmp.rsub<>nil then

tmp.rsub.up:=bt.cur;

bt.GoRSub;

end

else

Begin

bt.Cur.LSub:=tmp.LSub;

If tmp.rsub<>nil then

tmp.rsub.up:=bt.cur;

bt.GoLSub;

end;

tmp.Destroy;

end;

Procedure goprikorne(Var bt:tBT);

Begin

If (tmp.LSub<>nil) and (tmp.RSub<>nil) then

Begin

bt.BTree:=tmp.LSub;

bt.GoBOT;

While bt.Cur.RSub<>nil do

bt.GoRSub;

bt.Cur.RSub:=tmp.RSub;

tmp.RSub.up:=bt.Cur;

bt.btree.up:=nil;

end

else

if (tmp.LSub=nil) and (tmp.RSub=nil) then

Begin

bt.BTree:=nil;

bt.Cur:=nil;

tmp.Destroy;

end

else

if tmp.RSub<>nil then

Begin

bt.BTree:=tmp.RSub;

bt.GoBOT;

bt.btree.up:=nil;

tmp.Destroy;

end

else

Begin

bt.BTree:=tmp.LSub;

bt.GoBOT;

bt.btree.up:=nil;

tmp.Destroy;

end;

end;

Begin

bt.GoBOT;

searchel(bt,x);

If (bt.GetCur=nil) then

MessageBox(mainform.Handle,'Не найден','Внимание',MB_OK)

else

Begin

If bt.Cur<>bt.BTree then

Begin

tmp:=bt.Cur;

If bt.Cur.up.LSub=bt.Cur then

golevoesprava(bt)

else

gopravoesleva(bt);

bt.GoUp;

sv_vo(bt);

end

else

Begin

tmp:=bt.Cur;

goprikorne(bt);

sv_vo(bt);

end;

PaintBT(bt,masht);

end;

end;}

Procedure Next_el(Var Bt:tbt;Var tmp1:tNode);

Var x,y:tNode;

Begin

x:=bt.Cur;

If x.RSub<>nil then

Begin

y:=x.RSub;

While y.LSub<>nil do

y:=y.LSub;

end

else

Begin

y:=x.up;

While (y<>nil) and (x=y.RSub) do

Begin

x:=y;

y:=y.up;

end;

end;

tmp1:=y;

end;

Begin

bt.GoBOT;

searchel(bt,x);

If (bt.GetCur=nil) then

Begin

MessageBox(mainform.Handle,'Не найден','Внимание',MB_OK);

bt.gobot;

end

else

Begin

if (bt.Cur.LSub=nil) or (bt.Cur.RSub=nil) then

tmp:=bt.Cur

else

Begin

next_el(bt,tmp1);

tmp:=tmp1;

end;

if tmp.LSub<>nil then

tmp1:=tmp.LSub

else

tmp1:=tmp.RSub;

if tmp1<>nil then

tmp1.up:=tmp.up;

if tmp.up=nil then

bt.BTree:=tmp1

else

if tmp=tmp.up.LSub then

tmp.up.LSub:=tmp1

else

tmp.up.RSub:=tmp1;

If bt.Cur<>tmp then

Begin

bt.Cur.val:=tmp.val;

bt.Cur.prt:=tmp.prt;

sv_vo(bt);

end

else

Begin

if bt.Btree=nil then bt.GoBOT

else bt.Cur:=tmp.up;

end;

tmp.Destroy;

PaintBT(bt,masht);

end;

end;

Procedure Windows();

Begin

end;

Procedure Enab(code:byte);

Begin

case code of

0:{удачное открытие}

Begin

mainform.N2.Enabled:=true;

mainform.n30.Enabled:=true;

mainform.n3.Enabled:=true;

mainform.n23.Enabled:=false;

mainform.open1.enabled:=false;

end;

1:{обработать}

Begin

mainform.n30.Enabled:=false;

mainform.n3.Enabled:=false;

mainform.n19.Enabled:=true;

mainform.n33.Enabled:=true;

mainform.n23.Enabled:=true;

end;

2:{добавить элемент}

Begin

mainform.open1.Enabled:=false;

mainform.n3.Enabled:=false;

mainform.n19.Enabled:=true;

mainform.n33.Enabled:=true;

end;

3:{перезапуск}

Begin

mainform.open1.Enabled:=true;

mainform.n2.Enabled:=false;

mainform.n30.Enabled:=false;

mainform.n3.Enabled:=false;

mainform.n23.Enabled:=true;

mainform.n19.Enabled:=false;

mainform.n33.Enabled:=false;

end;

else

Begin

end;

end;

end;

{-----------------------------------------

конец моего}

procedure TMainForm.Timer1Timer(Sender: TObject);

Var s:string;

i:byte;

begin

s:=MainForm.Caption;

s:=s+s[1];

For i:=1 to length(s) do

s[i]:=s[i+1];

MainForm.Caption:=s;

end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);

begin

If opendialog1.FileName<>'' then closefile(vxod);

end;

procedure TMainForm.ScrollBox1CanResize(Sender: TObject; var NewWidth,

NewHeight: Integer; var Resize: Boolean);

begin

If (paintbox1.Height<>413) or (paintbox1.Width<>500) then

paintBT(bt,masht);

end;

procedure TMainForm.ScrollBox1Click(Sender: TObject);

begin

paintbt(bt,masht);

end;

procedure TMainForm.PaintBox1Click(Sender: TObject);

begin

paintbt(bt,masht);

end;

procedure TMainForm.Open1Click(Sender: TObject);

begin

If opendialog1.execute and FileExists(OpenDialog1.FileName)

Then

Begin

AssignFile(vxod,OpenDialog1.FileName);

Reset(vxod);

enab(0);

end;

end;

procedure TMainForm.N4Click(Sender: TObject);

begin

mainform.Close;

end;

procedure TMainForm.N3Click(Sender: TObject);

begin

readbt(bt,vxod);

paintbt(bt,masht);

enab(1);

end;

procedure TMainForm.N7Click(Sender: TObject);

begin

vvod.Show;

mainform.Enabled:=false;

vvod.Caption:='Создание входного файла';

vvod.BitBtn1.Visible:=true;

vvod.Edit1.Visible:=false;

vvod.Edit2.Visible:=false;

vvod.Button1.Visible:=false;

vvod.UpDown1.Visible:=false;

vvod.Memo1.ReadOnly:=false;

vvod.Memo1.Clear;

end;

procedure TMainForm.N2Click(Sender: TObject);

begin

vvod.Show;

mainform.Enabled:=false;

vvod.Caption:='Входной файл';

vvod.BitBtn1.Visible:=false;

vvod.Edit1.Visible:=false;

vvod.Edit2.Visible:=false;

vvod.Button1.Visible:=false;

vvod.UpDown1.Visible:=false;

vvod.Memo1.ReadOnly:=true;

vvod.Memo1.Lines.LoadFromFile(opendialog1.FileName);

end;

procedure TMainForm.N11Click(Sender: TObject);

begin

about.Show;

mainform.Enabled:=false;

end;

procedure TMainForm.N20Click(Sender: TObject);

begin

bt.GoUp;

paintbt(bt,masht);

end;

procedure TMainForm.N21Click(Sender: TObject);

begin

bt.GoLSub;

paintbt(bt,masht);

end;

procedure TMainForm.N22Click(Sender: TObject);

begin

bt.GoRSub;

paintbt(bt,masht);

end;

procedure TMainForm.N30Click(Sender: TObject);

begin

vvod.show;

mainform.Enabled:=false;

vvod.Caption:='Редактирование входного файла';

vvod.BitBtn1.Visible:=true;

vvod.Edit1.Visible:=false;

vvod.Edit2.Visible:=false;

vvod.Button1.Visible:=false;

vvod.UpDown1.Visible:=false;

vvod.Memo1.ReadOnly:=false;

vvod.Memo1.Lines.LoadFromFile(opendialog1.FileName);

end;

procedure TMainForm.N23Click(Sender: TObject);

begin

if n23.Checked then

Begin

groupbox4.Visible:=true;

end

else

groupbox4.Visible:=false;

end;

procedure TMainForm.N16Click(Sender: TObject);

begin

if n16.Checked then

Begin

groupbox5.Visible:=true;

end

else

groupbox5.Visible:=false;

end;

procedure TMainForm.N18Click(Sender: TObject);

begin

mainform.edit2.Text:=inttostr(round(masht*100)+1);

paintbt(bt,masht);

end;

procedure TMainForm.N27Click(Sender: TObject);

begin

mainform.edit2.Text:=inttostr(round(masht*100)+1);

paintbt(bt,masht);

end;

procedure TMainForm.N28Click(Sender: TObject);

begin

mainform.edit2.Text:=inttostr(round(masht*200));

paintbt(bt,masht);

end;

procedure TMainForm.N210Click(Sender: TObject);

begin

mainform.edit2.Text:=inttostr(round(masht*50));

paintbt(bt,masht);

end;

procedure TMainForm.N15Click(Sender: TObject);

begin

if n15.Checked then

groupbox6.Visible:=true

else

groupbox6.Visible:=false;

end;

procedure TMainForm.N33Click(Sender: TObject);

begin

if n33.Checked then

Begin

groupbox2.Visible:=true;

end

else

groupbox2.Visible:=false;

end;

procedure TMainForm.N35Click(Sender: TObject);

begin

if not bt.NullT then

Begin

bt.Free;

bt:=tBT.Create(nil,nil);

end;

paintbt(bt,masht);

enab(3);

end;

procedure TMainForm.Button2Click(Sender: TObject);

Var x:tInfo;

prt:tPRT;

begin

x:=strtoint(maskedit2.Text);

prt:=strtoint(maskedit3.Text);

addel(bt,x,prt);

paintbt(bt,masht);

enab(2);

end;

procedure TMainForm.SpeedButton1Click(Sender: TObject);

begin

bt.GoLSub;

paintbt(bt,masht);

end;

procedure TMainForm.SpeedButton3Click(Sender: TObject);

begin

bt.GoUp;

paintbt(bt,masht);

end;

procedure TMainForm.SpeedButton2Click(Sender: TObject);

begin

bt.GoRSub;

paintbt(bt,masht);

end;

procedure TMainForm.BitBtn1Click(Sender: TObject);

begin

mainform.edit2.Text:=inttostr(round(masht*200));

paintbt(bt,masht);

end;

procedure TMainForm.BitBtn2Click(Sender: TObject);

begin

mainform.edit2.Text:=inttostr(round(masht*50));

paintbt(bt,masht);

end;

procedure TMainForm.UpDown1Click(Sender: TObject; Button: TUDBtnType);

begin

paintbt(bt,mashT);

end;

procedure TMainForm.Edit2Change(Sender: TObject);

begin

If Trim(Edit2.Text)<>'' Then begin

UpDown1.Position:=StrToInt(Trim(Edit2.Text));

paintbt(bt,masht);

end;

end;

procedure TMainForm.N36Click(Sender: TObject);

begin

if n36.Checked then

Begin

groupbox7.Visible:=true;

end

else

groupbox7.Visible:=false;

end;

procedure TMainForm.Button3Click(Sender: TObject);

Var x:tInfo;

begin

x:=strtoint(maskedit4.Text);

udalenie(bt,x);

end;

procedure TMainForm.Button1Click(Sender: TObject);

Var x:tInfo;

begin

x:=strtoint(maskedit1.text);

bt.GoBOT;

Searchel(bt,x);

If bt.GetCur=nil then

Begin

MessageBox(mainform.Handle,'Не найден','Внимание',MB_OK);

edit1.Clear;

end

else

Begin

PaintBT(bt,masht);

edit1.Text:=inttostr(bt.Cur.prt);

end;

end;

procedure TMainForm.N37Click(Sender: TObject);

begin

bt.GoBOT;

PaintBT(bt,masht);

end;

procedure TMainForm.CheckBox1Click(Sender: TObject);

begin

if checkbox1.Checked then

checkbox2.enabled:=true

else

checkbox2.enabled:=false;

end;

procedure TMainForm.N39Click(Sender: TObject);

begin

vvod.Show;

mainform.Enabled:=false;

vvod.Caption:='Генерация входного файла';

vvod.BitBtn1.Visible:=false;

vvod.Edit1.Visible:=true;

vvod.Edit2.Visible:=true;

vvod.Button1.Visible:=true;

vvod.UpDown1.Visible:=true;

vvod.Memo1.ReadOnly:=true;

vvod.Memo1.Clear;

end;

end.

unit Unit2;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,