Welcome, guest! Login / Register - Why register?
Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)

Paste

Pasted by Art ( 15 years ago )
unit Unit1; 

{$mode objfpc}{$H+}
{------------------------------------------------------------------------------}
                                  interface
{------------------------------------------------------------------------------}
uses
  Classes, SysUtils;
type
BTp=longint;
PBTr=^TBTr;
TBTr=record
    Info:BTp;
    Left,Right:PBTr;
end;
Function SearchB (PInfo:BTp; PTree:PBTr):Boolean;
Procedure Print (PTree:PBTr;Depth:Word);
procedure Make(var AData:PBTr;n:integer);
procedure DeleteTree(var Tree1:PBTr );
function NewTreeBuild:PBTr;
function IsEmpty(const Atree:PBTr):boolean;
{------------------------------------------------------------------------------}
                                 implementation
{------------------------------------------------------------------------------}
var s:PBTr;

function NewTreeBuild:PBTr;
begin
new(s);
end;

function IsEmpty(const Atree:PBTr):boolean;
begin
if Atree=s then
result:=true;
end;

Function SearchB (PInfo:BTp; PTree:PBTr):Boolean;
begin

s^.Info:=Pinfo;
while Ptree^.Info<>PInfo do begin
     if PTree^.Info>PInfo then
        PTree:=PTree^.Left
     else PTree:=PTree^.Right;
end;

if Ptree<>s then
result:=true
else result:=false;

end;

Procedure Print (PTree:PBTr;Depth:Word);
var
 i:integer;
begin

    if (Assigned (Ptree)) then
     begin
     writeln;
    Print(PTree^.left,Depth+1);
    writeln;
    for i:=1 to depth do write('       ');
    if ptree=s then  print(PTree^.Right,Depth+1)
    else writeln(Ptree^.Info);
    print(PTree^.Right,Depth+1);
   end;
end;

procedure Make(var AData:PBTr;n:integer);
begin
  if (AData=nil) or (Adata=s) then
    begin
      new(AData);
      AData^.Left := s;
      AData^.Right := s;
      AData^.Info := n;
    end
  else if n<AData^.Info then Make(AData^.Left,n)
  else Make(AData^.Right,n);
end;

procedure DeleteTree(var Tree1:PBTr );
begin

        if Tree1 <> s then
          begin
            DeleteTree (Tree1^.LEFT);
            DeleteTree (Tree1^.RIGHT);
            Dispose(Tree1);
          end;
          end;
begin
end.

 

Revise this Paste

Your Name: Code Language: