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.