Показать сообщение отдельно
  #3  
Старый 10.02.2017, 20:25
Аватар для dr. F.I.N.
dr. F.I.N. dr. F.I.N. вне форума
I Like it!
 
Регистрация: 12.12.2009
Адрес: Россия, г. Новосибирск
Сообщения: 660
Версия Delphi: D6/D7
Репутация: 26643
По умолчанию

В моем примере контролы одной панели полностью копируются на вторую панель.
Код:
uses
  TypInfo;

procedure CopyObject(ObjFrom, ObjTo: TObject);
var
  PropInfos: PPropList;
  PropInfo: PPropInfo;
  Count, Loop: Integer;
  OrdVal: Longint;
  StrVal: String;
  FloatVal: Extended;
  MethodVal: TMethod;
begin
  Count := GetPropList(ObjFrom.ClassInfo, tkAny, nil);
  GetMem(PropInfos, Count * SizeOf(PPropInfo));
  try
    GetPropList(ObjFrom.ClassInfo, tkAny, PropInfos);
    for Loop := 0 to Count - 1 do
    begin
      PropInfo := GetPropInfo(ObjTo.ClassInfo, PropInfos^[Loop]^.Name);
      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
          { 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;

procedure TForm1.Button1Click(Sender: TObject);
var
  Original, Clone: TControl;
  OriginalClass: TClass;
  i: integer;
begin
  for i := 0 to Panel1.ControlCount - 1 do
  begin
    Original := Panel1.Controls[i];
    OriginalClass := Original.ClassType;
    Clone := TControlClass(OriginalClass).Create(Original.Owner);
    Clone.Parent := Panel2;
    CopyObject(Original, Clone);
  end;
end;

Для изучения: RTTI
__________________
Грамотно поставленный вопрос содержит не менее 50% ответа.
Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть.
Ответить с цитированием