Como clonar eventos de um componente?

Delphi

21/10/2012

Olá pessoal, recentemente estou tentando criar uma aplicação onde eu necessito clonar alguns componentes da tela.
Por exemplo, tenho um TButton e preciso criar uma copia idêntica dele incluse executanto os metodos para cada evento.

A parte de clonar o objeto eu consegui através do uso de streams.
var
  vaStream: TMemoryStream;
  vaButton:TButton;
begin
  vaStream := TMemoryStream.create;
  vaStream.WriteComponent(btnOriginal);
  vaStream.Position := 0;
  btnOriginal.Name := 'nome_qualquer';//para nao dizer q ja existe um componente com este nome ao criar o clone
  vaButton := TButton.Create(Self);

  vaM.ReadComponent(vaButton);//clonando
end;


Com este código consigo clonar as propriedades do botão, porém os eventos não funcionam.
Para fins de teste eu até tentei algo assim:
vaButton.onclick := btnOriginal.OnClick;
mas nem assim funcionou :(

Já tentei usando RTTI percorrer todas as property do btnOriginal e atribui-las para o vaButton, porém sem sucesso também.


Alguém saberia me dizer se isso é possível?

Desde já obrigado.
Rafael Costa

Rafael Costa

Curtidas 0

Respostas

Jurandi Frade

Jurandi Frade

21/10/2012

Rafael, segue abaixo exemplo como fazer o que vc deseja.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
FLeft,
FTop : Integer;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
Var
NewButton : TButton;
ButtonName : String;
nc : Integer;
begin
nc := Form1.ComponentCount; // aqui p/ não repetir o nome do componente
ButtonName := 'Button'+ IntToStr(nc+1); // nome a atribuir do componente
NewButton := TButton.Create(Self);
NewButton.OnClick := Button1Click;
NewButton.Name := ButtonName;
NewButton.Caption := 'ButtonRunTime'+IntToStr(nc+1); // caption
NewButton.Parent := Button1.Parent;
NewButton.Top := FTop;
NewButton.Left := FLeft;
NewButton.Visible := true;
FLeft := FLeft + 80;
if FLeft > 500 then
begin
Fleft := 100;
FTop := FTop + 50;
end

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage((sender as TButton).Caption +' clicado');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Fleft := 100;
FTop := Button1.Top;

end;


end.


Sds,

GOSTEI 0
Rafael Costa

Rafael Costa

21/10/2012

Ola Jurandi,

primeiramente muito obrigado por responder, porém não é este o caso. Porque o que preciso é de uma função genérica de clone qualquer componente que eu desejar. No exemplo que passei usei um button apenas para demonstrar, mas a minha função aqui na verdade recebe um TwinControl e portanto não sei quais são os seus eventos. Por isso queria uma maneira de percorrer todos os eventos do componente original e copia-los para o meu clone.

GOSTEI 0
Jurandi Frade

Jurandi Frade

21/10/2012

Rafael, ai vai o que acho que vc precisa.
Como fiquei curioso a respeito resolvi dar uma pesquisada na net e testar tbm

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,
TypInfo;


type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
Procedure CloneProperties(const Source: TComponent; const Dest: TComponent);
Procedure CloneEvents(Source, Dest: TControl);

public
{ Public declarations }
end;

var
Form1: TForm1;
vLeft,
vTop : Integer;

implementation

{$R *.dfm}

procedure TForm1.CloneProperties(const Source: TComponent; const Dest: TComponent);
var
ms: TMemoryStream;
OldName: string;
begin
OldName := Source.Name;
Source.Name := ''; // needed to avoid Name collision
try
ms := TMemoryStream.Create;
try
ms.WriteComponent(Source);
ms.Position := 0;
ms.ReadComponent(Dest);
finally
ms.Free;
end;
finally
Source.Name := OldName;
end;
end;

procedure TForm1.CloneEvents(Source, Dest: TControl);
var
I: Integer;
PropList: TPropList;
begin
for I := 0 to GetPropList(Source.ClassInfo, [tkMethod], @PropList) - 1 do
SetMethodProp(Dest, PropList[I], GetMethodProp(Source, PropList[I]));
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage((sender as TButton).Caption +' clicado');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
vleft := 100;
vTop := Button1.Top;

end;

procedure TForm1.Button2Click(Sender: TObject);
Var
nc : Integer;
MyComp : TComponent;
CompName : String;

begin
nc := Form1.ComponentCount;
CompName := 'Comp'+ IntToStr(nc+1);
MyComp := TButton.Create(Self);
MyComp.Name := CompName;
Cloneproperties(Button1, MyComp);
CloneEvents((Button1 as TControl), (MyComp as TControl));

(MyComp as TControl).Parent := (Button1 as TControl).Parent;
(MyComp as TControl).Top := vTop;
(MyComp as TControl).Left := vLeft;
(MyComp as TControl).Visible := true;

vLeft := vLeft + 80;
if vLeft > 500 then
begin
vleft := 100;
vTop := vTop + 50;
end

end;


procedure TForm1.Button1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key = vk_f5 then
showmessage('f5 teclada');
end;

end.



Sds,

GOSTEI 0
Jurandi Frade

Jurandi Frade

21/10/2012


vc pode tbm adicionar esta função para clonar direto o componente.
obtida em: http://stackoverflow.com/questions/1238122/create-an-exact-copy-of-tpanel-on-delphi5

As funçoes anteriores foram obtidas em: http://stackoverflow.com/questions/239002/duplicating-components-at-run-time


function TForm1.CloneComponent(AAncestor: TComponent): TComponent;
var
XMemoryStream: TMemoryStream;
XTempName: string;
begin
Result:=nil;
if not Assigned(AAncestor) then
exit;
XMemoryStream:=TMemoryStream.Create;
try
XTempName:=AAncestor.Name;
AAncestor.Name:='clone_' + XTempName;
XMemoryStream.WriteComponent(AAncestor);
AAncestor.Name:=XTempName;
XMemoryStream.Position:=0;
Result:=TComponentClass(AAncestor.ClassType).Create(AAncestor.Owner);
if AAncestor is TControl then TControl(Result).Parent:=TControl(AAncestor).Parent;
XMemoryStream.ReadComponent(Result);
finally
XMemoryStream.Free;
end;
end;


e no form de teste fazer a seguinte alteração:

// MyComp := TButton.Create(Self);
MyComp := CloneComponent(Button1);


GOSTEI 0
Rafael Costa

Rafael Costa

21/10/2012

Valeu cara,

era justamente esta função CloneEvents que estava precisando, essa de clonar o componente já tinha encontrado também.

So pra completar, tentei fazer o mesmo usando RTTI novamente (nao tinha conseguido antes) e não sei bem porque agora deu certo. Fica o código para caso alguem precise.
uses 
Rtti
...
procedure TForm1.cloneMetodos(ipSource, ipDest: TWinControl);
var
  vaContext: TRttiContext;
  vaProps, vaPropsDest: TArray<TRttiProperty>
  vaTypeDest, vaTypeSource: TRttiType;
  i: integer;
begin
  vaContext := TRttiContext.Create;
  vaTypeDest := vaContext.GetType(ipDest.ClassInfo);
  vaTypeSource := vaContext.GetType(ipSource.ClassInfo);

  vaProps := vaTypeSource.GetProperties;
  vaPropsDest := vaTypeDest.GetProperties;

  for i := Low(vaProps) to high(vaProps) do
    //copia somente se for writable e se o nome da property começar com On (Ex. OnClick)
    if vaPropsDest[i].IsWritable and (StartsText('On',vaPropsDest[i].Name)) then
      vaPropsDest[i].SetValue(ipDest, vaProps[i].GetValue(ipSource));

end;


Apenas uma ultima dica para quem for usar o método de clonar o componente usando o Stream. Ao chamar o ReadComponent pode ser que ocorra uma msg de erro dizendo Class Not Found. Não sei bem porque isto ocorre, mas acredito que seja porque o metodo readComponent use o metodo FindType da RTTI o qual até onde eu li procura por classes registradas no sistema. Enfim, para resolver basta colocar na seção initialization da unit o seguinte codigo:

initialization
begin
  RegisterClass(TButton);//aqui voce deve colocar o nome da classe q o Delphi ta dizendo não encontrar. Faca isso para      //cada classe que nao for encontrada.
end;
GOSTEI 0
Carlos Lois

Carlos Lois

21/10/2012

Valeu cara,

era justamente esta função CloneEvents que estava precisando, essa de clonar o componente já tinha encontrado também.

So pra completar, tentei fazer o mesmo usando RTTI novamente (nao tinha conseguido antes) e não sei bem porque agora deu certo. Fica o código para caso alguem precise.
uses 
Rtti
...
procedure TForm1.cloneMetodos(ipSource, ipDest: TWinControl);
var
  vaContext: TRttiContext;
  vaProps, vaPropsDest: TArray<TRttiProperty>
  vaTypeDest, vaTypeSource: TRttiType;
  i: integer;
begin
  vaContext := TRttiContext.Create;
  vaTypeDest := vaContext.GetType(ipDest.ClassInfo);
  vaTypeSource := vaContext.GetType(ipSource.ClassInfo);

  vaProps := vaTypeSource.GetProperties;
  vaPropsDest := vaTypeDest.GetProperties;

  for i := Low(vaProps) to high(vaProps) do
    //copia somente se for writable e se o nome da property começar com On (Ex. OnClick)
    if vaPropsDest[i].IsWritable and (StartsText('On',vaPropsDest[i].Name)) then
      vaPropsDest[i].SetValue(ipDest, vaProps[i].GetValue(ipSource));

end;


Apenas uma ultima dica para quem for usar o método de clonar o componente usando o Stream. Ao chamar o ReadComponent pode ser que ocorra uma msg de erro dizendo Class Not Found. Não sei bem porque isto ocorre, mas acredito que seja porque o metodo readComponent use o metodo FindType da RTTI o qual até onde eu li procura por classes registradas no sistema. Enfim, para resolver basta colocar na seção initialization da unit o seguinte codigo:

initialization
begin
  RegisterClass(TButton);//aqui voce deve colocar o nome da classe q o Delphi ta dizendo não encontrar. Faca isso para      //cada classe que nao for encontrada.
end;

Não compila a instrução RegisterClass(TButton), é apresentado o erro " [dcc32 Error] uFuncoesForm.pas(1129): E2010 Incompatible types: 'tagWNDCLASSW' and 'class of TButton' "

GOSTEI 0
POSTAR