Clear von TList überschreiben mit Objekten

[Luckie]

Ich habe eine Klasse von TObject abgeleitet mit einer inneren Liste vom Typ TList. Diese fülle ich mit Objekten. Hin und wieder muss ich eine Kopie dieser Liste anfertigen. Dazu hab eich mir eine Methode Assign geschrieben:

Delphi-Quellcode:

procedure TPageCollection.Assign(Source: TPageCollection);
var
  i                 : Integer;
  j                 : Integer;
  hobj              : Integer;
  hObjSource        : Integer;
  Page              : TImageEnVect;
begin
  // Klassenattribute kopieren
  PageParent := Source.PageParent;
  ScaleFactor := Source.ScaleFactor;
  for i := 0 to Source.Count - 1 do
  begin
    Page := TImageEnVect.Create(nil);
    // Seiteneigenschaften kopieren
    Page.Name := Source.Items[i].Name;
    Page.Parent := PageParent; //Source.Items[i].Parent;
    Page.Visible := False;
    Page.AllowOutOfBitmapMoving := False;
    Page.BorderStyle := bsNone;
    Page.ScrollBars := ssNone;
    Page.Cursor := crArrow;
    Page.DragMode := dmManual;
    Page.Width := Source.Items[i].Width;
    Page.Height := Source.Items[i].Height;
    Page.OnDragOver := Source.Items[i].OnDragOver;
    Page.OnDragDrop := Source.Items[i].OnDragDrop;
    Page.OnMouseDown := Source.Items[i].OnMouseDown;
    Page.OnObjectDblClick := Source.Items[i].OnObjectDblClick;
    Page.OnLayerNotify := Source.Items[i].OnLayerNotify;
    // Seiten-Layer kopieren. Bitmap nicht mit kopieren.
    for j := 1 to Source.Items[i].LayersCount - 1 do
    begin
      hobj := Page.LayersAdd;
      Page.Layers[hobj].Assign(Source.Items[i].Layers[j]);
    end;
    // Textobjekte
    for j := 0 to Source.Items[i].ObjectsCount - 1 do
    begin
      hobj := Page.AddNewObject;
      hObjSource := Source.Items[i].GetObjFromIndex(j);
      Page.ObjUserData[hObjSource] := Source.Items[i].ObjUserData[hObjSource];
      Page.ObjKind[hobj] := Source.Items[i].ObjKind[hObjSource];
      Page.ObjLeft[hobj] := Source.Items[i].ObjLeft[hObjSource];
      Page.ObjTop[hobj] := Source.Items[i].ObjTop[hObjSource];
      Page.ObjWidth[hobj] := Source.Items[i].ObjWidth[hObjSource];
      Page.ObjHeight[hobj] := Source.Items[i].ObjHeight[hObjSource];
      Page.ObjTextAlign[hobj] := Source.Items[i].ObjTextAlign[hObjSource];
      Page.ObjFontName[hobj] := Source.Items[i].ObjFontName[hObjSource];
      Page.ObjFontHeight[hobj] := Source.Items[i].ObjFontHeight[hObjSource];
      Page.ObjPenColor[hobj] := Source.Items[i].ObjPenColor[hObjSource];
      Page.ObjFontStyles[hobj] := Source.Items[i].ObjFontStyles[hObjSource];
      Page.ObjText[hobj] := Source.Items[i].ObjText[hObjSource];
      Page.Update;
    end;
    Add(Page);
  end;
end;

Die Instanz für die Kopie ist global (in der Klasse), damit ich aber jetzt keine Speicherlecks bekomme rufe ich die Methode Clear auf bevor ich Klasse mit der LÖiste kopiere:

Delphi-Quellcode:

procedure TPageCollection.Clear;
var
  i: Integer;
begin
  for i := FInnerList.Count - 1 downto 0 do
  begin
    TObject(FInnerList.Items[i]).Free;
  end;
//  inherited;
  //FInnerList.Clear;
end;

Das sieht dann so aus:

Delphi-Quellcode:

  TempPageCollection.Clear;
  TempPageCollection.Assign(PageCollection);

Nur leider bekomme ich eine AccessViolation in der Assign-Methode, wenn ich vorher meine Clear-Methode aufrufe.

