Деревья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.