Objekte mit Thread in eine Containerklasse laden

[Luckie]

Ich habe eine Klasse, die in einer Liste einzelne Objekte verwaltet. Dann hab eich eine Klasse mit der man die Eigenschaften der Objekte in einer Datei speichern kann (das Format ist unerheblich.) und eine Klasse mit der ich die Objekte wieder erzeugen und ihnen die gespeicherten Eigenschaften wieder zuweisen kann:

Die Containerklasse:

Delphi-Quellcode:

type
  TOnProgress = procedure(Sender: TObject; PercentDone: Integer) of object;
  TOnFinish = procedure(Sender: TObject) of object;

  TPageCollection = class(TList)
  private
    FOnProgress: TOnProgress;
    FOnSaveFinish: TOnFinish;
    FOnLoadFinish: TOnFinish;
    function GetItem(Index: Integer): TImageEnVect;
    procedure SetItem(Index: Integer; Item: TImageEnVect);
  protected
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
  public
    procedure Add(Item: TImageEnVect);
    procedure Insert(Index: Integer; Item: TImageEnVect);
    procedure Update(Index: Integer; Item: TImageEnVect);
    property Items[Index: Integer]: TImageEnVect read GetItem write SetItem;
    function FindItemByName(Name: String): Integer;
    procedure SavePages(const Filename: String);
    procedure LoadPages(const Filename: String);
    property OnProgress: TOnProgress read FOnProgress write FOnProgress;
    property OnSaveFinish: TOnFinish read FOnSaveFinish write FOnSaveFinish;
    property OnLoadFinish: TOnFinish read FOnLoadFinish write FOnLoadFinish;
  end;

Laden und Speichern:

Delphi-Quellcode:

  // parent class with shared properties and methods
  TSaveLoad = class(TThread)
  private
    FFilename: string;
    FPages: TPageCollection;
    FIEVect: TImageEnVect;
    FPercentDone: Integer;
    FSize: Int64;
    FCurrentPos: Int64;
    FOnProgress: TOnProgress;
    //FOnFinish: TOnFinish;
    procedure SetFilename(const Filename: string);
    function GetFilename: string;
    procedure SetPages(const Value: TPageCollection);
    function GetPages: TPageCollection;
    procedure SetProgress(Sender: TObject; Size, CurrentPos: Int64);
    procedure DoProgress;
  public
    property Filename: string read GetFilename write SetFilename;
    property Pages: TPageCollection read GetPages write SetPages;
    property OnProgress: TOnProgress read FOnProgress write FOnProgress;
    //property OnFinish: TOnFinish read FOnFinish write FOnFinish;
  end;

  // Loading
  TLoad = class(TSaveLoad)
  private
    FOnLoadFinish: TOnFinish;
    procedure DecompressFiles(const Filename, DestDirectory: string);
    procedure DoFinish;
  protected
    procedure Execute; override;
  public
    property OnLoadFinish: TOnFinish read FOnLoadFinish write FOnLoadFinish;
  end;

Execute sieht so aus:

Delphi-Quellcode:

procedure TLoad.Execute;
var
  XMLFile           : string;
  XMLDoc            : DomDocument;
  XMLDomList        : IXMLDOMNodeList;
  XMLNode           : IXMLDOMNode;
  i, j              : Integer;