Was mache ich da falsch? Oder wie kann man sonst Speicherlecks vermeiden?

[Ghostwalker]

Wie ist den die Items-Eigenschaft von TPageCollection definiert ?

[Luckie]

Delphi-Quellcode:

function TPageCollection.GetItem(Index: Integer): TImageEnVect;
begin
  Result := FInnerList.Items[Index];
end;

procedure TPageCollection.SetItem(Index: Integer; Item: TImageEnVect);
begin
  FInnerList.Items[Index] := Item;
end;

Und dann die Property dazu:

Delphi-Quellcode:

property Items[Index: Integer]: TImageEnVect read GetItem write SetItem;

[Ghostwalker]

hm....also das einzige was mir jetzt auffählt wäre im Clear.

Müsste das nicht

Delphi-Quellcode:

  TImageEnVect(FInnerList.Items[i]).Free;

statt

Delphi-Quellcode:

  TObject(FInnerList.Items[i]).Free;

Ansonsten mal mit dem Debuger rein, und guggen wo er genau im Assign semmelt.

[kalmi01]

ist FInnerList denn immer initialisiert ?
sonst greift Count ins Leere.

[Luckie]

Die innere Liste wird im Konstruktor erzeugt und im Destruktor wieder freigegeben. Und die TempPageCollection existiert auch. Durch die Schleife in der Clear-Methode läuft er ja auch durch, nur in der darauffolgenden Assign-Methode kracht es dann und zwar wenn der betreffende Code zum zweiten mal aufgerufen wird. Aber ich kopiere ja, also dürfte die Clear-Methode ja nichts aus der original Liste löschen oder so.

[CCRDude]

Ohne jetzt einen konkreten Fehler zu sehen, zwei etwas allgemeinere Tips:

* FreeAndNil statt Free verwenden; dadurch sieht man beim Debuggen wenigstens sofort, daß das Objekt vorher mal freigegeben wurde, statt einen Zeiger ins Irgendwo zu haben.
* In Assign nochmal expliziter mit Self. arbeiten, für den Fall das sich da irgendwo Namen und Sichtbarkeiten überschneiden.

[Ghostwalker]

Öhm...du solltest vielleicht auch den entsprechenden Listeneintrag beim Clear löschen, nicht nur das Objekt freigeben :)

Ansonsten..wie ich oben geschrieben hab.

[hoika]

Hallo,

soll Clear die Liste leeren oder nur die Objekte freigeben,
in ersterem Fall fehlt was

Delphi-Quellcode:

procedure TPageCollection.Clear;
var
  i: Integer;
begin
  for i := FInnerList.Count - 1 downto 0 do
  begin
    TObject(FInnerList.Items[i]).Free;

// das fehlt
    FInnerList.Delete(i);

// oder ungetestet
// FInnerLIst.Remove(FInnerList.Items[i])

  end;
end;

Durch Free des Objektes wird zwar as Objekt freigegeben,
aber nicht der Listeneintrag (Pointer),
Count bliebt also immer gleich, nur der Pointer zeugt ins Nirvana.

Ich würde per {$IFDEF DEBUG} eh immer FreeAndNIL benutzen,
dann bekommt du wenigstens (hoffentlich) ne bessere Fehlermeldung.


Heiko
PS: Schon mal TObjectlist versucht ?

[Phantom1]

@hoika: ein FInnerList.Clear reicht auch aus um alle Listeneinträge der TList zu entfernen, das hat Luckie auch gemacht (allerdings ist der code bei ihm auskommentiert).

Delphi-Quellcode:

procedure TPageCollection.Clear;
var
  i: Integer;
begin
  for i := FInnerList.Count - 1 downto 0 do
  begin
    TObject(FInnerList.Items[i]).Free;
  end;
  FInnerList.Clear;
end;

[Luckie]

Ich habe es jetzt so:

Delphi-Quellcode:

procedure TPageCollection.Clear;
var
  i: Integer;
begin
  for i := Self.FInnerList.Count - 1 downto 0 do
  begin
    TObject(Self.FInnerList.Items[i]).Free;
    Self.FInnerList.Items[i] := Nil;
    Self.FInnerList.Delete(i);
  end;
