Komponente zur Laufzeit clonen

[petwey]

Hallo Forum,

erstmal ich habe bereits nach dem Thema gesucht, aber der Suchbegriff clone fördert zu viele Ergebnisse.

Ich möchte zur Laufzeit eine Komponente auf Grundlage einer anderen Komponente erzeugen. Also ich habe eine "unsichtbare" Komponete in der ich zur Designzeit alles was ich so möchte einstelle. Ein Beispiel dafür wäre ein SynEdit mit zugehörigem Highlighter. Danach erzeuge ich zur Laufzeit eine neue Instanz dieser Komponente und übertrage alle Eigenschaften der Vorlage auf die Neue (Ausgenommen natürlich der Name).

Ich stelle mir dazu den folgenden Funktionsrumpf vor:

Code: Alles auswählen

procedure CloneComponent(ASrc, ATrgt : TComponent; AParent : TComponent);

Hat das schon mal jemand gemacht? Wie sieht es mit Zeigern aus, Routinen, etc. Worauf müsste man achten.

Ich habe bereits folgendes gefunden:
https://www.freepascal.org/~michael/art ... /rtti1.pdf

und die Funktion von Seite 8 angepasst um mir die Eigenschaften eines Buttons anzeigen zu lassen:

Code: Alles auswählen

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons;

type

  { TForm1 }

  TForm1 = class(TForm)
    ToClone: TButton;
    Button1: TButton;
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

uses
  TypInfo;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
Var
PL : PPropList;
Inf : TPropInfo;
I,N : Integer;
begin
//  N:=TypInfo.GetPropList(C,P);
  N:=TypInfo.GetPropList(ToClone,PL);
  try
    for i := 0 to N - 1 do
    begin
      Inf := (PL^)[i]^;
      Memo1.Lines.Add(Inf.Name);
    end;
  finally
    FreeMem(PL);
  end;
end;

end.

Während des Schreibens ist mir eingefallen, dass ich zur Not ein Frame erstellen könnte und damit auch zum Ziel kommen würde, aber das Thema reizt micht.
Darum frage ich hier mal in die Runde.

[theo]

Naja, bin nicht ganz sicher, ob ich das so machen würde, aber wichtig ist bestimmt einmal:
Ist dir TPersistent.Assign ein Begriff?
https://www.freepascal.org/docs-html/rt ... ssign.html

Damit kannst du z.B. alle Eigenschaften des Highlighters oder der Lines etc. kopieren.
Ein Synedit.Assign() funktioniert aber nicht direkt.

Es kommen bestimmt noch mehr Vorschläge.

[KodeZwerg]

Wenn es generisch sein soll, muss Dir bewusst sein das ein TObject, TControl oder TWinControl auch dutzende von Childs enthalten kann, damit wäre Dein jetziger Ansatz hinfällig.
Für Delphi habe ich auf stackoverflow eine kompetente Lösung gefunden, ob es 1:1 in Lazarus funktioniert kannst Du uns ja mitteilen

[petwey]

Hallo Zusammen,

erst mal Danke für eure antworten ich werde mir das mal ansehen.

In der Zwischenzeit hab ich ein bißchen rumgespielt und es klappt tatsächlich, wobei ich glaube nicht, dass ich bereits alle Eventualitäten berücksichtigt habe.

Hier mal mein Code und im Anhang das Projekt:

Code: Alles auswählen

uses
  RTTI;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
Var
  aBtn : TButton;
begin
  aBtn := TButton.Create(GroupBox1);
  aBtn.Name := 'Test';
  aBtn.Parent := GroupBox1;
  CloneComponent(Toclone, aBtn);
end;

procedure TForm1.CloneComponent(ASrc, ATrgt : TComponent);
Var
  Ctx : TRTTIContext;
  PSrc, PTrgt : TRttiProperty;
  i : Integer;
begin
  Ctx:=TRTTIContext.Create;
  try
    // Absicherung ob ASrc und ATrgt vom gleichen Typ (hier TButton) sind fehlt noch.
    For i := 0 to high(Ctx.GetType(ASrc.ClassInfo).GetProperties) do
    begin
      PSrc := Ctx.GetType(ASrc.ClassInfo).GetProperties[i];
      PTrgt := Ctx.GetType(ASrc.ClassInfo).GetProperties[i];
      // Bei welchen Eigenschaften kann es noch zu Problemen kommen? 
      // Hab ich mit tkSet überreagiert und es ist nur Anchors, das sich nicht setzen lässt?
      // Für die Methoden gibt es vielleicht eine spezielle Routine zum übertragen?
      if (PSrc.IsWritable) and (PSrc.PropertyType.TypeKind <> tkMethod)  and (PSrc.PropertyType.TypeKind <> tkSet) then
      begin
        case PSrc.Name of
          'Name' : begin end; // , 'Anchors'
        else
          PTrgt.SetValue(ATrgt,PSrc.GetValue(ASrc));
        end;
      end;
    end;
    finally
      Ctx.free;
  end;
end;

end.

Kritik ist auf jeden Fall erwünscht.