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