Multi-ObjectLists (Objekte mehrmals in einer Liste)

[himitsu]

Nja, was soll man dazu sagen?

Dieses sind einfach nur Listen, in welchen das selbe Objekt mehrmals enthalten sein kann, ohne das es Probleme geben könnte.

> Es gibt nur Auswirkungen, wenn OwnsObjects auf TRUE steht,
> sonst reagieren diese Listen, wie ihre "normalen" Verwandten.

Ist ein Objekt mehrmals vorhanden, dann wird es erst freigegeben, wenn keine Instanzen mehr in der Liste stecken.
(bei den normalen Listen wird das Objekt ja ohne Prüfung sofort freigegeben)

Delphi-Quellcode:

unit MultiLists;

interface
  {$DEFINE UseGenerics}

  uses
    Classes, Contnrs {$IFDEF UseGenerics}, Generics.Collections{$ENDIF};

  type
    TMultiObjectList = class(TObjectList)
    protected
      procedure Notify(Ptr: Pointer; Action: TListNotification); override;
    public
      function Remove(AObject: TObject; RemoveAll: Boolean): Integer; overload;
      procedure RemoveAll(AObject: TObject); inline;
    end;

    TMultiObjectStringList = class(TStringList)
    protected
      procedure PutObject(Index: Integer; AObject: TObject); override;
    public
      destructor Destroy; override;
      procedure Clear; override;
      procedure Delete(Index: Integer); override;
    end;

    {$IFDEF UseGenerics}

      TMultiObjectList<T: class> = class(TObjectList<T>)
      protected
        procedure Notify(const Value: T; Action: TCollectionNotification); override;
      public
        function Remove(const Value: T; RemoveAll: Boolean): Integer; overload;
        procedure RemoveAll(const Value: T); inline;
      end;

    {$ENDIF}

implementation
  procedure TMultiObjectList.Notify(Ptr: Pointer; Action: TListNotification);
  begin
    if (Action = lnDeleted) and OwnsObjects then begin
      if IndexOf(TObject(Ptr)) < 0 then
        TObject(Ptr).Free;
    end else inherited;
  end;

  function TMultiObjectList.Remove(AObject: TObject; RemoveAll: Boolean): Integer;
  var
    i: Integer;
  begin
    if RemoveAll then begin
      Result := -1;
      repeat
        i := Remove(AObject);
        if i >= 0 then Result := i;
      until i < 0;
    end else Result := Remove(AObject);
  end;

  procedure TMultiObjectList.RemoveAll(AObject: TObject);
  begin
    while Remove(AObject) >= 0 do ;
  end;

  procedure TMultiObjectStringList.PutObject(Index: Integer; AObject: TObject);
  var
    Temp: TObject;
    B: Boolean;
    i: Integer;
  begin
    if Assigned(AObject) then begin
      Temp := Objects[Index];
      if Temp <> AObject then begin
        inherited;
        if IndexOf(Temp) < 0 then
          Temp.Free;
      end;
    end else inherited;
  end;

  destructor TMultiObjectStringList.Destroy;
  begin
    OnChange := nil;
    OnChanging := nil;
    Clear;
    inherited;
  end;

  procedure TMultiObjectStringList.Clear;
  var
    i, i2: Integer;
    Temp: Tobject;
  begin
    BeginUpdate;
    try
      if (Count <> 0) and OwnsObjects then
        for i := Count - 1 downto 0 do begin
          Temp := Objects[i];
          for i2 := i - 1 downto 0 do
            if Objects[i2] = Temp then Objects[i2] := nil;
          Objects[i] := nil;
          Temp.Free;
        end;
      inherited;
    finally
      EndUpdate;
    end;
  end;

  procedure TMultiObjectStringList.Delete(Index: Integer);
  var
    Temp: Tobject;
    i: Integer;
  begin
    if OwnsObjects then begin
      BeginUpdate;
      try
        Temp := Objects[Index];
        for i := Count - 1 downto 0 do
          if (i <> Index) and (Objects[i] = Temp) then begin
            Objects[Index] := nil;
            break;
          end;
        inherited;
      finally
        EndUpdate;
      end;
    end else inherited;
  end;

  {$IFDEF UseGenerics}

    procedure TMultiObjectList<T>.Notify(const Value: T; Action: TCollectionNotification);
    var
      B: Boolean;
      i: Integer;
    begin
      if (Action = cnRemoved) and OwnsObjects then begin
        if Assigned(OnNotify) then OnNotify(Self, Value, cnRemoved);
        if IndexOf(Value) < 0 then Value.Free;
      end else inherited;
    end;

    function TMultiObjectList<T>.Remove(const Value: T; RemoveAll: Boolean): Integer;
    var
      i: Integer;
    begin
      if RemoveAll then begin
        Result := -1;
        repeat
          i := Remove(Value);
          if i >= 0 then Result := i;
        until i < 0;
      end else Result := Remove(AObject);
    end;

    procedure TMultiObjectList<T>.RemoveAll(const Value: T);
    begin
      while Remove(Value) >= 0 do ;
    end;

  {$ENDIF}

end.

[edits]
- kleine Optimierungen (einige For-Schleifen gegen IndexOf ersetzt)
- RemoveAll und Co. eingeführt
- RemoveAll-Parameter wird nun auch beachtet

[Stevie]

Zumindest bei der TMultiObjectList<T> musst du noch Remove überschreiben/überladen. Imho müsste über diese Methode jede Referenz aus der Liste gelöscht werden und nicht nur die erste gefundene.

[himitsu]

Zitat von Stevie:

Zumindest bei der TMultiObjectList<T> musst du noch Remove überschreiben/überladen. Imho müsste über diese Methode jede Referenz aus der Liste gelöscht werden und nicht nur die erste gefundene.

Hmmm joar, ist soeine Sache ... eigentlich wollte ich nur das Löschverhalten beeinflussen und nicht den Aufbau der Listen.

Normaler Weise entfernt Remove doch nur den ersten Fund aus der Liste
und nicht alle Vorkommen ... aber die normale (generische) Objektliste gibt dennoch das Objekt frei, selbst wenn es nochmals in der Liste steht.

So jetzt besser?
RemoveAll(Value: T) .
oder wäre ein Remove(Value: T; RemoveAll: Boolean = false) besser?

[edit]
Hab nun Beides verbaut.

[Stevie]

Zitat von himitsu:

Hab nun Beides verbaut.

Solltest noch den Parameter RemoveAll in der Remove Methode berücksichtigen.

Edit: Evtl wäre es auch sinnig, die Eigenschaft Duplicates vom Typ
TDuplicates = (dupIgnore, dupAccept, dupError); einzubauen (so wie in TStringList z.B.)

[himitsu]

Zitat von Stevie:

Solltest noch den Parameter RemoveAll in der Remove Methode berücksichtigen.

kümmer mich gleich drum (blödes Copy&Paste)

Zitat von Stevie:

Edit: Evtl wäre es auch sinnig, die Eigenschaft Duplicates vom Typ
TDuplicates = (dupIgnore, dupAccept, dupError); einzubauen (so wie in TStringList z.B.)

Ich war erst auf die Idee gekommen das OwnerObjects zu verändern, von einem Boolean zu einem Enum, mit mehreren Auswahlmöglichkeiten, aber das ließ sich nachträglich nicht gut ändern.

Wobei, wie schon erwähnt, diese Lieste ja eigentlich mehrere gleiche Objekte enthalten soll/darf, da wäre es doch kontraproduktiv, wenn man dieses jetzt auch noch verhindert/verbietet?