TStrings und Assign

[Sir Rufo]

Zitat von Bjoerk:

TPersistent.Assign bzw. TPersistent.AssignTo machen nichts außer Fehlermeldungen anzuzeigen. Weshalb es diese Implentierung überhaupt gibt hab ich noch nie verstanden? TStrings.Assign ruft TPersistent.Assign auf wenn Source <> TStrings ist. TStrings hat kein AssignTo. Deine Klasse braucht deshalb ein eigenes AssignTo oder mit TStrings.Assign arbeiten (falls möglich)?

Das TPersisten.Assign und TPersistent.AssignTo ist ja nicht ausschließlich für TStrings eingeführt worden, sondern auch um eigene Klassen zu implementieren.

Dann kommt zum besseren Verständnis hier mal eine Preisfrage:

Gegeben sind zwei Klassen in zwei getrennten Units:

Delphi-Quellcode:

unit Model_Person;

interface

uses
  Classes;

type
  TPerson = class( TPersistent )
  private
    FFirstname : string;
    FLastname : string;
    procedure AssignToPerson( Other : TPerson );
  protected
    procedure AssignTo( Dest : TPersistent ); override;
  public
    constructor Create( const Firstname, Lastname : string );
  published
    property Firstname : string read FFirstname;
    property Lastname : string read FLastname;
  end;

implementation

{ TPerson }

procedure TPerson.AssignTo( Dest : TPersistent );
begin
  if Dest is TPerson
  then
    AssignToPerson( Dest as TPerson )
  else
    inherited;
end;

procedure TPerson.AssignToPerson( Other : TPerson );
begin
  Other.FFirstname := Self.FFirstname;
  Other.FLastname := Self.FLastname;
end;

constructor TPerson.Create( const Firstname, Lastname : string );
begin
  inherited Create;
  FFirstname := Firstname;
  FLastname := Lastname;
end;

end.

und das entsprechende DatenTransferObjekt dazu

Delphi-Quellcode:

unit DTO_Person;

interface

uses
  Classes;

type
  TPerson_DTO = class( TPersistent )
  private
    FFirstname : string;
    FLastname : string;
    procedure AssignToPerson_DTO( Other : TPerson_DTO );
  protected
    procedure AssignTo( Dest : TPersistent ); override;
  published
    property Firstname : string read FFirstname write FFirstname;
    property Lastname : string read FLastname write FLastname;
  end;

implementation

{ TPerson_DTO }

procedure TPerson_DTO.AssignTo( Dest : TPersistent );
begin
  if Dest is TPerson_DTO
  then
    AssignToPerson_DTO( Dest as TPerson_DTO )
  else
    inherited;
end;

procedure TPerson_DTO.AssignToPerson_DTO( Other : TPerson_DTO );
begin
  Other.FFirstname := Self.FFirstname;
  Other.FLastname := Self.FLastname;
end;

end.

Nun wollen wir folgendes erreichen

Delphi-Quellcode:

program dp_180780;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils,
  Model_Person in 'Model_Person.pas',
  DTO_Person in 'DTO_Person.pas';

procedure Main;
var
  LPerson_DTO : TPerson_DTO;
  LPerson : TPerson;
begin
  LPerson := TPerson.Create( 'Peter', 'Lustig' );
  try
    LPerson_DTO := TPerson_DTO.Create;
    try
      LPerson_DTO.Assign( LPerson );
      LPerson_DTO.Firstname := 'Erwin';
      LPerson.Assign( LPerson_DTO );
    finally
      LPerson_DTO.Free;
    end;
  finally
    LPerson.Free;
  end;
end;

begin
  try
    Main;
  except
    on E : Exception do
      Writeln( E.ClassName, ': ', E.Message );
  end;

end.

Wie muss nun die Implementierung aussehen (ohne beide Klassen in eine Unit zu packen)?

Auflösung Model_Person.pas