VCL घटक क्लोनिंग

FMX में Embarcadero सावधानीपूर्वक क्लोनिंग के लिए प्रदान किया गया है, जो कभी-कभी डेवलपर के जीवन को सुखद बना सकता है। VCL रन-टाइम में एक स्पष्ट क्लोनिंग टूल प्रदान नहीं करता है।


इसका क्या उपयोग किया जा सकता है? बेशक, एक पैटर्न में दृश्य घटकों को क्लोन करने के लिए। इस दृष्टिकोण के फायदे और नुकसान, मैं गुरु के लिए छोड़ना पसंद करता हूं।

अगला, मैं सिर्फ कोड और अपनी टिप्पणी दूंगा:

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 वर्ग के क्लोन विधि का विवरण:
फ़ंक्शन क्लोन (const AOwner: TComponent; aExcept: string of string): TComponent;

• AOwner : TComponent - क्लोन किए गए घटक का नया मालिक
• एक्सेप्ट: स्ट्रिंग की एक सरणी - कॉपी करते समय बाहर करने के लिए गुणों के अर्थ (PPropList) के नाम वाले तार की एक सरणी
• परिणाम - मूल वस्तु की प्रतिलिपि का प्रतिनिधित्व करने वाले TComponent वर्ग की एक नई वस्तु का एक लिंक, नाम गुण रिक्त है

मेरी राय में, कार्यान्वयन घटकों को कॉपी करने के लिए एक सुविधाजनक तरीका प्रदान करता है: बच्चे की वस्तुओं की नकल करने के लिए प्रदान किए गए तंत्र के साथ जो ट्विनकंट्रोल वंशज हो सकते हैं; घटनाओं का पुनर्मूल्यांकन; अनावश्यक गुणों को खत्म करने की क्षमता।

किसी भी मामले में मैं एक नवाचार होने का नाटक नहीं करता, मेरा मतलब है कि एक साइकिल है, मुझे उम्मीद है कि यह एक बैसाखी नहीं है))