何に使用できますか？ もちろん、パターン内のビジュアルコンポーネントのクローンを作成する場合。 このアプローチの長所と短所は、教祖に任せたいと思います。
次に、コードとコメントを提供します。
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.
使用例：
procedure TForm1.Button1Click(Sender: TObject); var Clone: TPanel; begin Clone:=TPanel(TClonable(Panel1).Clone(Self, [])); Clone.Top:=Panel1.Top+Panel1.Height; end;
TClonableクラスのCloneメソッドの説明：
function Clone （const AOwner：TComponent; aExcept：文字列の配列）：TComponent;
- AOwner ： TComponent-複製されたコンポーネントの新しい所有者
- aExcept： 文字列の配列-コピー時に除外するプロパティ名（PPropList）を含む文字列の配列
- 結果 -元のオブジェクトのコピーを表すTComponentクラスの新しいオブジェクトへのリンク。Nameプロパティは空です
私の意見では、実装はコンポーネントをコピーする便利な方法を提供します。TWinControlの子孫に含まれる子オブジェクトをコピーするためのメカニズムが提供されます。 イベントの再割り当て。 不要なプロパティを削除する機能。
決してイノベーションのふりをするつもりはありません。自転車を意味します。松葉杖ではないことを願っています=）