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

Деревья1 / Unit1

.pas
Скачиваний:
7
Добавлен:
01.05.2014
Размер:
4 Кб
Скачать
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 б6Proba.res
  • #
    01.05.201425 б8tree.txt
  • #
    01.05.20148 Кб6Unit1.dcu
  • #
    01.05.201451 б6Unit1.ddp
  • #
    01.05.20141 Кб6Unit1.dfm
  • #
    01.05.20144 Кб7Unit1.pas
  • #
    01.05.20145 Кб6Unit2.dcu
  • #
    01.05.20149 Кб6Unit2.pas