Einzelnen Beitrag anzeigen

Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#16

AW: TObjectList als Result

  Alt 28. Okt 2014, 12:02
Ähm, ja, so ist doch die Frage, darum geht es doch dem TE (der übrigens auch nur Delphi 7 hat, was soll der da mit Generics?)
Eben!
Mir ist schleierhaft, was der TE mit der von Stevie vorgeschlagenen, selbst gebastelten "TInterfacedObjectList" anfangen soll?!

Delphi-Quellcode:
unit Unit1;

interface

uses
  Contnrs,
  Classes;

type
  IObjectList = interface
    ['{056BC23C-2F12-40DF-A0F7-2A9AE55ADADB}']
    function Add( AObject: TObject ): Integer;
    function Extract( Item: TObject ): TObject;
    function ExtractItem( Item: TObject; Direction: TList.TDirection ): TObject;
    function Remove( AObject: TObject ): Integer; overload;
    function RemoveItem( AObject: TObject; ADirection: TList.TDirection ): Integer;
    function IndexOf( AObject: TObject ): Integer;
    function IndexOfItem( AObject: TObject; ADirection: TList.TDirection ): Integer;
    function FindInstanceOf( AClass: TClass; AExact: Boolean = True; AStartAt: Integer = 0 ): Integer;
    procedure Insert( Index: Integer; AObject: TObject );
    function First: TObject;
    function Last: TObject;
    function GetOwnsObjects: Boolean;
    procedure SetOwnsObjects( const Value: Boolean );
    property OwnsObjects: Boolean read GetOwnsObjects write SetOwnsObjects;
    function GetItem( Index: Integer ): TObject;
    procedure SetItem( Index: Integer; AObject: TObject );
    property Items[Index: Integer]: TObject read GetItem write SetItem; default;
  end;

  TInterfacedObjectList = class( TObjectList, IInterface, IObjectList )
  private // IInterface
    FRefCount: Integer;
    function QueryInterface( const IID: TGUID; out Obj ): HRESULT; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  private // IObjectList
    function GetOwnsObjects: Boolean;
    procedure SetOwnsObjects( const Value: Boolean );
  end;

implementation

{ TInterfacedObjectList }

function TInterfacedObjectList.GetOwnsObjects: Boolean;
begin
  Result := OwnsObjects;
end;

function TInterfacedObjectList.QueryInterface( const IID: TGUID; out Obj ): HRESULT;
begin
  if GetInterface( IID, Obj )
  then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

procedure TInterfacedObjectList.SetOwnsObjects( const Value: Boolean );
begin
  OwnsObjects := Value;
end;

function TInterfacedObjectList._AddRef: Integer;
begin
  Result := AtomicIncrement( FRefCount );
end;

function TInterfacedObjectList._Release: Integer;
begin
  Result := AtomicDecrement( FRefCount );
  if Result = 0
  then
    Destroy;
end;

end.
Und dann im seinem Quelltext
Delphi-Quellcode:
function TForm1.imageloader: IObjectList;
begin
    Result := TInterfacedObjectList.Create( False );
    Result.Add(Image1);
    Result.Add(Image2);
    Result.Add(Image3);
    Result.Add(Image4);
    Result.Add(Image5);
    Result.Add(Image6);
    Result.Add(Image7);
end;

procedure TForm1.Button1Click(Sender: TObject);

var
    MyList: IObjectlist;
    counter : integer;
begin

    Mylist := ImageLoader; // Jetzt Interface, jetzt keine Speicherlecks mehr
    Allrounder := TImage(Imageloader.Items[5]); // <- da wird schon wieder eine erzeugt!!!, aber ist ja JETZT kein Problem mehr
    Allrounder.Picture.LoadFromFile('Unbenannt.jpg');

end;
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)

Geändert von Sir Rufo (28. Okt 2014 um 12:08 Uhr)
  Mit Zitat antworten Zitat