paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 12:49:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Delphi compatible TCollection.Sort() using helper

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-02-21 10:31:24 +01:00
parent 5c890b59e3
commit 97495e93b8
3 changed files with 40 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
packages/rtl-generics/src/generics.defaults.pas
View File

@ -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
rtl/objpas/classes/classesh.inc
View File

@ -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
rtl/objpas/classes/collect.inc
View File

@ -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