瀏覽代碼

* Delphi compatible TCollection.Sort() using helper

Michaël Van Canneyt 1 年之前
父節點
當前提交
97495e93b8
共有 3 個文件被更改,包括 40 次插入0 次删除
  1. 27 0
      packages/rtl-generics/src/generics.defaults.pas
  2. 2 0
      rtl/objpas/classes/classesh.inc
  3. 11 0
      rtl/objpas/classes/collect.inc

+ 27 - 0
packages/rtl-generics/src/generics.defaults.pas

@@ -1089,6 +1089,13 @@ function _LookupVtableInfo(AGInterface: TDefaultGenericInterface; ATypeInfo: PTy
 function _LookupVtableInfoEx(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt;
   AFactory: THashFactoryClass): Pointer;
 
+Type
+
+  TCollectionItemComparer = IComparer<TCollectionItem>;
+  TCollectionHelper = Class helper for TCollection
+    Procedure sort(const AComparer: TCollectionItemComparer); overload;
+  end;  
+
 implementation
 
 { TComparer<T> }
@@ -3481,5 +3488,25 @@ begin
   end;
 end;
 
+{ TCollectionHelper }
+
+
+Function GenericCollSort(Item1,Item2 : TCollectionItem; aContext : Pointer) : Integer;
+
+begin
+  Result:=TCollectionItemComparer(aContext).Compare(Item1,Item2);   
+end;
+
+Procedure TCollectionHelper.sort(const AComparer: TCollectionItemComparer);
+
+begin
+  aComparer._AddRef;
+  try
+    Sort(GenericCollSort,Pointer(aComparer));
+  finally
+    aComparer._Release;
+  end;  
+end;  
+
 end.
 

+ 2 - 0
rtl/objpas/classes/classesh.inc

@@ -804,6 +804,7 @@ type
   TCollectionItemClass = class of TCollectionItem;
   TCollectionNotification = (cnAdded, cnExtracting, cnDeleting);
   TCollectionSortCompare = function (Item1, Item2: TCollectionItem): Integer;
+  TCollectionSortCompare_Context = function (Item1, Item2: TCollectionItem; context : Pointer): Integer;
 
   TCollection = class(TPersistent)
   private
@@ -848,6 +849,7 @@ type
     procedure Exchange(Const Index1, index2: integer);
     procedure Move(Const Index1, index2: integer);
     procedure Sort(Const Compare : TCollectionSortCompare);
+    procedure Sort(Const Compare : TCollectionSortCompare_Context; Context : Pointer);
     property Count: Integer read GetCount;
     property ItemClass: TCollectionItemClass read FItemClass;
     property Items[Index: Integer]: TCollectionItem read GetItem write SetItem;

+ 11 - 0
rtl/objpas/classes/collect.inc

@@ -416,6 +416,17 @@ begin
     end;
 end;
 
+procedure TCollection.Sort(Const Compare : TCollectionSortCompare_Context; Context : Pointer);
+
+begin
+  BeginUpdate;
+  try
+    FItems.Sort(TListSortComparer_Context(Compare),Context);
+  Finally
+    EndUpdate;
+  end;
+end;
+
 procedure TCollection.Sort(Const Compare : TCollectionSortCompare);
 
 begin