Como clonar eventos de um componente?
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.
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.
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
Curtidas 0
Respostas
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,
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
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.
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
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,
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
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
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.
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:
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
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.
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:
Não compila a instrução RegisterClass(TButton), é apresentado o erro " [dcc32 Error] uFuncoesForm.pas(1129): E2010 Incompatible types: 'tagWNDCLASSW' and 'class of TButton' "
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