Arbore binar: desenare

>

{desenarea tuturor arborilor binari cu numar fixat de varfuri}
uses crt,graph;
const nmax=20;
      nmax1=15;
     inf=maxint div 2;

type arbore=^virf;
 virf=record
 st,dr:arbore;
end;
var opt:integer;
    karb,gd,gm,iarb,narb,dela:integer;
    arb:arbore;
    sarb:array [0..20] of integer;

FUNCTION EARBORE(narb1,narb2:integer):boolean;
var iarb:integer;
begin
       earbore:=false;
 if (narb2=narb1+2) and (sarb[narb1]=1) and (sarb[narb1+1]=2) and (sarb[narb2]=2)
        then earbore:=true
        else
            if (narb2>narb1+2) then
           if (sarb[narb1]=1) and (sarb[narb2]=2) and earbore(narb1+1,narb2-1)
               then earbore:=true
               else
          if (sarb[narb1]=1) and (sarb[narb1+1]=2) and earbore(narb1+2,narb2)
                   then earbore:=true
                   else
                       for iarb:=narb1+3 to narb2-3 do
       if (sarb[narb1]=1) and earbore(narb1+1,iarb) and earbore(iarb+1,narb2)
                         then
                             begin
                                  earbore:=true;
                                  exit;
                             end;
  end;

PROCEDURE AFISARE(arb:arbore;x,y:integer);
  begin
       if arb<>nil then
                 begin
                      if arb^.st<>nil then
                                    begin
                                         line(x,y,x-30,y+30);
                                         outtextxy(x,y,'*');
                                         afisare(arb^.st,x-30,y+30);
                                    end;
                      if arb^.dr<>nil then
                                    begin
                                         line(x,y,x+30,y+30);
                                         outtextxy(x,y,'*');
                                         afisare(arb^.dr,x+30,y+30);
                                    end;
                  end;
  end;

FUNCTION CONSTR(narb1,narb2:integer):arbore;
  var iarb:integer;
      arb:arbore;
  begin
     if (narb2=narb1+2) and (sarb[narb1]=1) and (sarb[narb1+1]=2) and
              (sarb[narb2]=2)  then
         begin
              new(arb);
              arb^.st:=nil;
              arb^.dr:=nil;
              constr:=arb;
        end
     else if (narb2>narb1+2) then
             if (sarb[narb1]=1) and (sarb[narb2]=2) and
                earbore(narb1+1,narb2-1) then
                 begin
                      new(arb);
                      arb^.dr:=nil;
                      arb^.st:=constr(narb1+1,narb2-1);
                      constr:=arb;
                 end
             else if (sarb[narb1]=1) and(sarb[narb1+1]=2) and
             earbore(narb1+2,narb2)  then
                      begin
                           new(arb);
                           arb^.st:=nil;
                           arb^.dr:=constr(narb1+2,narb2);
                           constr:=arb;
                      end
                  else for iarb:=narb1+3 to narb2-3 do
                        if (sarb[narb1]=1) and earbore(narb1+1,iarb)
                        and earbore(iarb+1,narb2)  then
                            begin
                                 new(arb);
                                 arb^.st:=constr(narb1+1,iarb);
                                 arb^.dr:=constr(iarb+1,narb2);
                                 constr:=arb;
                                 exit;
                            end;
  end;

PROCEDURE STERGERE(var arb:arbore);
  begin
       if arb<>nil then
          if (arb^.st=nil) and (arb^.dr=nil) then
                                             begin
                                                  dispose(arb);
                                                  arb:=nil;
                                             end
                                         else
                                             begin
                                                  stergere(arb^.st);
                                                  stergere(arb^.dr);
                                                  stergere(arb);
                                             end;
  end;

BEGIN
       clrscr;
       gd:=detect;
       initgraph(gd,gm,'c:bgi');
       outtextxy(20,200,'  Generarea arborilor binari cu "n" varfuri ;');
       cleardevice;
       closegraph;
            begin
                 clrscr;
                 writeln;writeln;writeln;
                 write('  Introduceti numarul de varfuri (n>4): ');
                  readln(narb);
                 write('Delay: ');
                 readln(dela);
                 gd:=detect;
                  initgraph(gd,gm,'c:bgi');
                  setbkcolor(1);
                  setcolor(14);
                  for iarb:=0 to 2*narb do sarb[iarb]:=0;
                  sarb[2*narb+1]:=2;
                  karb:=0;
                  while karb>=0 do
                     if karb=2*narb then
                         begin
                           if earbore(1,2*narb+1) then
                                          begin
                                               arb:=constr(1,2*narb+1);
                                               afisare(arb,300,0);
                                               delay(dela);
                                               cleardevice;
                                               stergere(arb);
                                          end;
                           dec(karb);
                         end
                      else if sarb[karb+1]<2 then
                                      begin
                                           inc(sarb[karb+1]);
                                           inc(karb);
                                      end
                                  else
                                      begin
                                           sarb[karb+1]:=0;
                                           dec(karb);
                                      end;
              closegraph;
            end;
END.
{PascalZone.uv.ro}