Objekt kopieren... gibt es was Neues ?

[himitsu]

Zitat von himitsu:

PS: Beim Button (allem ab TComponent, wenn ordentlich programmiert), kannst du auch TStream verwenden.
TStream.ReadComponent und Co.

PS: Hatte noch was nacheditiert.

Zum Auslesen müßtest du aber die Komponente erstemal erstellen und dann mit den StreamDaten befüllen.
Vollen Klassennamen merken und dann kann man über die RTTI die Typdeklaration der Klasse suchen und darüber erstellen lassen.
Ich glaub daheim hab ich noch irgendwo etwas dafür-

[haentschman]

Danke erstmal...

Bei meinen Anforderungen handelt es sich ausschließlich um eigene "Daten"-Objekte.

Nachtrag:
Ich hatte diverse Beiträge auf Seite 1 übersehen. Vor allem der Link in Beitrag 9 http://www.delphipraxis.net/1152083-post9.html und der weiterführende Link sind sehr aufschlußreich.

Danke an alle. Wenn das, so wie verlautet, auch mit generischen Listen im Objekt funktioniert, wäre das "Muster" gut geeignet für die CodeLib...

Nachtrag Lösung:
habe jetzt nach folgendem Muster umgestellt...

Delphi-Quellcode:

.....
uses
  DBXJSON, DBXJSONReflect;
.....
 
function DeepCopy(aValue: TObject): TObject;
var
  MarshalObj: TJSONMarshal;
  UnMarshalObj: TJSONUnMarshal;
  JSONValue: TJSONValue;
begin
  Result:= nil;
  MarshalObj := TJSONMarshal.Create;
  UnMarshalObj := TJSONUnMarshal.Create;
  try
    JSONValue := MarshalObj.Marshal(aValue);
    try
      if Assigned(JSONValue) then
        Result:= UnMarshalObj.Unmarshal(JSONValue);
    finally
      JSONValue.Free;
    end;
  finally
    MarshalObj.Free;
    UnMarshalObj.Free;
  end;
end;

Verwendung...

Delphi-Quellcode:

.....
var
  MyObject1,
  MyObject2: TMyObject;
begin
  //Regular object construction
  MyObject1:= TMyObject.Create;

  //Deep copying an object
  MyObject2:= TMyObject(DeepCopy(MyObject1));

  try
    //Do something here

  finally
    MyObject1.Free;
    MyObject2.Free;
  end;
end;

Die Verwendung als ClassHelper ist auch sehr interessant. (Siehe Link)

Erste Tests sind gut. Wollen wir dann mal schauen wie das mit "Unterobjekten" und generischen Listen funktioniert.

Danke an alle...

[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).