Unterklassen gehen bei Assign verloren

[BlueStarHH]

Hallo,

ich habe eine Oberklasse TFisch von der die Klassen TKarpfen und TZander abgeleitet sind. Ich erzeuge nun z.B. zwei Fische (TKarpfen und TZander). Dann speichere diese in einer Liste (TAquarium) ab. Anschließend kopiere ich diese Liste mit Assign in ein zweites TAquarium. In der Kopie sind nun keine TKarpfen und TZander mehr sondern nur noch 2x die Oberklasse TFisch. Es ist also in der Kopie von TAquarium irgendwie verlorgen gegangen, was für spezielle Klassen (Fische) da im Original enthalten waren. Wie kann ich das beheben? Danke!

Nachfolgend der komplette Code. Einfach ein neues Projekt erzeugen und dort einfügen. Per ShowMessage wird ausgegeben, was im Aquarium ist. An zwei Stellen habe ich einen Hinweis zum Fehler eingefügt.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, contnrs;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  TFisch = class(TPersistent)
  private
    FGewicht: Integer;
  protected
    function GetCaption: string; virtual;
  public
    procedure Assign(Source: TPersistent); override;
    property Caption: string read GetCaption;
    property Gewicht: Integer read FGewicht write FGewicht;
  end;

  TKarpfen = class(TFisch)
  protected
    function GetCaption: string; override;
  public
  end;

  TZander = class(TFisch)
  protected
    function GetCaption: string; override;
  public
  end;

  TAquarium = class(TPersistent)
  protected
    FList: TObjectList;
  public
    function GetFisch(Index: Integer): TFisch;
    procedure AddFisch(Fisch: TFisch);
    procedure Clear;
    function Count: Integer;

    constructor Create; reintroduce;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TFisch.Assign(Source: TPersistent);
begin
  if Source is TFisch then
    FGewicht := (Source as TFisch).Gewicht
  else
    inherited;
end;

function TFisch.GetCaption: string;
begin
  Result := 'Fisch';
end;

function TKarpfen.GetCaption: string;
begin
  Result := 'Karpfen';
end;

function TZander.GetCaption: string;
begin
  Result := 'Zander';
end;

procedure TAquarium.AddFisch(Fisch: TFisch);
begin
  FList.Add(Fisch);
end;

procedure TAquarium.Assign(Source: TPersistent);
var
  i: Integer;
  Item: TFisch;
begin
  if Source is TAquarium then
  begin
    Clear;

    for i := 0 to (Source as TAquarium).Count - 1 do
    begin
      Item := TFisch.Create;  //<-- Ist hier der Fehler weil hier kein TKarpfen oder TZander erzeugt wird?
      Item.Assign((Source as TAquarium).GetFisch(i));
      AddFisch(Item);
    end;
  end
  else
    inherited;
end;

procedure TAquarium.Clear;
begin
  FList.Clear;
end;

function TAquarium.Count: Integer;
begin
  Result := FList.Count;
end;

constructor TAquarium.Create;
begin
  inherited;
  FList := TObjectList.Create;
end;

destructor TAquarium.Destroy;
begin
  FList.Free;
  inherited;
end;

function TAquarium.GetFisch(Index: Integer): TFisch;
begin
  Result := FList[Index] as TFisch;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  Aquarium1, Aquarium2: TAquarium;
  Karpfen: TKarpfen;
  Zander: TZander;

begin
  Aquarium1 := TAquarium.Create;
  Aquarium2 := TAquarium.Create;

  Karpfen:= TKarpfen.Create;
  Karpfen.gewicht := 200;
  Zander:= TZander.Create;
  Zander.gewicht := 350;

  Aquarium1.AddFisch(Karpfen);
  Aquarium1.AddFisch(Zander);

  //Ausgabe: "Karpfen200, Zander350"
  ShowMessage(Aquarium1.GetFisch(0).Caption + IntToStr(Aquarium1.GetFisch(0).Gewicht) + ', '
   + Aquarium1.GetFisch(1).Caption + IntToStr(Aquarium1.GetFisch(1).Gewicht));

  Aquarium2.Assign(Aquarium1);

  //Ausgabe: "Fisch200, Fisch350"  <-- FEHLER! Soll "Karpfen200, Zander350" sein!
  ShowMessage(Aquarium2.GetFisch(0).Caption + IntToStr(Aquarium2.GetFisch(0).Gewicht) + ', '
   + Aquarium2.GetFisch(1).Caption + IntToStr(Aquarium2.GetFisch(1).Gewicht));

  Aquarium1.free;
  Aquarium2.free;
end;

end.

[Phoenix]

Du hast Dir die Frage tatsächlich schon selber beantwortet.
Du erzeugst einen TFisch und genau das. Auch beim Assign des einzelnen Fisches im Quell-Aquarium auf den Zielfisch kopierst Du nur das Gewicht.

Du könntest dem TFisch z.B. eine überschreibbare .Clone methode geben. In dieser könnte der Fisch dann einen TFisch, der Karpfen in der Überschriebenen Methode einen TKarpfen und der Koi dann einen TKoi erzeugen. Danach wird er jeweils sich selber auf den Clon per Assign zuweisen womit dann auch sein Gewicht geklont wird. Dieser Klon ist der Rückgabewert und wird dann in das neue Aquarium eingesetzt.

[Uwe Raabe]

So könnte es gehen:

Delphi-Quellcode:

...
type
  TFischClass = class of TFisch;
...
var
  SourceItem: TFisch;
...
      SourceItem := (Source as TAquarium).GetFisch(i);
      Item := TFischClass(SourceItem.ClassType).Create;
      Item.Assign(SourceItem);
...

Schwieriger wird es, wenn die abgeleiteten Klassen eigene Konstruktoren haben, die irgendetwas Wichtiges machen. Aber dann kannst du ja nochmal fragen...

[mjustin]

Dieser Thread beschreibt es recht umfassend:

http://www.delphipraxis.net/internal...t.php?t=159696

[BlueStarHH]

Zitat:

Zitat von Uwe Raabe

So könnte es gehen:

Delphi-Quellcode:

...
type
  TFischClass = class of TFisch;
...
var
  SourceItem: TFisch;
...
      SourceItem := (Source as TAquarium).GetFisch(i);
      Item := TFischClass(SourceItem.ClassType).Create;
      Item.Assign(SourceItem);
...

Schwieriger wird es, wenn die abgeleiteten Klassen eigene Konstruktoren haben, die irgendetwas Wichtiges machen. Aber dann kannst du ja nochmal fragen...

Vielen Dank! Das klappt so!