Пирамидальная сортировка

uses crt;
type arr=array[0..10000] of integer;
 
procedure Sort(var A: arr; Count: Integer);
  procedure DownHeap(index, Count: integer; Current: integer);
  {Функция пробегает по пирамиде восстанавливая ее
  Также используется для изначального создания пирамиды
  Использование: Передать номер следующего элемента в index
  Процедура пробежит по всем потомкам и найдет нужное место для следующего элемента}
  var
    Child: Integer;
  begin
    while index < Count div 2 do
     begin
      Child := (index+1)*2-1;
      if (Child < Count-1) and (A[Child] < A[Child+1]) then
        Child:=Child+1;
      if Current >= A[Child] then
        break;
      A[index] := A[Child];
      index := Child;
    end;
    A[index] := Current;
  end;
 
{Основная функция }
var
  i: integer;
  Current: integer;
begin
  {Собираем пирамиду}
  for i := (Count div 2)-1 downto 0 do
    DownHeap(i, Count, A[i]);
  {Пирамида собрана. Теперь сортируем}
  for i := Count downto 0 do begin
    Current := A[i];{перемещаем верхушку в начало отсортированного списка}
    A[i] := A[0];
    DownHeap(0, i, Current);{находим нужное место в пирамиде для нового элемента}
  end;
end;
var a:arr;
    n,i:integer;
begin
clrscr;
randomize;
write('n=');
readln(n);
for i:=1 to n do
a[i]:=random(100);
Sort(a,n);
for i:=1 to n do
write(a[i]:4);
readln
end.