Janilabo | TSAShellSort

procedure TSAShellSort(var TSA: TStringArray; order: (tso_HighToLow, tso_LowToHigh));
var
  x, a, b, l: Integer;
begin
  l := Length(TSA);
  x := 0;
  while (x < (l div 3)) do
    x := ((x * 3) + 1);
  case order of
    tso_HighToLow:
      while (x >= 1) do
      begin
        for a := x to (l - 1) do
        begin
          b := a;
          while ((b >= x) and (TSA[b] > TSA[(b - x)])) do
          begin
            Swap(TSA[b], TSA[(b - x)]);
            DecEx(b, x);
          end;
        end;
        x := (x div 3);
      end;
    tso_LowToHigh:
      while (x >= 1) do
      begin
        for a := x to (l - 1) do
        begin
          b := a;
          while ((b >= x) and (TSA[b] < TSA[(b - x)])) do
          begin
            Swap(TSA[b], TSA[(b - x)]);
            DecEx(b, x);
          end;
        end;
        x := (x div 3);
      end;
  end;
end;

var
  TSA: TStringArray;

begin
  TSA := ['Toby', 'Richard', 'Nina', 'Joann', 'Matt', 'Jani', 'Ann'];
  WriteLn('TSA before sorting: ' + ToStr(TSA));
  TSAShellSort(TSA, tso_LowToHigh);
  WriteLn('TSA after sorting: ' + ToStr(TSA));
  SetLength(TSA, 0);
end.