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

[یوسف زالی]

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

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 هارو ران تایم بسازید.

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

[یوسف زالی]

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