AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

TObjectList als Result

Ein Thema von Kuehter · begonnen am 27. Okt 2014 · letzter Beitrag vom 28. Okt 2014
 
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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 06:39 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz