Скачиваний:
8
Добавлен:
01.05.2014
Размер:
24.99 Кб
Скачать
// Copyright (c) 2004. All Rights Reserved.
// by Software Solusions, Inc. Saint-Petersburg, Russian Federation (812)xxx-xx-xx
// Written by Khomyakov Marat

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Menus, Mask, Buttons, ExtCtrls, StdCtrls, ComCtrls;

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;
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;
If bt.GetCur<>nil then
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.
Соседние файлы в папке Исследование бинарных деревьев
  • #
    01.05.20141.08 Кб8r.bmp
  • #
    01.05.20141.08 Кб8u.bmp
  • #
    01.05.201429.62 Кб8Unit1.dcu
  • #
    01.05.201451 б8Unit1.ddp
  • #
    01.05.201412.21 Кб8Unit1.dfm
  • #
    01.05.201424.99 Кб8Unit1.pas
  • #
    01.05.20147.21 Кб8Unit2.dcu
  • #
    01.05.201451 б8Unit2.ddp
  • #
    01.05.20147.05 Кб9Unit2.dfm
  • #
    01.05.20142.95 Кб8Unit2.pas
  • #
    01.05.20144.26 Кб8Unit3.dcu