//  inherited;
  //FInnerList.Clear;
end;

Aber da bekomme ich in der Assign-Methode auch wieder eine AV. :gruebel:

Die Logdatei von FastMM wird übrigens immer größer. :wall:

[mirage228]

Wieso verwendest Du nicht einfach TObjectList ?

mfG
mirage228

[Phantom1]

@Luckie: könntest du mal die deklaration von TPageCollection posten?

[Luckie]

@David: Weil ich damit am Anfang unerklärliche Probleme hatte.

Delphi-Quellcode:

TPageCollection = class(TObject)
  private
    FInnerList: TList;
    FPageParent: TWinControl;
    FPageOptions: TPageProperties;
    FScaleFactor: Double;
    FOnAfterAdd: TOnAfterAdd;
    FOnAfterDelete: TOnAfterDelete;
    FOnProgress: TOnProgress;
    FOnSaveFinish: TOnSaveFinish;
    FOnLoadFinish: TOnLoadFinish;
    { Getter und Setter } {}
    function GetScaleFactor: Double;
    procedure SetScaleFactor(const Value: Double);
    function GetPageParent: TWinControl;
    procedure SetPageParent(const Value: TWinControl);
    function GetItem(Index: Integer): TImageEnVect;
    procedure SetItem(Index: Integer; Item: TImageEnVect);
    function GetPageOptions: TPageProperties;
    procedure SetPageOptions(PageOptions: TPageProperties);
    { Private Methoden } {}
    procedure Renumber;
    procedure RescalePage(Page: TImageEnvect);
  public
    constructor Create; overload;
    destructor Destroy; override;
    { Methode zum "Clonen" der Seitenliste }
    procedure Assign(Source: TPageCollection);
    { TList Methoden } {}
    procedure Add(Item: TImageEnVect);
    procedure Clear;
    function Count: Integer;
    procedure Delete(Index: Integer);
    procedure Insert(Index: Integer; Item: TImageEnVect);
    { Fotobook spezifische Erweiterungen für Liste } {}
    { Aktualisiert Seite in der Liste und skaliert sie zurück. }
    procedure UpdatePage(Page: TImageEnVect);
    { Speichert eine Seite ohne sie zurück zu skalieren. }
    procedure Save(Page: TImageEnVect);
    { Liefert den Index einer Seite nach Namen. }
    function FindItemByName(const Name: WideString): Integer;
    { Speichert die Seiten in einem eignen, komprimierten Dateiformat
      mit Bildern und XML-Datei zur Beschreibung der Seiten.
      Ausgelagert in die Klasse TPagesIO. }
    procedure SavePages(const Filename: WideString);
    { Läd Seiten aus einer Fotobuchdatei.
      Ausgelagert in die Klasse TPagesIO. }
    procedure LoadPages(const Filename: WideString);
    { Öffentliche Eigenschaften }{}
    property ScaleFactor: Double read GetScaleFactor write SetScaleFactor;
    property PageParent: TWinControl read GetPageParent write SetPageParent;
    property Items[Index: Integer]: TImageEnVect read GetItem write SetItem;
    property PageOptions: TPageProperties read GetPageOptions write SetPageOptions;
    property OnAfterAdd: TOnAfterAdd read FOnAfterAdd write FOnAfterAdd;
    property OnAfterDelete: TOnAfterDelete read FOnAfterDelete write FOnAfterDelete;
    property OnProgress: TOnProgress read FOnProgress write FOnProgress;
    property OnSaveFinish: TOnSaveFinish read FOnSaveFinish write FOnSaveFinish;
    property OnLoadFinish: TOnLoadFinish read FOnLoadFinish write FOnLoadFinish;
  end;

[Phantom1]

Könnte es sein das:

Delphi-Quellcode:

Page.ObjUserData[hObjSource] := Source.Items[i].ObjUserData[hObjSource];

evtl so aussehen muss?:

Delphi-Quellcode:

Page.ObjUserData[hObj] := Source.Items[i].ObjUserData[hObjSource];

[Luckie]

Stimmt, das war ein Fehler, aber der ändert leider nichts an der AV. :cry:

