Richtige Objekt-Kopie? Aber wie?

[uligerhardt]

Bei nachfolgendem Testprojekt passiert bei mir kein Baba. (Wenn wir bei Baba an das Gleiche denken. )

CloneAssignTest.dpr:

Delphi-Quellcode:

program CloneAssignTest;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  CloneAssign in 'CloneAssign.pas';

var
  b1, b2: TBasis;

begin
  b1 := TAbgeleitetS.Create('StringDing', 'Blah');
  try
    b2 := b1.Clone;
    Writeln(b1.ToString);
    Writeln(b2.ToString);
  finally
    b1.Free;
  end;

  b1 := TAbgeleitetI.Create('IntDing', 4711);
  try
    b2 := b1.Clone;
    Writeln(b1.ToString);
    Writeln(b2.ToString);
  finally
    b1.Free;
  end;

  Readln;
end.

CloneAssign.pas:

Delphi-Quellcode:

unit CloneAssign;

interface

type
  TBasis = class
  strict private
    FName: string;
  public
    constructor Create(const AName: string);
    function Clone: TBasis;
    procedure Assign(Source: TBasis); virtual;
    function ToString: string; virtual;
  end;

  TAbgeleitetS = class(TBasis)
  strict private
    FText: string;
  public
    constructor Create(const AName, AText: string);
    procedure Assign(Source: TBasis); override;
    function ToString: string; override;
  end;

  TAbgeleitetI = class(TBasis)
  strict private
    FCount: Integer;
  public
    constructor Create(const AName: string; ACount: Integer);
    procedure Assign(Source: TBasis); override;
    function ToString: string; override;
  end;

implementation

uses
  SysUtils;
  
{ TBasis }

constructor TBasis.Create(const AName: string);
begin
  inherited Create;
  FName := AName;
end;

function TBasis.Clone: TBasis;
begin
  // Da der Konstruktor über ClassType aufgerufen wird (und nicht direkt
  // TBasis.CreateRaw), wird eine Instanz des richtigen Typs erzeugt:
  Result := TBasis(ClassType.Create);
  Assert(Result.ClassType = ClassType);
  Result.Assign(Self);
end;

procedure TBasis.Assign(Source: TBasis);
begin
  FName := Source.FName;
end;

function TBasis.ToString: string;
begin
  Result := FName + ': ' + ClassName;
end;

{ TAbgeleitetS }

constructor TAbgeleitetS.Create(const AName, AText: string);
begin
  inherited Create(AName);
  FText := AText;
end;

procedure TAbgeleitetS.Assign(Source: TBasis);
begin
  inherited Assign(Source);
  FText := TAbgeleitetS(Source).FText;
end;

function TAbgeleitetS.ToString: string;
begin
  Result := inherited ToString + sLineBreak + '  Text = "' + FText + '"';
end;

{ TAbgeleitetI }

constructor TAbgeleitetI.Create(const AName: string; ACount: Integer);
begin
  inherited Create(AName);
  FCount := ACount;
end;

procedure TAbgeleitetI.Assign(Source: TBasis);
begin
  inherited Assign(Source);
  FCount := TAbgeleitetI(Source).FCount;
end;

function TAbgeleitetI.ToString: string;
begin
  Result := inherited ToString + sLineBreak + '  Count = ' + IntToStr(FCount);
end;

end.

Haut das bei dir auch hin?