Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

Деревья1 / Unit1

.pas
Скачиваний:
6
Добавлен:
01.05.2014
Размер:
4.26 Кб
Скачать
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,unit2, StdCtrls, ComCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Button3: TButton;
OpenDialog1: TOpenDialog;
TreeView1: TTreeView;
TreeView2: TTreeView;
Label1: TLabel;
procedure ster1(Sender: TObject);
procedure step2(Sender: TObject);
procedure rez(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
T1,t2:binT;
f1,f:text;
k,i:integer;
f_in:Textfile;
equal:boolean;
fff:boolean;

implementation

{$R *.dfm}
function EnterBt:BinT;
{Vvod uzlov v KLP poradke}
var c:Char;
begin
Read(F1,c);
if c='/' then EnterBT:=NilBT
Else EnterBT:=ConsBT(c,EnterBT,EnterBT);
end;{EnterBT}

procedure ustupSpisok(b:BinT);
begin
if Null(b) then writeln(f,'/')
else begin
write(f,RootBT(b)); write(f,#10);
if not NullBT(RightBT(b)) then
begin
write(f,' ');
ustupSpisok(RightBT(b));
write(f,#8);write(f,#8);
end;
if not Null(LeftBT(b)) then
begin
write(f,#10);
write(f,' ');
ustupSpisok(LeftBT(b));
write(f,#8);write(f,#8);
end;
end;{else}
end;{UstupSpisok}

//===========================================================
//===========================================================
//===========================================================

procedure DrawBT(Cur:BinT;var i:Integer;var f:TextFile);
forward;

Procedure DrawLeft (Cur:BinT;i:Integer;var f:TextFile);
var
j: word;
begin
if (Cur.LSub<>nil) then
begin
Cur:=Cur.LSub;
for j:=1 to i do write(f,' ');
writeln(f,'L: '+Cur.Info);
if i>k then k:=i;
DrawBT(Cur,i,f);
end;
end;

Procedure DrawRight (Cur:BinT;i:integer;var f:TextFile);
var
j:word;
begin
if (Cur.RSub<>nil) then
begin
Cur:=Cur.RSub;
for j:=1 to i do write(f,' ');
writeln(f,'R: '+Cur.Info);
if i>k then k:=i;
DrawBT(cur,i,f);
end;
end;

procedure DrawBT(Cur:BinT;var i:integer;var f:TextFile);
begin
i:=i+1;
DrawLeft (Cur,i,f);
DrawRight(Cur,i,f);
end;

//===========================================================
//===========================================================
//===========================================================

procedure TForm1.ster1(Sender: TObject);
begin
if opendialog1.Execute then begin
assignfile(f1,opendialog1.FileName);
if proverka(f1) then begin
reset(f1);
t1:=enterbt;
closefile(f1);

k:=0;
i:=0;
AssignFile(f_in,'Bt.txt');
Rewrite(f_in);
writeln(f_in,'Root: '+t1.info);
DrawBT(t1,i,f_in);
CloseFile(f_in);
TreeView1.LoadFromFile('Bt.Txt');
DeleteFile('Bt.Txt');
Treeview1.FullExpand;
end else edit1.Text:=('Неправильная запись');
end;
end;

procedure TForm1.step2(Sender: TObject);
begin
if opendialog1.Execute then begin
assignfile(f1,opendialog1.FileName);
if proverka(f1) then begin
reset(f1);
t2:=enterbt;
closefile(f1);

k:=0;
i:=0;
AssignFile(f_in,'Bt.txt');
Rewrite(f_in);
writeln(f_in,'Root: '+t2.info);
DrawBT(t2,i,f_in);
CloseFile(f_in);
TreeView2.LoadFromFile('Bt.Txt');
DeleteFile('Bt.Txt');
Treeview2.FullExpand;
end else edit1.Text:=('Неправильная запись');
end;
end;

procedure TForm1.rez(Sender: TObject);
var rez:boolean;
begin
equal:=true;
fff:=true;
if (t1<>nil)and(t2<>nil) then begin
rez:=Compare(t1,t2);
if (rez and equal) then edit1.Text:=('Деревья подобны!') else edit1.Text:=('Деревья не подобны!');
end else edit1.Text:=('Одно из деревьев пусто! ');
end;

end.
Соседние файлы в папке Деревья1
  • #
    01.05.2014876 б5Proba.res
  • #
    01.05.201425 б6tree.txt
  • #
    01.05.20148.02 Кб5Unit1.dcu
  • #
    01.05.201451 б5Unit1.ddp
  • #
    01.05.20141.49 Кб5Unit1.dfm
  • #
    01.05.20144.26 Кб6Unit1.pas
  • #
    01.05.20145.43 Кб5Unit2.dcu
  • #
    01.05.20149.03 Кб5Unit2.pas