Objekt kopieren... gibt es was Neues ?

[stahli]

Ich habe (unter XE) eine eigene Funktion geschrieben, die bestimmte Objekteigenschaften direkt an ein anderes Objekt zuweist.

Die betreffenden Eigenschaften sind mit einem Attribut gekennzeichnet.
Die Objekte (Tod) haben eine gemeinsame Basis. Die Ableitungen (Todl) verwalten zusätzlich eine Liste von Tod-Objekten.

Falls jemand eine Anregung daraus übernehmen will, hier der Quelltext:

Delphi-Quellcode:

  TodCourt = class(TodCustomStahliSport)
    ...
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function IsFree: Boolean;
    [AttrOd] // <- Kennzeichnung zum Kopieren
    property Number: Integer read get_Number write set_Number;
    [AttrOd]
    property CourtType: TCourtType read get_CourtType write set_CourtType;
    [AttrOd]
    property Activate: Boolean read get_Activate write set_Activate;
    [AttrOd]
    property Game: TodGame read get_Game write set_Game;
    [AttrOd]
    property PositionValues: String read get_PositionValues write set_PositionValues;
  published
  end;

//

procedure TodProp.AssignFromTo(odFrom, odTo: Tod);
var
  ContextFrom: TRttiContext;
  ContextTo: TRttiContext;
  RttiTypeFrom: TRttiType;
  RttiTypeTo: TRttiType;
  PropInfoFrom: TRttiProperty;
  PropInfoTo: TRttiProperty;
  FFrom: Boolean;
  FTo: Boolean;
  AttrFrom: TCustomAttribute;
  AttrTo: TCustomAttribute;
  ValueFrom: TValue;
  ValueTo: TValue;
  _oFrom, _oTo: TObject;
  _odFrom, _odTo: Tod;
  odlFrom: Todl;
  odlTo: Todl;
begin
  if (not Assigned(odFrom)) or (not Assigned(odTo)) then
    Exit;

  ContextFrom := TRttiContext.Create;
  RttiTypeFrom := ContextFrom.GetType(odFrom.ClassType);

  ContextTo := TRttiContext.Create;
  RttiTypeTo := ContextTo.GetType(odTo.ClassType);

  if (Assigned(RttiTypeFrom)) and (Assigned(RttiTypeTo)) then
    begin
      for PropInfoFrom in RttiTypeFrom.GetProperties do
        begin
          FFrom := False;
          for AttrFrom in PropInfoFrom.GetAttributes do
            begin
              if AttrFrom is AttrOd then
                FFrom := True;
            end;
          if FFrom then
            begin
              for PropInfoTo in RttiTypeTo.GetProperties do
                begin
                  FTo := False;
                  for AttrTo in PropInfoTo.GetAttributes do
                    begin
                      if AttrTo is AttrOd then
                        FTo := True;
                    end;
                  if FTo then
                    begin
                      if PropInfoFrom.PropertyType = PropInfoTo.PropertyType then
                        begin
                          ValueFrom := PropInfoFrom.GetValue(odFrom);
                          if PropInfoTo.IsWritable then
                            begin
                              PropInfoTo.SetValue(odTo, ValueFrom);
                            end
                          else
                            begin
                              _oFrom := ValueFrom.AsObject;
                              if _oFrom is Tod then
                                _odFrom := (_oFrom as Tod)
                              else
                                _odFrom := nil;
                              ValueTo := PropInfoTo.GetValue(odFrom);
                              _oTo := ValueTo.AsObject;
                              if _oTo is Tod then
                                _odTo := (_oTo as Tod)
                              else
                                _odTo := nil;
                              if Assigned(_odTo) then
                                begin
                                  if Assigned(_odFrom) then
                                    _odTo.Assign(odFrom)
                                  else
                                    _odTo.Clear;
                                end;
                            end;
                        end;
                    end;
                end;
            end;
        end;
    end;

  ContextFrom.Free;
  ContextTo.Free;

  if (odFrom is Todl) and (odTo is Todl) then
    begin
      odlFrom := (odFrom as Todl);
      odlTo := (odTo as Todl);
      // outputdebugstring(pchar('a:' + inttostr(odlFrom.Items.Count)));
      // outputdebugstring(pchar('b:' + inttostr(odlTo.Items.Count)));
      odlTo.Items.Assign(odlFrom.Items);
      // outputdebugstring(pchar('c:' + inttostr(odlFrom.Items.Count)));
      // outputdebugstring(pchar('d:' + inttostr(odlTo.Items.Count)));
    end;
end;

@haentschman

Mit generischen Klassen sollte eine solche Serialisierung auch funktionieren. Man kann lediglich nicht eine generische Klasse von einer anderen ableiten und diese Ableitung später nachvollziehen (sofern ich das so richtig zusammenfasse).