Деревья1 / Lab03 / tree

unit tree;

interface

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

const NilBT=nil;
type
tInfo=Char;
tLink=^tNode;
tNode= record
Val: tInfo;
LT,RT,Father: tLink;
end;

tBinT = class
private
Root:tLink;
Data:tNode;
public
constructor Create;
function GetRoot:tLink;
procedure SetRoot(val:tInfo);
function SetRightT(t:tLink;val:tInfo):tLink;
function SetLeftT (t:tLink;val:tInfo):tLink;
end;

type
TForm1 = class(TForm)
TreeView1: TTreeView;
OpenDialog1: TOpenDialog;
Label1: TLabel;
Button2: TButton;
Label3: TLabel;
Label4: TLabel;
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
t:tBinT;
fname:string;
f:boolean;
s1:string;
k:integer;
Val:char;
l:byte;


implementation

{$R *.dfm}

constructor tBinT.Create;
begin
Root:=nil;
end;

function tBinT.GetRoot:tLink;
begin
GetRoot:=Root;
end;

procedure tBinT.SetRoot(val:tInfo);
var t:tLink;
begin
new(t);
root:=t;
Root.Val:=val;
Root.Father:=nil;
Root.LT:=nil;
Root.RT:=nil;
end;

function tBinT.SetRightT(t:tLink;val:tInfo):tlink;
var p:tLink;
begin
new(p);
t.RT:=p;
p.Val:=val;
p.Father:=t;
p.RT:=nil;
p.LT:=nil;
SetRightT:=p;
end;

function tBinT.SetLeftT(t:tLink;val:tInfo):tLink;
var p:tLink;
begin
new(p);
t.LT:=p;
p.Val:=val;
p.Father:=t;
p.RT:=nil;
p.LT:=nil;
SetLeftT:=p;
end;

procedure Error;
begin
f:=false;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
f_in : TextFile;
x : char;
Cur : tLink;
i : integer;

{--------------------Ввод дерева---------------------}

procedure Add(Cur:tLink;var f_in:TextFile; var t:tBinT;var x:char);
forward;

procedure AddLeft(Cur:tLink;var f_in:TextFile; var t:tBinT;var x:char);
begin
Cur:=t.SetLeftT(Cur,x);
read(f_in,x);
add(Cur,f_in,t,x);
end;

procedure AddRight(Cur:tLink;var f_in:TextFile; var t:tBinT;var x:char);
begin
Cur:=t.SetRightT(Cur,x);
read(f_in,x);
Add(cur,f_in,t,x);
end;

procedure Add(Cur:tLink;var f_in:TextFile;var t:tBinT;var x:char);
begin
if x ='(' then
begin
read(f_in,x);
if x<>' ' then AddLeft(Cur,f_in,t,x) else read(f_in,x);
if x<>' ' then AddRight(Cur,f_in,t,x) else read(f_in,x);
read(f_in,x);
end // | -- |
else if x=')'then if Eoln(f_in) then exit; // | :) |
end; // | -- |

procedure EnterBT(var Cur:tLink; var f_in:TextFile;var t:tBinT);
begin
read(f_in,x);
if x='(' then
begin
read(f_in,x);
t.SetRoot(x);
Cur:=t.GetRoot;
read(f_in,x);
Add(Cur,f_in,t,x);
end
else Error;
readln(f_in);
end;

{-----Рисование дерева на основе обхода в глубину----}

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

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

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

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

{----------Проверка на коректный ввод---------------}
function Check( var f_in:textfile):boolean;
var
i:integer;
s:string;
f:boolean;
el:char;
begin
s:='';f:=true;i:=0;s1:='';
while not eoln(f_in) and f do
begin
read(f_in,el);
if el<>')' then
begin
s:=s+el;
s1:=s1+el;
i:=i+1;
end
else
if (length(s)<>0) and (s[i-3]<>' ')and(s[i-2]='(')
and (length(s)<>2)and not(s[i-1]in [')','('])
and not(s[i]in [')','(']) then
begin
s[i-3]:='a';s1:=s1+')';
delete(s,i-2,3);
i:=i-3;
end
else
if (length(s)=2)and not eoln(f_in) then
f:=false;
end;
if eoln(f_in) and f and (length(s)=2) then
begin
check:=true ;
s1:=s1+')';
end
else
check:=false;
reset(f_in)
end;
{======================================================}


{--------------------Button_1_Click--------------------}

begin
if OpenDialog1.Execute then
fname:=OpenDialog1.filename;
if fname<>'' then
begin
treeView1.Visible:=true;

t:=tBinT.Create;
AssignFile(f_in,fname);
Reset(f_in);

f:=true;
if check(f_in) then
EnterBT (Cur,f_in,t)
else f:=false;

Closefile(f_in);
if f then
begin
k:=0;
Cur:=t.Root;
i:=0;
AssignFile(f_in,'Bt.txt');
Rewrite(f_in);
writeln(f_in,'Root: '+Cur.Val);
DrawBT(Cur,i,f_in);
CloseFile(f_in);
TreeView1.LoadFromFile('Bt.Txt');
Cur:=t.Root;
DeleteFile('Bt.Txt');
end
else Error;
end;
Button2.Enabled:=false;
end;



end.