komponente kopieren / duplizieren

[u-boot]

Zum Kopieren von Komponenten fand ich untenstehenden Delphi-Code. Dieser läuft zwar unter Lazarus aber es werden Texturen nicht kopiert (label.caption, edit.txt usw...) .
Daher nun mal meine Frage: Was wird mit dieser Prozedur warum kopiert, und was wird weshalb nicht kopiert ?

Code: Alles auswählen

procedure TForm1.CloneProperties(const Source: TControl; const Dest: TControl);
var
  ms: TMemoryStream;
  OldName: string;
begin
  OldName := Source.Name;
  Source.Name := ''; // needed to avoid Name collision
  try
    ms := TMemoryStream.Create;
    try
      ms.WriteComponent(Source);
      ms.Position := 0;
      ms.ReadComponent(Dest);
    finally
      ms.Free;
    end;
  finally
    Source.Name := OldName;
  end;
end;

P.S.: FindProperty wär mal nich schlecht...

[_X_]

Ich würde sagen wegen den TypeCasts; wenn TControl die Eigenschaft xyz nicht hat, aber die davon abgeleitete Komponente schon; dann wird sie nicht mit kopiert, da TControl diese Eigenschaft nicht hat.

mfg _X_

[u-boot]

klingt einleuchtend aber bei folgendem Aufruf wird das Label.Caption leider auch nicht übertragen:

Code: Alles auswählen

procedure TForm1.CloneProperties(const Source: TControl; const Dest: TControl);// http://stackoverflow.com" onclick="window.open(this.href);return false;
var
  ms: TMemoryStream;
  OldName: string;
begin
  OldName := Source.Name;
  Source.Name := ''; // needed to avoid Name collision
  try
    ms := TMemoryStream.Create;
    try
      if not(Source is TLabel) then begin
        ms.WriteComponent(Source);
        ms.Position := 0;
        ms.ReadComponent(Dest);
      end else begin
        ms.WriteComponent(TLabel(Source));
        ms.Position := 0;
        ms.ReadComponent(TLabel(Dest));
      end;
    finally
      ms.Free;
    end;
  finally
    Source.Name := OldName;
  end;
end;

[pluto]

Warum nicht einfach so:

Code: Alles auswählen

procedure CloneObject(const aObject:TComponent; aOwner:TWinControl);
var
  aNewCompo:TComponent;
begin
  aNewCompo:=TComponent.Create(aOwner);
  aNewCompo.Assigen(aObject);
end;

Assigen kopiert alle Eigenschaften einer Komponente. So bzw. so ähnlich sollte es Funktionieren.

[Socke]

Assigen kopiert alle Eigenschaften einer Komponente. So bzw. so ähnlich sollte es Funktionieren.

Das hab ich auch schon gedacht. In der Praxis kommt eine Exception (sinngemäß: "can't assign TLabel to TLabel"). In den Quellen sieht man dann, dass AssignTo (diese Funktion soll das am Ende machen), nur für TPersistent sinnvoll arbeitet. Alles was davon abgeleitet ist, muss selbst programmiert werden.

Ein anderer Ansatz, der mir spontan einfällt, wäre das einfache Kopieren des Speichers (das ersetzt aber wohl kaum die ganzen Referenzen zu anderen Objekten, aber so könnte man auch zwei TListBox mit der selben Liste ermöglichen).

[u-boot]

Mit dem Speicher kopieren ... ich hätte gedacht mit dem beschriebenen Konstrukt wird da sowas gemacht.

Falls dem nicht so ist ... hat vielleicht jemand ne Anleitung dafür ? Evtl fehlt mir etwas wissen über Komponenten und Speicher weil das sonst meist übernommen wird.

Ich habe auch immer die Sorge Speicherleichen zu produzieren bzw. mit Zeigeroperationen Komponenten oder Teile davonzu löschen, die dann noch einer anderen Komponente gehören.

[Socke]

Ich meinte nicht Speichern und Kopieren sondern den Speicher zu kopieren. Das hat mit dem, was du tust, relativ wenig zu tun, da du die Komponente streamst (wovon ich überhaupt keine Ahnung habe).

In Code ginge das in etwa so:

Code: Alles auswählen

var
  oldlabel: TLabel;
  newlabel: TLabel;
begin
  newlabel := New(TLabel);
  Move(Pointer(oldlabel)^,Pointer(newlabel)^,TLabel.InstanceSize);