[Ghostwalker]

Geh doch mal mit dem Debugger rein und schau, bei welcher Anweisung er im Assign knallt. Das grenzt die Möglichkeiten doch schon arg ein :)

[hoika]

Hallo,

vielleicht liegt es am class(TObject),
dass muss doch nicht rein.

Mach doch mal ein kleines kompilierbares Bsp
und hänge es an dein Posting.


Heiko

[Ghostwalker]

Dem Compiler ist es ziemlich egal ob du schreibst =class oder =class(TObject). Das Ergebnis ist das gleiche :)

[hoika]

Mir nicht ;)

cih würde das TObject(XXX).Free ersetzen durch die richtige Klasse.

Die internen Assign's macht mir auch Sorgen,
nicht dass du dort irgendwo direkt Pointer aus Source übergibst.

Wo genau im Assign kommt denn der Fehler ?


Heiko

[Luckie]

Auch wenn ich Nach TImageEnVect catse kommt es zur AV. Wo er genau in der Assign-Methode aussteigt versuche ich gerade zu ermitteln.

aber es ist doch richtig, dass es zu einem Speicherleck an dieser Stelle kommt, wenn ich in der Methode Clear die Objekte in der Liste nicht freigebe oder?

[hoika]

Ja,

ist richtig.
Ich habe den Tag rot angestrichen, als ich von memcheck gehört habe ;)
Naja, die folgenden Tage war ich mit Leck abdichten beschäftigt ;)


Heiko

[Phantom1]

Zitat:

Zitat von Luckie

aber es ist doch richtig, dass es zu einem Speicherleck an dieser Stelle kommt, wenn ich in der Methode Clear die Objekte in der Liste nicht freigebe oder?

Speicherlecks dürfte es eigentlich nicht geben, da ja beim TList.destroy auch die clear methode immer aufgerufen wird.

Ich empfehle aber trotzdem FInnerList.Clear in deiner TPageCollection.clear methode aufzurufen.

[DGL-luke]

Eine TList macht glaube ich nur ein Dispose beim Clear. Das heißt, hat man Objekte drin, dann gibts n Speicherleck, wenn man die nicht zuvor freigibt.

[Luckie]

Ich habe mal nachgeguckt. Clear von TList setzt nur die Länge und Kapazität auf null. Da wird also nichts freigegeben.

[Phantom1]

Zitat:

Zitat von DGL-luke

Eine TList macht glaube ich nur ein Dispose beim Clear. Das heißt, hat man Objekte drin, dann gibts n Speicherleck, wenn man die nicht zuvor freigibt.

Ja, aber Luckie gibt ja die Objekte direkt frei, von daher gibt es keine speicherlecks:

Delphi-Quellcode:

procedure TPageCollection.Clear;
var
  i: Integer;
begin
  for i := FInnerList.Count - 1 downto 0 do
  begin
    TObject(FInnerList.Items[i]).Free;
  end;
  FInnerList.Clear;
end;

[Luckie]

Nur leider führt dieser Code zu einer AV, wenn ich danach Assign aufrufe.

[Hawkeye219]

Hallo Michael,

ein Leck könnte hier entstehen:

Delphi-Quellcode:

procedure TPageCollection.SetItem(Index: Integer; Item: TImageEnVect);
begin
  FInnerList.Items[Index] := Item;
end;

TList schickt zwar beim Entfernen des alten Elements eine Notification, aber erst in TObjectList wird diese Nachricht abgehört. Du solltest also vor der Zuweisung das alte Element selbst freigeben.

Was die AV angeht: wurden die TImageEnVect-Controls eventuell schon von ihrem Parent zerstört, wenn du versuchst, sie zu freizugeben? klick

Gruß Hawkeye

[Luckie]

Ich sehe gerade im Debugger:

Zitat:

Debug Output: FastMM has detected an attempt to call a virtual method on a freed object. An access violation will now be raised in order to abort the current operation.

Freed object class: TImageEnVect

Virtual method: Destroy

Virtual method address: 5BC0D0

Process DWFotoBook.exe (3288)

Heißt dass, dass da schon was freigegeben wurde? Ich wüsste aber nicht wo das im Quelltext passiert sein sollte.

