Приведенный ниже код содержит функцию DuplicateComponents, позволяющую проводить клонирование любых компонентов и их потомков во время выполнения приложения. Действия ее напоминают операцию копирования/вставки (copy/paste) во время разработки приложения. Новые компоненты при создании получают тех же родителей, владельцев (в случае применения контейнеров) и имена (естественно, несколько отличающихся), что и оригиналы. В данной функции есть вероятность багов, но я пока их не обнаружил. Ошибки и недочеты могут возникнуть из-за редко применяемых специфических методов, которые, вместе с тем, могут помочь программистам, столкнувшимися с аналогичными проблемами. Данная функция может оказаться весьма полезной в случае наличия нескольких одинаковых областей на форме с необходимостью синхронизации изменений в течение некоторого промежутка времени. Процедура создания дубликата проста до безобразия: разместите на TPanel или на другом родительском компоненте необходимые элементы управления и сделайте: "newpanel := DuplicateComponents(designedpanel)".
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls, IniFiles, TypInfo, Debug;
type
TUniqueReader = class(TReader)
LastRead: TComponent;
procedure ComponentRead(Component: TComponent);
procedure SetNameUnique(
Reader: TReader;
Component: TComponent;
var Name: string
);
end;
implementation
procedure TUniqueReader.ComponentRead(Component: TComponent);
begin
LastRead := Component;
end;
// Задаем уникальное имя считываемому компоненту, например,
// "Panel2", если "Panel1" уже существует
procedure TUniqueReader.SetNameUnique(
Reader: TReader;
Component: TComponent; // Считываемый компонент
var Name: string // Имя компонента для дальнейшей модификации
);
var
i: Integer;
tempname: string;
begin
i := 0;
tempname := Name;
while Component.Owner.FindComponent(Name) <> nil do
begin
Inc(i);
Name := Format('%s%d', [tempname, i]);
end;
end;
function DuplicateComponents(
AComponent: TComponent // исходный компонент
): TComponent; // возвращаемся к созданию нового компонента
procedure RegisterComponentClasses(
AComponent: TComponent
);
var
i: integer;
begin
RegisterClass(TPersistentClass(AComponent.ClassType));
if AComponent is TWinControl then
if TWinControl(AComponent).ControlCount > 0 then
for i := 0 to
(TWinControl(AComponent).ControlCount - 1) do
RegisterComponentClasses(TWinControl(AComponent).Controls[i]);
end;
var
Stream: TMemoryStream;
UniqueReader: TUniqueReader;
Writer: TWriter;
begin
result := nil;
UniqueReader := nil;
Writer := nil;
try
Stream := TMemoryStream.Create;
RegisterComponentClasses(AComponent);
try
Writer := TWriter.Create(Stream, 4096);
Writer.Root := AComponent.Owner;
Writer.WriteSignature;
Writer.WriteComponent(AComponent);
Writer.WriteListEnd;
finally
Writer.Free;
end;
Stream.Position := 0;
try
// создаем поток, перемещающий данные о компоненте в конструктор
UniqueReader := TUniqueReader.Create(Stream, 4096);
UniqueReader.OnSetName := UniqueReader.SetNameUnique;
UniqueReader.LastRead := nil;
if AComponent is TWinControl then
UniqueReader.ReadComponents(
// считываем компоненты и суб-компоненты
TWinControl(AComponent).Owner,
TWinControl(AComponent).Parent,
UniqueReader.ComponentRead
)
else
UniqueReader.ReadC omponents(
// читаем компоненты
AComponent.Owner,
nil,
UniqueReader.ComponentRead
);
result := UniqueReader.LastRead;
finally
UniqueReader.Free;
end;
finally
Stream.Free;
end;
end;
