Преобразовать дерево в идеально сбалансированное

uses crt;
type
PTree=^TTree;
TTree=record
num:integer;
LEFT,RIGHT:PTree;
end;
const n=10;
var
a:array[1..n] of integer;
i, z,v,max:integer;
predkor,Hkor, kor:Ptree;
procedure print(TREE:Ptree;n:integer);
var q:integer;
begin
if TREE<>nil then
begin
for q:= 1 to n do
write('*');
writeln(TREE^.num);
print(TREE^.LEFT,n+1);
print(TREE^.RIGHT,n+1);
end;
end;
procedure insert(var TREE:Ptree;x:integer);
var CUR,TNEW:PTree;
begin
CUR:=TREE;
if CUR=nil then
begin
new(TNEW);
TNEW^.num:=x;
TNEW^.LEFT:=nil;
TNEW^.RIGHT:=nil;
Hkor:=TNEW;
end
else
begin
new(TNEW);
TNEW^.num:=x;
TNEW^.RIGHT:=nil;
TNEW^.LEFT:=nil;
if CUR^.num>x
then
if CUR^.LEFT=nil
then
begin
TREE^.LEFT:=TNEW;
end
else begin CUR:=CUR^.LEFT; insert(cur,x); end
else
if CUR^.RIGHT=nil
then
begin
TREE^.RIGHT:=TNEW;
end
else begin CUR:=CUR^.RIGHT; insert(cur,x);end;
end;
end;
procedure clear(var tree:ptree) ;
var cur:ptree;
begin
cur:=tree;
if cur<>nil then
begin
clear(cur^.LEFT);
clear(cur^.RIGHT);
dispose(cur);
end;
tree:=nil;
end;
procedure menu(v:integer);
begin
case  (v) of
1:begin writeln; if Hkor<>nil then print(Hkor,0) else writeln('дерево пусто'); end;
2:begin writeln('введите ключ: ');read(z); insert(Hkor,z); end;
3:begin clear(Hkor);  end;
0:v:=0;
end;
end;
begin
//a[1]:=random(10);a[2]:=random(10);a[3]:=random(10);a[4]:=random(10);a[5]:=random(10);
//a[6]:=random(10);a[7]:=random(10);a[8]:=random(10);a[9]:=random(10);a[10]:=random(10);
a[1]:=7; a[2]:=5; a[3]:=9; a[4]:=3; a[5]:=1; a[6]:=10; a[7]:=6; a[8]:=8; a[9]:=4; a[10]:=2;
Hkor:=nil;
for i:= 1 to n do
begin
insert(Hkor,a[i]);
end;
v:=1;
writeln('***************************');
writeln('1 - Печать дерева');
writeln('2 - добавление элемента в дерево');
writeln('3 - очистка дерева');
writeln('***************************');
Writeln;
while v<>0 do
begin
readln(v);
menu(v);
Writeln;
end;
end.

var
   newRoot : PTree;
 
procedure CreateBalanced(var index : Integer;
                         n : integer; var p : PTree);
var
   now : PTree;
   nLeft, nRight : integer;
begin
   now := p;
   if n = 0 then p := nil
   else
   begin
      nLeft := n div 2; nRight := n - nLeft - 1;
      new(now);
      inc(index); now^.num := A[index];
      CreateBalanced(index, nLeft, now^.Left);
      CreateBalanced(index, nRight, now^.Right);
      p := now;
   end;
end;

begin
   index := 0; // Var index : Integer
   CreateBalanced(index, n, newRoot); // <--- newRoot - корень ИСД
end;