const SIZE = 20000;
type TFeld = array[1..SIZE] of integer;
 
procedure heapsort(var f:TFeld);
 
    procedure erzeugeheap(var f:TFeld); // Aufbau des Heaps 
    var i,j,max,temp:integer;
    begin
        for i := SIZE div 2 downto 2 do // Die zweite Hälfte des Feldes braucht nicht betrachtet werden.
          begin   
            j:=i;
            while j <= SIZE div 2 do begin
                max := j * 2 + 1;       // Finde das Maximum der (beiden) Söhne.
                if max > SIZE then dec(max)
                else if f[max-1] > f[max] then dec(max);
                if f[j] < f[max] then   // Tausche gegebenenfalls.
                   begin     
                    temp := f[j];
                    f[j] := f[max];
                    f[max] := temp;
                   end;
                j := max;
            end;
         end;
    end;
 
    function popmax(var f:TFeld;heapsize:integer):integer;
    var i,max,temp:integer;
    begin
        popmax := f[1];
        f[1] := f[heapsize];
        i := 1;
        while i <= (heapsize div 2) do // Setze das letzte Element an Anfang setzen und lasse es versickern.
           begin 
            max := i * 2 + 1;          // Finde das Maximum der (beiden) Söhne. 
            if max > heapsize then dec(max)
            else if f[max-1] > f[max] then dec(max);
            if f[i] < f[max] then      // Tausche gegebenenfalls.
               begin     
                temp := f[i];
                f[i] := f[max];
                f[max] := temp;
            end;
            i := max;
        end;
    end;
 var i:integer;
begin
    genheap(f);
    for i:=SIZE downto 1 do f[i] := popmax(f,i);
end;

Quelle: http://de.wikibooks.org/wiki/Algorithmensammlung:_Sortierverfahren:_Heapsort