{"id":204678,"date":"2013-12-03T16:18:02","date_gmt":"2013-12-03T12:18:02","guid":{"rendered":"http:\/\/savepearlharbor.com\/?p=204678"},"modified":"-0001-11-30T00:00:00","modified_gmt":"-0001-11-29T21:00:00","slug":"","status":"publish","type":"post","link":"https:\/\/savepearlharbor.com\/?p=204678","title":{"rendered":"\u041a\u043b\u043e\u043d\u0438\u0440\u043e\u0432\u0430\u043d\u0438\u0435 \u043a\u043e\u043c\u043f\u043e\u043d\u0435\u043d\u0442\u043e\u0432 VCL<\/span>"},"content":{"rendered":"
\tEmbarcadero \u0432 FMX \u0437\u0430\u0431\u043e\u0442\u043b\u0438\u0432\u043e \u043f\u0440\u0435\u0434\u0443\u0441\u043c\u043e\u0442\u0440\u0435\u043b\u043e \u043a\u043b\u043e\u043d\u0438\u0440\u043e\u0432\u0430\u043d\u0438\u0435, \u043a\u043e\u0442\u043e\u0440\u0435 \u0438\u043d\u043e\u0433\u0434\u0430 \u043c\u043e\u0436\u0435\u0442 \u043f\u0440\u0438\u044f\u0442\u043d\u043e \u0443\u043f\u0440\u043e\u0441\u0442\u0438\u0442\u044c \u0436\u0438\u0437\u043d\u044c \u0440\u0430\u0437\u0440\u0430\u0431\u043e\u0442\u0447\u0438\u043a\u0430. VCL \u0436\u0435 \u044f\u0432\u043d\u043e\u0433\u043e \u0438\u043d\u0441\u0442\u0440\u0443\u043c\u0435\u043d\u0442\u0430 \u043a\u043b\u043e\u043d\u0438\u0440\u043e\u0432\u0430\u043d\u0438\u044f \u0432 run-time \u043d\u0435 \u043f\u0440\u0435\u0434\u043e\u0441\u0442\u0430\u0432\u043b\u044f\u0435\u0442.
<\/a>
\u0414\u043b\u044f \u0447\u0435\u0433\u043e \u044d\u0442\u043e \u043c\u043e\u0436\u0435\u0442 \u0431\u044b\u0442\u044c \u0438\u0441\u043f\u043e\u043b\u044c\u0437\u043e\u0432\u0430\u043d\u043d\u043e? \u041a\u043e\u043d\u0435\u0447\u043d\u043e \u0436\u0435 \u0434\u043b\u044f \u043a\u043b\u043e\u043d\u0438\u0440\u043e\u0432\u0430\u043d\u0438\u044f \u0432\u0438\u0437\u0443\u0430\u043b\u044c\u043d\u044b\u0445 \u043a\u043e\u043c\u043f\u043e\u043d\u0435\u043d\u0442\u043e\u0432 \u043f\u043e \u0448\u0430\u0431\u043b\u043e\u043d\u0443. \u041f\u0440\u0438\u0435\u043c\u0443\u0449\u0435\u0441\u0442\u0432\u0430 \u0438 \u043d\u0435\u0434\u043e\u0441\u0442\u0430\u0442\u043a\u0438 \u0434\u0430\u043d\u043d\u043e\u0433\u043e \u043f\u043e\u0434\u0445\u043e\u0434\u0430 \u044f \u043f\u0440\u0435\u0434\u043f\u043e\u0447\u0442\u0443 \u043e\u0441\u0442\u0430\u0432\u0438\u0442\u044c \u0434\u043b\u044f \u0433\u0443\u0440\u0443.<\/p>\n

\u0414\u0430\u043b\u0435\u0435 \u044f \u043f\u0440\u043e\u0441\u0442\u043e \u043f\u0440\u0438\u0432\u0435\u0434\u0443 \u043a\u043e\u0434 \u0438 \u0441\u0432\u043e\u0438 \u043a\u043e\u043c\u043c\u0435\u043d\u0442\u0430\u0440\u0438\u0438:<\/p>\n

unit Clonable;  interface  uses   System.SysUtils, System.Classes, System.TypInfo, Vcl.Controls, StrUtils;  { extending } type   TClonable = class(TComponent)   private     procedure CopyComponentProp(Source, Target: TObject; aExcept: array of string);   public     function Clone(const AOwner: TComponent; aExcept: array of string): TComponent;   end;   implementation   procedure TClonable.CopyComponentProp(Source, Target: TObject; aExcept: array of string); var   I, Index: Integer;   PropName: string;   Source_PropList  , Target_PropList  : PPropList;   Source_NumProps  , Target_NumProps  : Word;   Source_PropObject, Target_PropObject: TObject;   { property list finder }   function FindProperty(const PropName: string; PropList: PPropList; NumProps: Word): Integer;   var     I: Integer;   begin     Result:= -1;     for I:= 0 to NumProps - 1 do       if CompareStr(PropList^[I]^.Name, PropName) = 0 then begin         Result:= I;         Break;       end;   end; begin   if not Assigned(Source) or not Assigned(Target) then Exit;   Source_NumProps:= GetTypeData(Source.ClassInfo)^.PropCount;   Target_NumProps:= GetTypeData(Target.ClassInfo)^.PropCount;   GetMem(Source_PropList, Source_NumProps * SizeOf(Pointer));   GetMem(Target_PropList, Target_NumProps * SizeOf(Pointer));   try     { property list }     GetPropInfos(Source.ClassInfo, Source_PropList);     GetPropInfos(Target.ClassInfo, Target_PropList);     for I:= 0 to Source_NumProps - 1 do begin       PropName:= Source_PropList^[I]^.Name;       if  (AnsiIndexText('None'  , aExcept                ) =  -1) and          ((AnsiIndexText(PropName, ['Name', 'Left', 'Top']) <> -1) or           (AnsiIndexText(PropName, aExcept                ) <> -1)) then Continue;       Index:= FindProperty(PropName, Target_PropList, Target_NumProps);       if Index = -1 then Continue; {no property found}       { compare types }       if Source_PropList^[I]^.PropType^.Kind <> Target_PropList^[Index]^.PropType^.Kind then         Continue;       case Source_PropList^[I]^.PropType^^.Kind of         tkClass:  begin                     Source_PropObject:= GetObjectProp(Source, Source_PropList^[I    ]);                     Target_PropObject:= GetObjectProp(Target, Target_PropList^[Index]);                     CopyComponentProp(Source_PropObject, Target_PropObject, ['None']);                   end;         tkMethod: SetMethodProp(Target, PropName, GetMethodProp(Source, PropName));       else SetPropValue(Target, PropName, GetPropValue(Source, PropName));       end;     end;   finally     FreeMem(Source_PropList);     FreeMem(Target_PropList);   end; end;   function IsUniqueGlobalNameProc(const Name: string): Boolean; begin   if Length(Name) = 0 then     Result := True   else     Result := Not Assigned(FindGlobalComponent(Name)); end;   function TClonable.Clone(const AOwner: TComponent; aExcept: array of string): TComponent; var   S: TStream;   SaveName: string;   Reader: TReader;   FSaveIsUniqueGlobalComponentName: TIsUniqueGlobalComponentName;   I: Integer;   Child: TComponent;   LComponent: TComponent; begin   { for simple compatible }   LComponent:=Self;   { register self type }   RegisterClass(TPersistentClass(LComponent.ClassType));   S := TMemoryStream.Create;   Result := nil;   try     { store }     SaveName := LComponent.Name;     Self.Name := '';     S.WriteComponent(LComponent);     LComponent.Name := SaveName;     S.Position := 0;     { load }     FSaveIsUniqueGlobalComponentName := IsUniqueGlobalComponentNameProc;     IsUniqueGlobalComponentNameProc := IsUniqueGlobalNameProc;     try       Reader := TReader.Create(S, 4096);       try         Result := TComponent(Reader.ReadRootComponent(nil));         if Assigned(AOwner) then           AOwner.InsertComponent(Result);       finally         Reader.Free;         if not Assigned(Result) then           Result := TComponentClass(LComponent.ClassType).Create(AOwner);       end;     finally       IsUniqueGlobalComponentNameProc := FSaveIsUniqueGlobalComponentName;     end;   finally     S.Free;   end;   {parent}   if (LComponent is TControl) and (LComponent as TControl).HasParent then     (Result as TControl).Parent:=(LComponent as TControl).Parent;   { copy propertys value }   CopyComponentProp(LComponent, Result, aExcept);   { childs }   if (LComponent is TWinControl) and ((LComponent as TWinControl).ControlCount > 0) then     for I := 0 to (LComponent as TWinControl).ControlCount - 1 do begin       Child:=       TClonable(         (LComponent as TWinControl).           Controls[I]).           Clone(LComponent, aExcept);       if (Child is TControl) then         (Child as TControl).Parent:=(Result as TWinControl);     end; end;  end. <\/code><\/pre>\n
  \u041f\u0440\u0438\u043c\u0435\u0440 \u0438\u0441\u043f\u043e\u043b\u044c\u0437\u043e\u0432\u0430\u043d\u0438\u044f:  <\/p>\n
procedure TForm1.Button1Click(Sender: TObject); var   Clone: TPanel; begin   Clone:=TPanel(TClonable(Panel1).Clone(Self, []));   Clone.Top:=Panel1.Top+Panel1.Height; end; <\/code><\/pre>\n
  \u041e\u043f\u0438\u0441\u0430\u043d\u0438\u0435 \u043c\u0435\u0442\u043e\u0434\u0430 Clone \u043a\u043b\u0430\u0441\u0441\u0430 TClonable:
   function<\/b> Clone<\/b>(const AOwner: TComponent; aExcept: array of string): TComponent;  <\/p>\n