mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 05:29:21 +02:00
* Delphi compatible TCollection.Sort() using helper
This commit is contained in:
parent
5c890b59e3
commit
97495e93b8
@ -1089,6 +1089,13 @@ function _LookupVtableInfo(AGInterface: TDefaultGenericInterface; ATypeInfo: PTy
|
|||||||
function _LookupVtableInfoEx(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt;
|
function _LookupVtableInfoEx(AGInterface: TDefaultGenericInterface; ATypeInfo: PTypeInfo; ASize: SizeInt;
|
||||||
AFactory: THashFactoryClass): Pointer;
|
AFactory: THashFactoryClass): Pointer;
|
||||||
|
|
||||||
|
Type
|
||||||
|
|
||||||
|
TCollectionItemComparer = IComparer<TCollectionItem>;
|
||||||
|
TCollectionHelper = Class helper for TCollection
|
||||||
|
Procedure sort(const AComparer: TCollectionItemComparer); overload;
|
||||||
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
{ TComparer<T> }
|
{ TComparer<T> }
|
||||||
@ -3481,5 +3488,25 @@ begin
|
|||||||
end;
|
end;
|
||||||
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.
|
end.
|
||||||
|
|
||||||
|
@ -804,6 +804,7 @@ type
|
|||||||
TCollectionItemClass = class of TCollectionItem;
|
TCollectionItemClass = class of TCollectionItem;
|
||||||
TCollectionNotification = (cnAdded, cnExtracting, cnDeleting);
|
TCollectionNotification = (cnAdded, cnExtracting, cnDeleting);
|
||||||
TCollectionSortCompare = function (Item1, Item2: TCollectionItem): Integer;
|
TCollectionSortCompare = function (Item1, Item2: TCollectionItem): Integer;
|
||||||
|
TCollectionSortCompare_Context = function (Item1, Item2: TCollectionItem; context : Pointer): Integer;
|
||||||
|
|
||||||
TCollection = class(TPersistent)
|
TCollection = class(TPersistent)
|
||||||
private
|
private
|
||||||
@ -848,6 +849,7 @@ type
|
|||||||
procedure Exchange(Const Index1, index2: integer);
|
procedure Exchange(Const Index1, index2: integer);
|
||||||
procedure Move(Const Index1, index2: integer);
|
procedure Move(Const Index1, index2: integer);
|
||||||
procedure Sort(Const Compare : TCollectionSortCompare);
|
procedure Sort(Const Compare : TCollectionSortCompare);
|
||||||
|
procedure Sort(Const Compare : TCollectionSortCompare_Context; Context : Pointer);
|
||||||
property Count: Integer read GetCount;
|
property Count: Integer read GetCount;
|
||||||
property ItemClass: TCollectionItemClass read FItemClass;
|
property ItemClass: TCollectionItemClass read FItemClass;
|
||||||
property Items[Index: Integer]: TCollectionItem read GetItem write SetItem;
|
property Items[Index: Integer]: TCollectionItem read GetItem write SetItem;
|
||||||
|
@ -416,6 +416,17 @@ begin
|
|||||||
end;
|
end;
|
||||||
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);
|
procedure TCollection.Sort(Const Compare : TCollectionSortCompare);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
Loading…
Reference in New Issue
Block a user