end;

Dabei hast du nur ein paar Probleme:

• Der "Owner" weiß nichts von dem neuen Label (siehe TComponent.Notifcation, TComponent.FreeNotification) und kann es deshalb nicht automatisch freigeben.
• Parent ist zwar gesetzt, aber der "Parent" weiß ebenfalls nichts vom neuen Label und zeigt es nicht an; kann evtl. durch einfaches neu setzen korrigiert werden.
• Das neue Label hat den selben Inhalt wie das alte. Bei Labels ist das noch relativ harmlos, sobald andere Objekte (Listen, Bäume) dazu kommen, wird interessant. Beide wollen die gleichen Objekte freigeben (AccessViolation ist unumgänglich)

[Hitman]

Das neue Label hat den selben Inhalt wie das alte. Bei Labels ist das noch relativ harmlos, sobald andere Objekte (Listen, Bäume) dazu kommen, wird interessant. Beide wollen die gleichen Objekte freigeben (AccessViolation ist unumgänglich)

Du hast Strings vergessen, die bei Labels sehr wohl eine Rolle spielen. Du würdest mit so einer Kopie deren Referenzzähler durcheinander bringen und damit früher oder später eine Access Violation oder andere Effekte von defektem Speicherinhalt provozieren.

[mse]

TPersistent.Assign() ruft Source.AssignTo() auf:

Code: Alles auswählen

procedure TPersistent.Assign(Source: TPersistent);
 
begin
  If Source<>Nil then
    Source.AssignTo(Self)
  else
    AssignError(Nil);
end;

welches eine exception wirft:

Code: Alles auswählen

procedure TPersistent.AssignError(Source: TPersistent);
 
Var SourceName : String;
 
begin
  If Source<>Nil then
    SourceName:=Source.ClassName
  else
    SourceName:='Nil';
  raise EConvertError.CreateFmt (SAssignError,[SourceName,ClassName]);
end;
 
procedure TPersistent.AssignTo(Dest: TPersistent);
 
 
begin
  Dest.AssignError(Self);
end;

Assign() funktioniert also nur dann, wenn in der entsprechenden Klasse überschrieben oder wenn Source.AssignTo() die Zuweisung zur Zielklasse unterstützt. In Assign() werden in der Regel nur ausgewählte Eigenschaften und Variablen kopiert.
Die Methode mit WriteComponent/ReadComponent() kopiert alle published properties. Das Code-Beispiel von u-boot sollte meiner Meinung nach funktionieren.

Martin

[u-boot]

Die Methode mit WriteComponent/ReadComponent() kopiert alle published properties. Das Code-Beispiel von u-boot sollte meiner Meinung nach funktionieren.

Ein TShape mit dieser Methode kopiert sieht auch ganz ordentlich aus, aber wie schon berichtet TLabel.Caption und TEdit.Text funktionieren nicht obwohl das published properties sind.

[pluto]

Vielleicht sind diese Eigenschaften nicht Registriert. Meines Wissens muss eine Eigenschaft Registriert werden um bei Assigen zu Funktionieren. Währe das hier der Fall ?

[mse]

Ein TShape mit dieser Methode kopiert sieht auch ganz ordentlich aus, aber wie schon berichtet TLabel.Caption und TEdit.Text funktionieren nicht obwohl das published properties sind.

Eine mögliche Erklärung für TEdit ist, dass dort der Text vermutlich im widgetset gespeichert ist und die Übertragung nicht klappt. Dies ist eine reine Vermutung, da müsste ein Lazarus Spezialist Auskunft geben. Du kannst den binären stream Inhalt mit ObjectBinaryToText() in eine Textdatei wandeln um zu prüfen, ob das Problem beim Speichern oder beim Lesen liegt.
Ich bin ziemlich sicher, dass auch Lazarus eine solche Kopierroutine besitzt. MSEgui hat ebenfalls ein entsprechende Funktion (copycomponent() in mseclasses.pas) welche twriter.writerootcomponent()/treader.readrootcomponent() benutzt, unter anderem damit TComponent.Loaded() aufgerufen wird. Du kannst ja mal als Versuch Loading()/Loaded() aufrufen.

Code: Alles auswählen

type
 tcomponent1 = class(tcomponent); // um auf protected elemente zugreifen zu koennen
[...]
 tcomponent1(dest).loading;
[...]
//stream schreiben/lesen
[...]
 tcomponent1(dest).loaded;