{--------------------------------------------------------------------------
A very fast stringlist Quicksorting routine - many many times faster than
Delhpi's built in TStringlist.sort - even in spite of the double casts.
The whole routine sorts 100.000 words in about 1 sec (on a 650MHz machine (sic!)).

It is also much faster than using the TStringlist.Sorted := true property
while filling the stringlist. Set the sorted property to false and sort it using
this routine afterwards.

Copyright Hans J. Klarskov Mortensen 2004 - (h@hjkm.dk) Sorting routine
based on M. C. Kerman's book "Programming and Problem Solving
with Delphi", Pearsons Education, 2002.

If anyone can use this unit they're welcome. But I ask you to let
this copyright notice stay and that you don't pretend taht you wrote it.

No warranty imaginable accepted. Use at your own risk.

(Language note: My native language is Danish. In this language "ord" means
"word" not ordinal.)

Usage : FastSortStList(YourStringlist);
-------------------------------------------------------------------------}
unit FastSortStringlist;

interface

uses
  ComCtrls, Classes, Windows, Sysutils;

type
  {This explains part of the speed! I wish I (really) knew why!
  If this declaration is placed in connection with the
  procedure the whole procedure is more than ten times slower.
  The reason may be that placing ithere means that the array it is
  created when program loads - if it is declared "locally"
  it is not created until the procedure requests it.}
  OrdArray = array of string;

procedure FastSortStList(Stlist: TStringlist);

implementation

{------------ Standard hand coded quicksort ------------------------------}
{ The sorting is - as you can see - based on ANSI-values, thus it is case sensitive.
If case insensitivity is needed use ANSIUPPERCASE.

If the string variables indicated are replaced by integer variables it'll
happily sort integers as well, but of course a StrToInt cast is needed.
--------------------------------------------------------------------------}

procedure Swap(var Value1, Value2: string);
var
  temp: string; //Integer;
begin
  temp := Value1;
  Value1 := Value2;
  Value2 := temp;
end;

function GetPIndex(lo, hi: Integer): Integer;
var
i : integer;
begin
  i := (lo+hi) div 2;
  GetPIndex := i;
end;
  
procedure Quicksort(low, high: Integer; var Ordliste: OrdArray);
var
  pivotIndex: Integer;
  pivotValue: string;
  left, right: Integer;
begin

  pivotIndex := GetPIndex(low, high);
  pivotValue := Ordliste[pivotIndex];

  left := low;
  right := high;
  repeat

    while ((left <= high) and (Ordliste[left] < pivotValue)) do
    begin
      Inc(left);
    end;

    while ((right >= low) and (pivotValue < Ordliste[right])) do
    begin
      Dec(right);
    end;
    if (left <= right) then
    begin
      Swap(Ordliste[left], Ordliste[right]);
      Inc(left);
      Dec(right);
    end;

  until (left > right);

  if (low < right) then
  begin
    Quicksort(low, right, Ordliste);
  end;

  if (left < high) then
  begin
    Quicksort(left, high, Ordliste);
  end;
end;
{-----------   End of Quicksort routines   -----------------------------}

{-----------   The Stringlist sorting routine with casts   -------------}

procedure FastSortStList(Stlist: TStringlist);
var
  SortArray: OrdArray;
  i, j: Integer;
begin
  //Cast Stringlist to an array
  setlength(sortArray, Stlist.count);
  for i := 0 to Stlist.count - 1 do
    SortArray[i] := Trim(Stlist.strings[i]);

  //Now sort
  QuickSort(Low(SortArray), High(SortArray), SortArray);

  //Recast
  for j := low(SortArray) to High(SortArray) do
    begin //Sometimes empty entries abound, get rid of them
    if StList.strings[j] <> '' then
    Stlist.Strings[j] := Sortarray[j];
    end;

  //Free the array
  SetLength(SortArray,0);
end;

end.