首页  编辑  

克隆控件和窗体

Tags: /超级猛料/VCL/Control.控件使用开发和第三方控件/控件使用技巧/   Date Created:

clone a Component?

{ This code shows how to clone a TPanel (Panel1)

 You can do it with any other component

}

procedure TForm1.Button1Click(Sender: TObject);

var

 ms: TMemoryStream;

 s: string;

 p, temp: TPanel;

 x,y: Integer;

begin

 ms := TMemoryStream.Create;

 try

   temp := panel1;

   s := panel1.Name;

   panel1.Name := '';

   try

     ms.WriteComponent(temp);

     ms.Position := 0;

     p := TPanel.Create(Self);

     ms.ReadComponent(p);

     with p do

     begin

       x := panel1.Left;

       y := panel1.Top;

       Inc(x, 5);

       Inc(y, 5);

       SetBounds(x, y, Width, Height);

       Parent := Self;

       Name := Format('Panel%d_%d', [x, y]);

     end;

   finally

     temp.Name := s;

     panel1 := temp;

   end

 finally

   ms.Free;

 end; { finally }

end;

***************************

clone a Form?

procedure TForm1.Button1Click(Sender: TObject);

var

 ms: TMemoryStream;

 newform: TForm1;

begin

 ms := TMemoryStream.Create;

 try

   ms.WriteComponent(Form1);

   newform := TForm1.CreateNew(Application);

   ms.Position := 0;

   ms.ReadComponent(newform);

   { show the new form. Note that it will appear exactly on top of the

    original! You may want to change its Left and Top property to move it

    a bit.

    Zeigt die neue Form. Die neue Form erscheint genau oberhalb der

    original form. Die Left, Top Properties müssen evtl. noch angepasst werden

   }

   newform.Show;

 finally

   ms.Free

 end;

end;

**********************************

也可以采取下面的方法:

uses

 TypInfo ;

{ Clone Object! Coder:Kingron }

function CloneProperty2 ( SourceComp , TargetComp : TObject ): Boolean ;

var

 i                 : Integer ;

 Properties         : PPropList ;

begin

 Result := True ;

  try

    for i := 0 to GetPropList ( SourceComp , Properties ) - 1 do

    begin

      if LowerCase ( Properties [ i ]. Name ) = 'name' then continue ;

      if not IsPublishedProp ( SourceComp , Properties [ I ]. Name ) then Continue ;

      if not IsPublishedProp ( TargetComp , Properties [ I ]. Name ) then Continue ;

      if PropType ( SourceComp , Properties [ I ]. Name ) <> PropType ( TargetComp , Properties [ I ]. Name )

        then

       Continue ;

      case PropType ( SourceComp , Properties [ i ]. Name ) of

       tkClass :

         SetObjectProp ( TargetComp , Properties [ i ],

           GetObjectProp ( SourceComp , Properties [ i ]));

       tkMethod :

         SetMethodProp ( TargetComp , Properties [ I ], GetMethodProp ( SourceComp ,

           Properties [ I ]));

      else

       SetPropValue ( TargetComp , Properties [ i ]. Name , GetPropValue ( SourceComp ,

         Properties [ i ]. Name ));

      end ;

    end ;

  except

   Result := False ;

  end ;

end ;