نحوه کلون کردن یک شی با تمام زیرمجموعه ها

[یوسف زالی]

سلام.
در نظر بگیرید که یک پنل دارید، توش چند تا عنصر گذاشتید که برای هر کدوم هم رویداد هایی نوشتید. حالا دقیقا همین کار رو می خواهید روی یک فرم دیگه چندین بار تکرار کنید، کدی که می گذارم می تونه این کار رو براتون بی دردسر انجام بده و رویداد هاش رو هم انتصاب بده.


uses TypInfo, Unit2;


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
{ 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; // case
end // if


finally
FreeMem(PropInfos, Count * SizeOf(PPropInfo));
end;
end;


procedure CopyTemplate(Template, HostControl: TWinControl);
var
BaseName: string;


function GetOwner(Cmp: TComponent): TComponent;
begin
Result := Cmp;
while Assigned(Result.Owner) and not (Result is TCustomForm) do
Result := Result.Owner;
end;


procedure InnerCopy(Template, HostControl: TWinControl);
var
i: integer;
Cmp, New: TControl;
CLS: TControlClass;
Own: TComponent;
begin
for i := 0 to Template.ControlCount -1 do
begin
Cmp := Template.Controls[i];
CLS := TControlClass(Cmp.ClassType);
Own := GetOwner(HostControl);
New := CLS.Create(Own);
New.Name := BaseName + '_' + Cmp.Name;
New.Parent := HostControl;
CopyObject(Cmp, New);


if Cmp is TWinControl then
InnerCopy(TWinControl(Cmp), TWinControl(New));


end;
end;


begin
if Template = HostControl then
Exit;


BaseName := HostControl.Name;
InnerCopy(Template, HostControl);
end;




نمونه استفاده:


CopyTemplate(form2.Panel1, GroupBox2);


نکته جالب این کد اینه که اگر روی دکمه ها رویداد هایی بنویسید، در اشیای جدید هم رویداد ها رو خواهید داشت. فقط باید حواستون باشه که به جای استفاده از نام مستقیم اشیا باید از نام Sender استفاده کنید.
مثلا تو OnClick دکمه بنویسید:


ShowMessage(TButton(Sender).Name);


بهترین مورد مصرفش ساخت کامپوننت "واره" هاست، در حقیقت این کد Template هارو ران تایم بسازید.

امیدوارم به کارتون بیاد.
:چشمک:

[یوسف زالی]

اینم مثالش، البته می شه بهتر نوشتش: