/|\АРТЕМ.NET.RU /|\ - Портал для программистов и не только: Delphi Visual Basic BORLAND С++ PERL PHP HTML

Дублирование компонентов и их потомков во время выполнения приложения I

Приведенный ниже код содержит функцию 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;

procedure TUniqueReader.SetNameUnique( // Задаем уникальное имя считываемому компоненту, например, "Panel2", если "Panel1" уже существует

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.ReadComponents(
// читаем компоненты

AComponent.Owner,

nil,

UniqueReader.ComponentRead

);

result := UniqueReader.LastRead;

finally

UniqueReader.Free;

end;

finally

Stream.Free;

end;

[000058]