Eine TCollection sortieren!

[LoCrux]

Items einer TCollection sortieren!

Vielleicht ist das fuer den einen oder anderen auch interessant.
Funktioniert und getestet in Delphi 7 Enterprise.

Delphi-Quellcode:

interface {PART}

type
  
  TMyCollectionItem = CLASS(TCollectionItem)
  private
    .
    FSortIndex : Integer;
    .
  protected
    .
    .
  public
    .
    property  SortIndex:Integer read FSortIndex write FSortIndex default -1;
    .
  end; 


  TMyCollection = CLASS(TCollection)
  private
    .
    .
  protected
    .
    .
  public
    .
    procedure Sort;
    .
  end;


implementation {PART}

  //-----------------------------------------------------//
  //                                                     //
  //-- TCollection Hack to Access Private Declarations --//
  //                                                     //
  //-----------------------------------------------------//
  //                                                     //
  //  Org. Declaration order of TCollecion in Classes    //
  //                                                     //
  //  TCollection = class(TPersistent)                   //
  //  private                                            //
  //    FItemClass: TCollectionItemClass;                //
  //    FItems: TList;                                   //
  //    .                                                //
  //    .                                                //
  //-----------------------------------------------------//
  //                                                     //
  //  To Access eg. FItems of your TCollection           //
  //                                                     //
  //  SC :=  TShadowedCollection(Self).FItems;           //
  //                                                     //
  //-----------------------------------------------------//

  {$HINTS OFF}
  TShadowedCollection = class(TPersistent)
  private
    FItemClass: TCollectionItemClass;
    FItems: TList;
  end;
  {$HINTS ON}


procedure TMyCollection.Sort;
var
  sc      : TList;
  i       : integer;

  procedure _QuickSort(L, R: Integer);
  var
    I, J, P : Integer;
    Save    : TCollectionItem;
  begin
    repeat
      I := L;
      J := R;
      P := (L + R) shr 1;
      repeat
        while TMyCollectionItem(Items[I]).SortIndex<TMyCollectionItem(Items[P]).SortIndex do Inc(I);
        while TMyCollectionItem(Items[J]).SortIndex>TMyCollectionItem(Items[P]).SortIndex do Dec(J);
        if I <= J then begin
          Save        := sc.Items[I];
          sc.Items[I] := sc.Items[J];
          sc.Items[J] := Save;
          if P = I then
            P := J
          else if P = J then
            P := I;
          Inc(I);
          Dec(J);
        end;
      until I > J;
      if L < J then _QuickSort(L, J);
      L := I;
    until I >= R;
  end;


begin
  {$WARNINGS OFF}
  if (count>1) {OTHERWISE MAKES NO SENSE}
  then begin
    //-- THE TCOLLECTION HACK TO ACCES FITMES OF THE ANCESTOR CLASS --//
    sc :=  TShadowedCollection(Self).FItems;
    //-- NOW CALCULATING OR DEFINIG THE SORT CRITERIA  --//
    for i := 0 to sc.Count-1
      do TMyCollectionItem(sc.Items[i]).SortIndex := WhatEverToCalculateWith(sc.Items[i]); {Ein Integer Kriterium}
    //-- AND DO THE LIMBO --//
    _QuickSort(0,count-1);
  end;
  {$WARNINGS ON}
end;

WhatEver koennte z.B. ein Funktion sein aka:

Delphi-Quellcode:

 

function TMyCollection.WhatEverToCalculateWith(AItem:TCollectionItem):integer;
var
  CastedItem   : TMyCollectionItem;
begin
  CastedItem := TMyCollectionItem(AItem);
  .
  .
  result := TheResultOfYourCalculation; // SORRY ABER MUSS HIER MAL ABSTRAKT BLEIBEN
end;

Alternativ geht es auch so. Hier muesst Ihr Euer Kriterium aber vorher igendwie definieren.

Delphi-Quellcode:

//-----------------------------------------------------------------//
//                                                                 //
// Defined in Classes:                                             //
//                                                                 //
// TListSortCompare = function (Item1, Item2: Pointer): Integer;   //
//                                                                 //
//-----------------------------------------------------------------//

function compare(Item1, Item2: Pointer): Integer; {=TListSortCompare}
var v1,v2 : integer;
begin
  result := 0;
  v1 := TMyCollectionItem(Item1).SortIndex; {Oder Anderes Kriterium}
  v2 := TMyCollectionItem(Item2).SortIndex; {Oder Anderes Kriterium}
  if (v1>v2)
    then result:=1
    else if (v1<v2)
         then result := -1;
end;


procedure TMyCollection.Sort;
var
  sc      : TList;

begin
  {$WARNINGS OFF}
  if (count>1) {OTHERWISE MAKES NO SENSE}
  then begin
    //-- THE TCOLLECTION HACK TO ACCES FITMES OF THE ANCESTOR CLASS --//
    sc :=  TShadowedCollection(Self).FItems;
    //-- AND DO THE LIMBO --//
    sc.Sort(compare); // ALTERNATIVE - BUT MAYBE MORE CALCULATIONS
  end;
  {$WARNINGS ON}
end;

{$WARNINGS ON/OFF} und {$HINTS ON/OFF} damit der Compiler nicht meckert (unsichere Typumwandlung).

Der Hack wurde so oder so aehnlich schon mal HIER AUF DELPHIPRAXIS besprochen.

Edits: Tippfehler