运行时复制组件

Question

运行时复制组件

delphirtti

13

有没有一种简单的方法可以复制父组件下的所有子组件，包括它们的已发布属性?

例如:

TPanel
- TLabel
- TEdit
- TListView
- TSpecialClassX

当然最重要的因素是，在正常情况下它应该复制我放在TPanel上的任何新组件而不修改代码。

我听说过RTTI，但实际上从未使用过。有什么想法吗？

- Atlas

4个回答

6

请阅读这个页面

Delphi中的运行时类型信息 - 它对你有什么用处？

注意从一个组件复制属性到另一个组件一节

其中有一个单元RTTIUnit，其中包含一个过程，似乎可以完成部分你想要的功能，但我认为它不会复制任何子组件，需要额外的代码。（我认为在这里粘贴它是可以的...）

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;

- DarkAxi0m

5

你可以将源组件写入流中，然后将其读回目标组件。

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

你可能会遇到重复组件名称的问题。

- Uwe Raabe

2

@ Uwe，你说得对，如果源和目标共享相同的父级，则重复的组件名称将是一个问题。一种解决方案是在将其写入流之前将源组件名称暂时设置为空字符串。在读取目标组件后，如果要保留目标组件，则必须为其找到一个适当的名称，因为Delphi不会流式传输具有空名称属性的组件。 - iamjoosy

0

在运行时复制现有组件实际上相当容易。困难的部分是将所有已发布的属性复制到新的（复制的）对象。

很抱歉，我的代码示例是在C++Builder中。VCL是相同的，只是不同的语言。将其翻译为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
        }

也许有人有更好的方法将旧控件的所有发布属性复制到新控件。

- Kluge

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- François · Accepted Answer

您可以使用答案中的CLoneProperties例程，在通过父控件的循环创建副本组件后，将其用于“运行时替换可视化组件”。 更新：一些可行的代码...

我假设您想要复制包含在WinControl中的控件（因为Parent是TWinControl）。我不知道您是否还想将重复的控件与原始控件连接到相同的事件处理程序中，因此我提供了一个选项。您可能还想为复制的控件命名。

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;