[Phantom1]

Ich denke mal du gibts irgendwo vorher schon ein TImageEnVect-objekt mit FInnerlist.Items[i].free, aber vergisst diesen itemeintrag auch aus der TList zu löschen mit FInnerlist.delete(i).

bsp:

du hast 4 objekte in der TList:

Finnerlist.Items[0]
Finnerlist.Items[1]
Finnerlist.Items[2]
Finnerlist.Items[3]

und du gibst jetzt das 3te Item frei mit FInnerlist.Items[2].free (ohne anschließenden aufruf finnerlist.delete(2)), dann sieht es so aus;

Finnerlist.Items[0]
Finnerlist.Items[1]
Finnerlist.Items[2] (item immernoch verhanden, aber objekt bereits freigegeben
Finnerlist.Items[3]

In deiner Assign methode werden dann alle objekte durchgegangen und auf FInnerlist.Items[2] zugegriffen, obwohl das objekt bereits freigegeben wurde.

[Luckie]

So, ich habs:

Code:

FastMM has detected an attempt to call a virtual method on a freed object. An access violation will now be raised in order to abort the current operation.

Freed object class: TImageEnVect

Virtual method: Offset +136

Virtual method address: 4E9078

The allocation number was: 71947

Stack trace of when the object was allocated (return addresses):
402FDE [System][@GetMem]
404453 [System][TObject.NewInstance]
40481A [System][@ClassCreate]
5BB985 [ievect][TImageEnVect.Create]
4227E9 [FastMM4][TList.SetCapacity]
422650 [FastMM4][TList.Grow]
5FCCB4 [units\FotoBook\Units\PageCollection.pas][PageCollection][TPageCollection.Add][148]
5FCD37 [units\FotoBook\Units\PageCollection.pas][PageCollection][TPageCollection.Assign][171]
6078DF [units\FotoBook\Units\FotoBook.pas][FotoBook][TFotoBook.Display][1227]
6515DE [formulare\frmMain.pas][frmMain][TMain.lbPageListClick][376]

Stack trace of when the object was subsequently freed (return addresses):
404471 [System][TObject.FreeInstance]
404865 [System][@ClassDestroy]
5BC186 [ievect][TImageEnVect.Destroy]
4044B7 [System][TObject.Free]
5FD0DC [units\FotoBook\Units\PageCollection.pas][PageCollection][TPageCollection.Clear][230]
6078D4 [units\FotoBook\Units\FotoBook.pas][FotoBook][TFotoBook.Display][1226]
6515DE [formulare\frmMain.pas][frmMain][TMain.lbPageListClick][376]
46070A [Controls][TControl.Click]
44734A [StdCtrls][TCustomListBox.CNCommand]
460202 [Controls][TControl.WndProc]

The current stack trace leading to this error (return addresses): 
5FD441 [units\FotoBook\Units\PageCollection.pas][PageCollection][TPageCollection.RescalePage][400]
5FCCB4 [units\FotoBook\Units\PageCollection.pas][PageCollection][TPageCollection.Add][148]
5FD287 [units\FotoBook\Units\PageCollection.pas][PageCollection][TPageCollection.UpdatePage][347]
607906 [units\FotoBook\Units\FotoBook.pas][FotoBook][TFotoBook.Display][1235]
6515DE [formulare\frmMain.pas][frmMain][TMain.lbPageListClick][376]
46070A [Controls][TControl.Click]
44734A [StdCtrls][TCustomListBox.CNCommand]
460202 [Controls][TControl.WndProc]
7E36C665 [CallWindowProcW]
4B763D [TntControls.pas][TntControls][TWinControlTrap.DefWin32Proc][604]

Der zugehörige Quellcode:

Delphi-Quellcode:

TempPageCollection.Clear;
  TempPageCollection.Assign(PageCollection);
  
  // nur im Entwurfsmodus speichern
  if (DisplayMode = dmDesign) then
  begin
    // Seiten sichern und in Liste aktualisieren
    if Assigned(LeftPage) then
    begin
      PageCollection.UpdatePage(LeftPage);
    end;
    if Assigned(RightPage) then
    begin
      PageCollection.UpdatePage(RightPage);
    end;
  end;

Aber ich verstehe eins nicht: Ich lösche doch die temporäre Liste (TempPageColelction), die hat doch gar nichts mjit der original Liste (PageCollection) zu tun.

Hier noch mal meine Assign- und Clear-Methoden:

Delphi-Quellcode:

procedure TPageCollection.Assign(Source: TPageCollection);
var
  i                 : Integer;
  j                 : Integer;
  hobj              : Integer;
  hObjSource        : Integer;
  Page              : TImageEnVect;
begin
  // Klassenattribute kopieren
  PageParent := Source.PageParent;
  ScaleFactor := Source.ScaleFactor;
  for i := 0 to Source.Count - 1 do
  begin
    Page := TImageEnVect.Create(nil);
    // Seiteneigenschaften kopieren
    Page.Name := Source.Items[i].Name;
    Page.Parent := PageParent; //Source.Items[i].Parent;
    Page.Visible := False;
    Page.AllowOutOfBitmapMoving := False;
    Page.BorderStyle := bsNone;
    Page.ScrollBars := ssNone;
    Page.Cursor := crArrow;
    Page.DragMode := dmManual;
    Page.Width := Source.Items[i].Width;
    Page.Height := Source.Items[i].Height;
    Page.OnDragOver := Source.Items[i].OnDragOver;
    Page.OnDragDrop := Source.Items[i].OnDragDrop;
    Page.OnMouseDown := Source.Items[i].OnMouseDown;
    Page.OnObjectDblClick := Source.Items[i].OnObjectDblClick;
    Page.OnLayerNotify := Source.Items[i].OnLayerNotify;
    // Seiten-Layer kopieren. Bitmap nicht mit kopieren.
    for j := 1 to Source.Items[i].LayersCount - 1 do
    begin
      hobj := Page.LayersAdd;
      Page.Layers[hobj].Assign(Source.Items[i].Layers[j]);
    end;
    // Textobjekte
    for j := 0 to Source.Items[i].ObjectsCount - 1 do
    begin
      hobj := Page.AddNewObject;
      hObjSource := Source.Items[i].GetObjFromIndex(j);
      Page.ObjUserData[hObj] := Source.Items[i].ObjUserData[hObjSource];
      Page.ObjKind[hobj] := Source.Items[i].ObjKind[hObjSource];
      Page.ObjLeft[hobj] := Source.Items[i].ObjLeft[hObjSource];
      Page.ObjTop[hobj] := Source.Items[i].ObjTop[hObjSource];
      Page.ObjWidth[hobj] := Source.Items[i].ObjWidth[hObjSource];
      Page.ObjHeight[hobj] := Source.Items[i].ObjHeight[hObjSource];
      Page.ObjTextAlign[hobj] := Source.Items[i].ObjTextAlign[hObjSource];
      Page.ObjFontName[hobj] := Source.Items[i].ObjFontName[hObjSource];
      Page.ObjFontHeight[hobj] := Source.Items[i].ObjFontHeight[hObjSource];
      Page.ObjPenColor[hobj] := Source.Items[i].ObjPenColor[hObjSource];
      Page.ObjFontStyles[hobj] := Source.Items[i].ObjFontStyles[hObjSource];
      Page.ObjText[hobj] := Source.Items[i].ObjText[hObjSource];
      Page.Update;
    end;
    Self.Add(Page);
  end;
end;

procedure TPageCollection.Clear;
var
  i: Integer;
begin
  {mp, 2007-07-03 16:44}
  for i := 0 to Self.FInnerList.Count - 1 do
  begin
    if Assigned(TObject(Self.FInnerList.Items[i])) then
      TObject(Self.FInnerList.Items[i]).Free;
  end;

  Self.FInnerList.Clear;
end;

[Ghostwalker]

Kann es sein das RescalePage irgendwie auf die temporäre Liste zugreift statt aufs orginal ?

[Luckie]

Sollte eigentlich nicht sein. RescalePage wird in UpdatePage von PageCollection aufgerufen und nicht von TempPageCollection. Und die Liste in PageCollection wird ja nie gelöscht bzw. geleert.