begin
  if FileExists(FFilename) then
  begin
    DecompressFiles(FFilename, ExtractFilePath(ParamStr(0)));

    XMLFile := ExtractFilePath(ParamStr(0)) + ChangeFileExt(ExtractFilename(FFilename), '.xml');

    try
      CoInitialize(nil);

      XMLDoc := CoFreeThreadedDOMDocument.Create;
      XMLDoc.Load(XMLFile);

      // Seiten laden
      XMLDomList := XMLDoc.selectNodes('/root/pages/*');
      for j := 0 to XMLDomList.length - 1 do
      begin
        // Seite (TImageEnVect) erzeugen
        FIEVect := TImageEnVect.Create(nil);
        FIEVect.Name := Format('Page%d', [j]);
        // Layer laden
        XMLDomList := XMLDoc.selectNodes('/root/pages/singlepage/layers/*');
        for i := 0 to XMLDomList.length - 1 do
        begin
          with FIEVect do
          begin
            LayersAdd;
            XMLNode := XMLDomList.item[i].selectSingleNode('posx');
            Currentlayer.PosX := StrToInt(XMLNode.text);
            // ...;
            CurrentLayer.Bitmap.VclBitmap.LoadFromFile(ExtractFilepath(ParamStr(0)) + XMLNode.text);
          end;
        end;
        // Textobjekte laden
        XMLDomList := XMLDoc.selectNodes('/root/pages/singlepage/textobjects/*');
        for i := 0 to XMLDomList.length - 1 do
        begin
          with FIEVect do
          begin
            ObjKind[-1] := iekTEXT;
            // ...;
            AddNewObject;
          end;
        end;
        // Seite (TImageEnVect) zur Liste hinzufügen
        Pages.Add(FIEVect);
      end;
    finally
      CoUninitialize;
    end;
  end
  else
    raise Exception.CreateFmt(rsFileNotExists, [FFilename]);
  if Assigned(OnLoadFinish) then
    OnLoadFinish(self);
end;

Wie bekomme ich jetzt aber die Objekte in die Containerklasse rein? Ich habe es so probiert:

Delphi-Quellcode:

procedure TPageCollection.LoadPages(const Filename: String);
var
  Load: TLoad;
begin
  Load := TLoad.Create(True);
  try
    Load.FreeOnTerminate := True;
    Load.Pages := self;
    Load.Filename := Filename;
    Load.OnProgress := OnProgress;
    Load.OnLoadFinish:= OnLoadFinish;
    Load.Resume;
  finally

  end;
end;

Aber irgendwie sind die Objekte in der Conainerklasse doch nicht da, obwohl sie da zu sein scheinen:

Delphi-Quellcode:

procedure TForm1.OnLoadFinish(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to PageCollection.Count - 1 do
    ListBox1.Items.Add(Format('Seite %d', [i+1]));
  LBCurrentIndex := 0;
  Progressbar1.Position := 0;
end;

Das funktioniert noch. Aber das:

Delphi-Quellcode:

procedure TForm1.ListBox1Click(Sender: TObject);
var
  idx               : Integer;
begin
  idx := PageCollection.FindItemByName('Page' + IntToStr(LBCurrentIndex));
  if idx <> -1 then
  begin
    // aktuelle Seite sichern
//    PageCollection.Update(idx, ImageEnVect);
//    LBCurrentIndex := Listbox1.ItemIndex;
    // ausgewählte Seite anzeigen
    if not Assigned(ImageEnVect) then
      ImageEnVect := NewPage;
    if not Assigned(PageCollection.Items[idx]) then
      ShowMessage('Mist');
    ImageEnVect.Visible := False;
    ImageEnVect := PageCollection.Items[LBCurrentIndex];
    ImageEnVect.Visible := True;
  end;
  lblCurrPage.Caption := Format('Aktuelle Seite: %s', [PageCollection.Items[LBCurrentIndex].Name]);
end;

funktioniert nicht mehr. Als Objektname wird mir immer der Name des ersten Objektes angezeigt. Egal auf welchen Eintrag ich in der Listbox klicke. Und anzeigen tut er es mir auch nicht. Ich habe keine Ahnung, was da passiert. Sieht jemand von euch, was ich da falsch mache?

[marabu]

Hallo Michael,

fangen wir hinten an:

Zitat:

Zitat von Luckie

... Als Objektname wird mir immer der Name des ersten Objektes angezeigt. Egal auf welchen Eintrag ich in der Listbox klicke. ...

heißt das, idx ist immer 0?

Delphi-Quellcode:

procedure TForm1.ListBox1Click(Sender: TObject);
var
  idx: Integer;
begin
  idx := PageCollection.FindItemByName('Page' + IntToStr(LBCurrentIndex));
  if idx <> -1 then
  begin
    // ...
  end;
  lblCurrPage.Caption := Format('Aktuelle Seite: %s', [PageCollection.Items[LBCurrentIndex].Name]);
end;

Ich würde dann mal zuerst LBCurrentIndex überprüfen (heiß), anschließend die Methode FindItemByPage() - wenn noch nötig.

Freundliche Grüße