- Método
procedure TrocaInstanciaClass(Instancia: TObject; NovaClasse: TClass; Parent: twincontrol);
type
PClass = ^TClass;
begin
if Assigned(Instancia) and Assigned(NovaClasse)
and NovaClasse.InheritsFrom(Instancia.ClassType)
and (NovaClasse.InstanceSize = Instancia.InstanceSize) then
begin
PClass(Instancia)^ := NovaClasse;
if NovaClasse.InheritsFrom(tcontrol) then
begin
tcontrol(Instancia).Parent:= nil;
tcontrol(Instancia).Parent:= parent;
end;
end;
end;
- Exemplo
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TMeuBotao = class(TButton) //Nova classe herdando de TButton
public
procedure ShowHandle;
end;
TForm1 = class(TForm)
btn_1: TButton;
procedure btn_1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TrocaInstanciaClass(Instancia: TObject; NovaClasse: TClass; Parent: twincontrol);
type
PClass = ^TClass;
begin
if Assigned(Instancia) and Assigned(NovaClasse)
and NovaClasse.InheritsFrom(Instancia.ClassType)
and (NovaClasse.InstanceSize = Instancia.InstanceSize) then
begin
PClass(Instancia)^ := NovaClasse;
if NovaClasse.InheritsFrom(tcontrol) then
begin
tcontrol(Instancia).Parent:= nil;
tcontrol(Instancia).Parent:= parent;
end;
end;
end;
procedure TForm1.btn_1Click(Sender: TObject);
begin
TrocaInstanciaClass(btn_1, TMeuBotao, Self); //Troca a instância
ShowMessage(btn_1.ClassName); //Mostra a classe
(btn_1 as TMeuBotao).ShowHandle; //Ultiliza o metodo da nova classe
end;
{ TMeuBotao }
procedure TMeuBotao.ShowHandle;
begin
ShowMessage(IntToStr(Self.Handle));
end;
end.
Nenhum comentário:
Postar um comentário