[__Fantom_]

Работаю в delphi xe 7.У меня на форме при загрузке есть image1 мне надо, чтобы он создал копию моей картинки и начал двигать эту копию.
Пробовала сделать это с помощью функции Clone. Но что-то не получилось.
Помогите с написанием, пожалуйста

[Alegun]

Для начала сохраните это как 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;

[lmikle]

Что значит "сделал копию"?

Код:

var
  NewImage : TImage;
begin
  NewImage := TImage.Create(Self);
  NewImage.Asign(Image1);

[Alegun]

Сообщение от lmikle

Код:

...
  NewImage.Asign(Image1);
...

Да не, так нельзя вроде, ошибка будет на присвоение имиджа имиджу

[M.A.D.M.A.N.]

Сообщение от Alegun

Да не, так нельзя вроде, ошибка будет на присвоение имиджа имиджу

Проверь.
По моему дак не будет.

[Alegun]

Всё же есть, вот

[Aristarh Dark]

Сообщение от Alegun

Всё же есть, вот

Нужно до Bitmap'а спустится, и там будет.

[icWasya]

До BitMap - не обязательно, достаточно до Picture

Код:

var
  NewImage : TImage;
begin
  NewImage := TImage.Create(Self);

  NewImage.BoundsRect:= Image1.BoundsRect; //присвоим размеры
  NewImage.Parent := Image1.Parent; // что бы где-нибудь нарисовалось
  NewImage.Picture.Asign(Image1.Picture);// скопируем картинку;
(*
  Ну и до кучи - Proportional, Stretch, Transparent, Autosize, Center
*)