Duplicating components at Run-Time

后端 未结 4 2013
鱼传尺愫
鱼传尺愫 2020-12-06 11:03

Is there a simple way to duplicate all child components under parent component, including their published properties?

For example:

  • TPanel
    • TLa
相关标签:
4条回答
  • 2020-12-06 11:13

    You can propably use the CLoneProperties routine from the answer to "Replace visual component at runtime", after you have created the dup components in a loop thru the parent's controls.

    Update: some working code....

    . I assume from your question that you want to duplicate the Controls that are contained in a WinControl (as a Parent is a TWinControl).
    . As I did not know if you also wanted to hook the duplicated controls with the same Event Handlers as the originals, I made an option for that.
    . And you may want to give a proper meaningful Name to the duplicated controls.

    uses
      TypInfo;
    
    procedure 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;
    
    procedure CloneEvents(Source, Dest: TControl);
    var
      I: Integer;
      PropList: TPropList;
    begin
      for I := 0 to GetPropList(Source.ClassInfo, [tkMethod], @PropList) - 1 do
        SetMethodProp(Dest, PropList[I], GetMethodProp(Source, PropList[I]));
    end;
    
    procedure DuplicateChildren(const ParentSource: TWinControl;
      const WithEvents: Boolean = True);
    var
      I: Integer;
      CurrentControl, ClonedControl: TControl;
    begin
      for I := ParentSource.ControlCount - 1 downto 0 do
      begin
        CurrentControl := ParentSource.Controls[I];
        ClonedControl := TControlClass(CurrentControl.ClassType).Create(CurrentControl.Owner);
        ClonedControl.Parent := ParentSource;
        CloneProperties(CurrentControl, ClonedControl);
        ClonedControl.Name := CurrentControl.Name + '_';
        if WithEvents then
          CloneEvents(CurrentControl, ClonedControl);
      end;
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
      DuplicateChildren(Panel1);
    end;
    
    0 讨论(0)
  • 2020-12-06 11:14

    It's actually fairly easy to duplicate existing components at runtime. The difficult part is to copy all of their published properties to the new (duplicated) objects.

    I'm sorry, but my code example is in C++Builder. The VCL is the same, just a different language. It shouldn't be too much trouble to translate it Delphi:

    for (i = 0; i < ComponentCount; ++i) {
        TControl *Comp = dynamic_cast<TControl *>(Components[i]);
        if (Comp) {
            if (Comp->ClassNameIs("TLabel")) {
                TLabel *OldLabel = dynamic_cast<TDBEdit *>(Components[i]);
                TLabel *NewLabel = new TLabel(this);  // new label
                // copy properties from old to new
                NewLabel->Top = OldLabel->Top;
                NewLabel->Left = OldLabel->Left;
                NewLabel->Caption = Oldlabel->Caption
                // and so on...
            } else if (Comp->ClassNameIs("TPanel")) {
                // copy a TPanel object
            }
    

    Maybe somebody has a better method of copying all of the published properties of the old control to the new one.

    0 讨论(0)
  • 2020-12-06 11:30

    You can write the source component into a stream and read it back into the target component.

    MemStream := TMemoryStream.Create;
    try
      MemStream.WriteComponent(Source);
      MemStream.Position := 0;
      MemStream.ReadComponent(Target);
    finally
      MemStream.Free;
    end;
    

    You may get problems with duplicate component names though.

    0 讨论(0)
  • 2020-12-06 11:31

    have a read of this page

    Run-Time Type Information In Delphi - Can It Do Anything For You?

    Noting the section Copying Properties From A Component To Another

    which has a unit, RTTIUnit with a Procedure, which seems to do part of what you want but i don't think it will copy any child components with out extra code. (i think its ok to paste it here...)

    procedure CopyObject(ObjFrom, ObjTo: TObject);    
      var
    PropInfos: PPropList;
    PropInfo: PPropInfo;
    Count, Loop: Integer;
    OrdVal: Longint;
    StrVal: String;
    FloatVal: Extended;  
    MethodVal: TMethod;
    begin
    //{ Iterate thru all published fields and properties of source }
    //{ copying them to target }
    
    //{ Find out how many properties we'll be considering }
    Count := GetPropList(ObjFrom.ClassInfo, tkAny, nil);
    //{ Allocate memory to hold their RTTI data }
    GetMem(PropInfos, Count * SizeOf(PPropInfo));
    try
    //{ Get hold of the property list in our new buffer }
    GetPropList(ObjFrom.ClassInfo, tkAny, PropInfos);
    //{ Loop through all the selected properties }
    for Loop := 0 to Count - 1 do
    begin
      PropInfo := GetPropInfo(ObjTo.ClassInfo, PropInfos^[Loop]^.Name);
     // { Check the general type of the property }
      //{ and read/write it in an appropriate way }
      case PropInfos^[Loop]^.PropType^.Kind of
        tkInteger, tkChar, tkEnumeration,
        tkSet, tkClass{$ifdef Win32}, tkWChar{$endif}:
        begin
          OrdVal := GetOrdProp(ObjFrom, PropInfos^[Loop]);
          if Assigned(PropInfo) then
            SetOrdProp(ObjTo, PropInfo, OrdVal);
        end;
        tkFloat:
        begin
          FloatVal := GetFloatProp(ObjFrom, PropInfos^[Loop]);
          if Assigned(PropInfo) then
            SetFloatProp(ObjTo, PropInfo, FloatVal);
        end;
        {$ifndef DelphiLessThan3}
        tkWString,
        {$endif}
        {$ifdef Win32}
        tkLString,
        {$endif}
        tkString:
        begin
          { Avoid copying 'Name' - components must have unique names }
          if UpperCase(PropInfos^[Loop]^.Name) = 'NAME' then
            Continue;
          StrVal := GetStrProp(ObjFrom, PropInfos^[Loop]);
          if Assigned(PropInfo) then
            SetStrProp(ObjTo, PropInfo, StrVal);
        end;
        tkMethod:
        begin
          MethodVal := GetMethodProp(ObjFrom, PropInfos^[Loop]);
          if Assigned(PropInfo) then
            SetMethodProp(ObjTo, PropInfo, MethodVal);
        end
      end
    end
    finally
      FreeMem(PropInfos, Count * SizeOf(PPropInfo));
    end;
    end;
    
    0 讨论(0)
提交回复
热议问题