Janilabo | TSAHeapSort() [Simba]

procedure TSAHeapSort(var TSA: TStringArray; order: (so_LowToHigh, so_HighToLow));
var
  a, b, r, c, l: Integer;
  tmp: string;
begin
  l := Length(TSA);
  if (l > 1) then
  begin
    a := ((l - 1) div 2);
    b := (l - 1);
    case order of
      so_LowToHigh:
      begin
        while (a >= 0) do
        begin
          r := a;
          while (((r * 2) + 1) <= (l - 1)) do
          begin
            c := ((r * 2) + 1);
            if ((c < (l - 1)) and (TSA[c] < TSA[(c + 1)])) then
              c := (c + 1);
            if (TSA[r] < TSA[c]) then
            begin
              tmp := TSA[r];
              TSA[r] := TSA[c];
              TSA[c] := tmp;
              r := c;
            end else
              Break;
          end;
          a := (a - 1);
        end;
        while (b > 0) do
        begin
          tmp := TSA[b];
          TSA[b] := TSA[0];
          TSA[0] := tmp;
          b := (b - 1);
          r := 0;
          while (((r * 2) + 1) <= b) do
          begin
            c := ((r * 2) + 1);
            if ((c < b) and (TSA[c] < TSA[(c + 1)])) then
              c := (c + 1);
            if (TSA[r] < TSA[c]) then
            begin
              tmp := TSA[r];
              TSA[r] := TSA[c];
              TSA[c] := tmp;
              r := c;
            end else
              Break;
          end;
        end;
      end;
      so_HighToLow:
      begin
        while (a >= 0) do
        begin
          r := a;
          while (((r * 2) + 1) <= (l - 1)) do
          begin
            c := ((r * 2) + 1);
            if ((c < (l - 1)) and (TSA[c] > TSA[(c + 1)])) then
              c := (c + 1);
            if (TSA[r] > TSA[c]) then
            begin
              tmp := TSA[r];
              TSA[r] := TSA[c];
              TSA[c] := tmp;
              r := c;
            end else
              Break;
          end;
          a := (a - 1);
        end;
        while (b > 0) do
        begin
          tmp := TSA[b];
          TSA[b] := TSA[0];
          TSA[0] := tmp;
          b := (b - 1);
          r := 0;
          while (((r * 2) + 1) <= b) do
          begin
            c := ((r * 2) + 1);
            if ((c < b) and (TSA[c] > TSA[(c + 1)])) then
              c := (c + 1);
            if (TSA[r] > TSA[c]) then
            begin
              tmp := TSA[r];
              TSA[r] := TSA[c];
              TSA[c] := tmp;
              r := c;
            end else
              Break;
          end;
        end;
      end;
    end;
  end;
end;

var
  TSA: TStringArray;

begin
  TSA := ['Apple', 'Orange', 'Lemon', 'Banana', 'Pear'];
  TSAHeapSort(TSA, so_HighToLow); // Reversed.
  WriteLn(ToStr(TSA));
  TSAHeapSort(TSA, so_LowToHigh); // Default.
  WriteLn(ToStr(TSA));
end.