Browse Source

* Applied patch by Markus Kaemmerer (merged):
- Added support for TStringList.CustomSort

sg 25 years ago
parent
commit
9dc9cdeafc
2 changed files with 35 additions and 12 deletions
  1. 9 2
      fcl/inc/classesh.inc
  2. 26 10
      fcl/inc/stringl.inc

+ 9 - 2
fcl/inc/classesh.inc

@@ -401,6 +401,7 @@ type
 { TStringList class }
 
   TDuplicates = (dupIgnore, dupAccept, dupError);
+  TStringList = class;
 
   PStringItem = ^TStringItem;
   TStringItem = record
@@ -410,6 +411,7 @@ type
 
   PStringItemList = ^TStringItemList;
   TStringItemList = array[0..MaxListSize] of TStringItem;
+  TStringListSortCompare = function(List: TStringList; Index1, Index2: Integer): Integer;
 
   TStringList = class(TStrings)
   private
@@ -422,7 +424,7 @@ type
     FOnChanging: TNotifyEvent;
     procedure ExchangeItems(Index1, Index2: Integer);
     procedure Grow;
-    procedure QuickSort(L, R: Integer);
+    procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
     procedure InsertItem(Index: Integer; const S: string);
     procedure SetSorted(Value: Boolean);
   protected
@@ -446,6 +448,7 @@ type
     function IndexOf(const S: string): Integer; override;
     procedure Insert(Index: Integer; const S: string); override;
     procedure Sort; virtual;
+    procedure CustomSort(CompareFn: TStringListSortCompare);
     property Duplicates: TDuplicates read FDuplicates write FDuplicates;
     property Sorted: Boolean read FSorted write SetSorted;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
@@ -1236,7 +1239,11 @@ function LineStart(Buffer, BufPos: PChar): PChar;
 
 {
   $Log$
-  Revision 1.5  2000-11-13 15:46:55  marco
+  Revision 1.6  2000-12-03 22:35:09  sg
+  * Applied patch by Markus Kaemmerer (merged):
+    - Added support for TStringList.CustomSort
+
+  Revision 1.5  2000/11/13 15:46:55  marco
    * Unix renamefest for defines.
 
   Revision 1.4  2000/10/15 10:04:39  peter

+ 26 - 10
fcl/inc/stringl.inc

@@ -641,19 +641,18 @@ end;
 
 
 
-Procedure TStringList.QuickSort(L, R: Integer);
+Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
 
-Var I,J : Longint;
-    Pivot : String;
+Var I,J, Pivot : Longint;
 
 begin
   Repeat;
     I:=L;
     J:=R;
-    Pivot:=Flist^[(L+R) div 2].FString;
+    Pivot:=(L+R) div 2;
     Repeat
-      While AnsiCompareText(Flist^[I].Fstring,Pivot)<0 do Inc(I);
-      While AnsiCompareText(Flist^[J].Fstring,Pivot)>0 do Dec(J);
+      While CompareFn(Self, I, Pivot)<0 do Inc(I);
+      While CompareFn(Self, J, Pivot)>0 do Dec(J);
       If I<=J then
         begin
         ExchangeItems(I,J); // No check, indices are correct.
@@ -661,7 +660,7 @@ begin
         Dec(j);
         end;
     until I>J;
-    If L<J then QuickSort(L,J);
+    If L<J then QuickSort(L,J, CompareFn);
     L:=I;
   Until I>=R;
 end;
@@ -955,20 +954,37 @@ begin
 end;
 
 
-Procedure TStringList.Sort;
+Procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
 
 begin
   If Not Sorted and (FCount>1) then
     begin
     Changing;
-    QuickSOrt(0,FCount-1);
+    QuickSort(0,FCount-1, CompareFn);
     Changed;
     end;
 end;
 
+function StringListAnsiCompare(List: TStringList; Index1, Index: Integer): Integer;
+
+begin
+  Result := AnsiCompareText(List.FList^[Index1].FString,
+    List.FList^[Index1].FString);
+end;
+
+Procedure TStringList.Sort;
+
+begin
+  CustomSort(@StringListAnsiCompare);
+end;
+
 {
   $Log$
-  Revision 1.5  2000-11-22 22:44:39  peter
+  Revision 1.6  2000-12-03 22:35:09  sg
+  * Applied patch by Markus Kaemmerer (merged):
+    - Added support for TStringList.CustomSort
+
+  Revision 1.5  2000/11/22 22:44:39  peter
     * fixed commatext (merged)
 
   Revision 1.4  2000/11/17 13:39:49  sg