quinta-feira, 30 de janeiro de 2014

Trocar a classe de uma instância em runtime...

- 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