How to sort a TStringList using the Quicksort algorithm (Views: 30)
Problem/Question/Abstract: How to sort a TStringList using the Quicksort algorithm Answer: Here is a complete example, which uses a rather tricky type case to gain access to some private data of the TStringList. It does provide a method for you to use as many custom sort routines as you like in one descendant class. One thing to note is that only swaps pointers and not data so it is extremely fast even with 10000 entrys. unit sslistu; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; ListBox1: TListBox; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} type TStringListCompare = function(var X, Y: TStringItem): integer; TStringListCracker = class(TStrings) private FList: PStringItemList; FCount: Integer; FCapacity: Integer; FSorted: Boolean; end; TcStringList = class(TStringList) private FListptr: PStringItemList; procedure ExchangeItems(Index1, Index2: Integer); procedure QuickSort(L, R: Integer; Compare: TStringListCompare); procedure SetSorted(Value: Boolean); public procedure Sort(Compare: TStringListCompare); {Hide not Override} end; procedure TcStringList.SetSorted(Value: Boolean); begin if Sorted <> Value then TStringListCracker(Self).FSorted := value; end; procedure TcStringList.ExchangeItems(Index1, Index2: Integer); var Temp: Integer; Item1, Item2: PStringItem; begin Item1 := @FListPtr^[Index1]; Item2 := @FListPtr^[Index2]; Temp := Integer(Item1^.FString); Integer(Item1^.FString) := Integer(Item2^.FString); Integer(Item2^.FString) := Temp; Temp := Integer(Item1^.FObject); Integer(Item1^.FObject) := Integer(Item2^.FObject); Integer(Item2^.FObject) := Temp; end; procedure TcStringList.QuickSort(L, R: Integer; Compare: TStringListCompare); var I, J: Integer; P: TStringItem; begin repeat I := L; J := R; P := FListPtr^[(L + R) shr 1]; repeat while Compare(FListPtr^[I], P) < 0 do Inc(I); while Compare(FListPtr^[J], P) > 0 do Dec(J); if I <= J then begin ExchangeItems(I, J); Inc(I); Dec(J); end; until I > J; if L < J then QuickSort(L, J, Compare); L := I; until I >= R; end; procedure TcStringList.Sort(Compare: TStringListCompare); begin {trick to gain access to private data} FListptr := TStringListCracker(Self).FList; QuickSort(0, Count - 1, Compare); end; function Example1(var X, Y: TStringItem): integer; begin Result := CompareStr(X.FString, Y.FString); end; function Example2(var X, Y: TStringItem): integer; begin Result := CompareStr(copy(X.FString, 2, 5), copy(Y.FString, 2, 5)); end; function Example3(var X, Y: TStringItem): integer; begin if integer(X.FObject) > integer(Y.FObject) then result := 1 else if integer(X.FObject) < integer(Y.FObject) then result := -1 else result := 0; end; procedure TForm1.Button1Click(Sender: TObject); var fSList: TcStringList; I, J, K, L: integer; s: string; begin fSList := TcStringList.create; for I := 0 to 10000 do begin s := ''; for K := 10 to Random(20) + 10 do s := s + char(random(26) + 65); L := random(20000); fSList.addobject(s, pointer(L)); end; listbox1.items.add('Sorting'); application.processmessages; fSList.addobject('Dennis', pointer(10000)); fSList.Sorted := false; {disable default Sort} fSList.Sort(Example1); {replacement Alpha sort} fSList.Sorted := true; {enable Binary searching} listbox1.items.add('Done'); application.processmessages; {if ByStringPosdata then fSList.Sort(Example2); if ByObjectValue then fSList.Sort(Example3);} listbox1.items.assign(fSList); showmessage('Dennis is at line number #' + inttostr(fSList.Indexof('Dennis'))); fSList.free; end; end. |