
14.02.2015, 21:04
|
 |
LMD-DML
|
|
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
|
|
Для начала сохраните это как Clonable.pas
Код:
//http://habrahabr.ru/post/204678/
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.
вам ещё потребуется добавить на форму баттон и таймер (имидж с рисунком уже есть) и затем делайте примерно так
Код:
...
uses
Clonable;
...
var
img: TImage;
procedure TForm1.Button1Click(Sender: TObject);
begin
Img:=TImage(TClonable(Image1).Clone(Self, []));
Timer1.Enabled:= true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Img.Left:= Img.Left+1;
end;
|