Neste artigo iremos abordar como criar uma classe genérica que poderá ser utilizada dentro das listas genéricas do Delphi.

Um tipo genérico no Delphi pode ser definido por qualquer tipo padrão (string, integer, boolean) ou um tipo criado especificamente para sua aplicação. Como isto pode ser feito? Quais componentes podem ser utilizados?

Primeiro vamos definir uma classe que ficará responsável por encapsular o valor real que queremos armazenar em um tipo genérico.

Definimos uma classe TValor onde T é o tipo que a classe irá implementar.

Listagem 1: Exemplo de Classe genérica


TValor = class
      Valor: T;
end;

Listagem 2: Exemplo de utilização da classe


Procedure teste();
Var
   oTexto: Tvalor;
begin
   oTexto := TValor.Create;
   try
      oTexto.Valor := ‘isto é um teste’;
   finally
      oTexto.Destroy;
      oTexto := Nil;
   end;
end;

Vamos pensar agora que nem sempre iremos ler o valor diretamente, como por exemplo em uma lista de objetos, como saberemos o tipo a ser tratado? Simples, vamos mudar a implementação da classe!

Listagem 3: Implementação da classe genérica alterada


unit Model.ValorUnit;

interface

uses
   System.TypInfo;

type
TValor = class
private
   FValor: T;
   FTipo: TTypeKind;
   function GetValor: T;
   procedure SetValor(const Value: T);
   function GetTipo: TTypeKind;
public
   procedure AfterConstruction; override;
   property Valor: T read GetValor write SetValor;
   property Tipo: TTypeKind read GetTipo;
end;

implementation

{ TValor }

procedure TValor.AfterConstruction;
var
   Info: PTypeInfo;
begin
   Info := System.TypeInfo(T);
   try
      if Info <> nil then
      FTipo := Info^.Kind;
   finally
      Info := nil;
   end;
end;

function TValor.GetTipo: TTypeKind;
begin
   inherited;
   result := FTipo;
end;

function TValor.GetValor: T;
begin
   result := FValor;
end;

procedure TValor.SetValor(const Value: T);
begin
   FValor := Value;
end;

end.

Nesta segunda implementação (ou alteração) a classe TValor agora possui dois campos, Fvalor e Ftipo. Fvalor irá receber o valor propriamente dito, seja ele string, integer ou qualquer outro. Enquanto que Ftipo irá receber o tipo de dados que está sendo utilizado dentro da classe e por consequência no campo Fvalor.

Para definir o campo Ftipo, utilizaremos o procedimento AfterConstruction, este procedimento herdado da classe TObject é chamado após o último construtor da classe ser executado. Segue abaixo o texto do Help do Delphi para melhor entendimento:

“Responds after the last constructor has executed.
AfterConstruction is called automatically after the object's last constructor has executed. Do not call it explicitly in your applications.
The AfterConstruction method implemented in TObject does nothing. Override this method when creating a class that performs an action after the object is created. For example, TCustomForm overrides AfterConstruction to generate an OnCreate event.”.

Neste procedimento, a nossa classe com o auxílio da System.TypInfo busca o tipo repassado ao criar um objeto do tipo Tvalor retornando o TtypeKind.

Tipos de TtypeKind: TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString, tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray, tkUString, tkClassRef, tkPointer, tkProcedure).

Porque não usar a RTTI do Delphi?

No caso de Classes Genéricas, a RTTI não consegue achar a classe com o tipo especificado através da RTTI, não podendo retornar a classe e não retornando a classe, não se pode definir o tipo de dado da propriedade.

Quando pensamos em modelos de dados em um sistema, nos vem logo à cabeça "MVC, nele existe o DAO" pensando de maneira rápida.

O que acontece quando temos uma estrutura de dados em MVC que tem a premissa de ser “Genérica”? Ou quando iremos utilizar um dicionário de dados para interação com as estruturas de nosso banco de dados e fazer de suas tabelas as nossas amadas classes de regras de negócio?

Neste ponto começamos a ter problemas entre ideias e execução. Pesquisando um pouco, chega-se a um ponto onde mesmo criando um tipo genérico (exemplo: TValor), as listas (TList, TObjectList, TSictionaryList e outros) não aceitam a seguinte sintaxe:

Listagem 4: Sintaxe não aceita por algumas listas


oLista := TList>.Create

Sendo assim, qual a solução? Uma divisão de responsabilidades dentro da estrutura de um campo de dados, uma classe genérica que guarda o valor e o tipo, uma interface para uso em listas, definindo alguns métodos gerais e uma classe que encapsula o valor genérico e que implemente a interface de campo. Complicado não é? Nem tanto. Vamos ao código.

Já temos nossa classe genérica implementada. A classe TValor encapsula somente os dados de valoração, ou seja, guarda o dado especificado na variável Fvalor e tem seu tipo definido de acordo com TypeInfo. Vamos criar agora uma interface de campos.

Listagem 5: Definindo a interface de campos


unit Model.ICampoUnit;

interface

uses
System.TypInfo;

type
   ICampo = Interface
   // GUID
   ['{CB875B5A-35E6-4A2A-9688-5994B5803CE3}']
   // functions
   function GetNomeCampo: String; stdCall;
   function GetTipo: TTypeKind; stdCall;
   // procedures
   procedure SetNomeCampo(const Value: String); stdCall;
   // propriedades
   property Tipo: TTypeKind read GetTipo;
   property NomeCampo: String read GetNomeCampo write SetNomeCampo;
End;

implementation

end.

Esta Interface irá ser utilizada para as listas genéricas. Como assim? Isso mesmo. Como em toda a programação Delphi, pode-se utilizar interfaces e criar N implementações para a mesma. Agora iremos criar uma classe que implementa a Interface e utiliza o encapsulamento de TValor.

Listagem 6: Classe que implementa a interface criada


unit Model.CampoUnit;

interface

uses
Model.ICampoUnit, Model.ValorUnit, System.TypInfo;

type
   TCampo = class(TInterfacedObject, ICampo)
   private
      var
         FNomeCampo: TValor;
         FCampo: TValor;
      function GetNomeCampo: string; stdcall;
      function GetTipo: TTypeKind; stdcall;
      procedure SetNomeCampo(const Value: string); stdcall;
      function GetValor: T;
      procedure SetValor(const Value: T);
   public
      procedure AfterConstruction; override;
      procedure BeforeDestruction; override;
      property Tipo: TTypeKind read GetTipo;
      property NomeCampo: String read GetNomeCampo write SetNomeCampo;
      property Valor: T read GetValor write SetValor;
end;

implementation

{ TCampo }

procedure TCampo.AfterConstruction;
begin
   inherited;
   FCampo := TValor.create;
   FNomeCampo := TValor.Create;
end;

procedure TCampo.BeforeDestruction;
begin
   if (FCampo <> Nil) then
   begin
      FCampo.Destroy;
      FCampo := Nil;
   end;

   if (FNomeCampo <> Nil) then
   begin
      FNomeCampo.Destroy;
      FNomeCampo := Nil;
   end;
end;

function TCampo.GetNomeCampo: string;
begin
   result := FNomeCampo.Valor
end;

function TCampo.GetTipo: TTypeKind;
begin
   result := FCampo.Tipo
end;

function TCampo.GetValor: T;
begin
   result := FCampo.Valor
end;

procedure TCampo.SetNomeCampo(const Value: string);
begin
   FNomeCampo.Valor := Value
end;

procedure TCampo.SetValor(const Value: T);
begin
   FCampo.Valor := Value
end;
end.

A classe TCampo é a classe que irá se valer da Interface ICampo e do Encapsulamento de TValor, sendo que o tipo repassado a TValor é o mesmo T da classe TCampo. Também se pode notar que outro campo FnomeCampo existe na classe e o mesmo utiliza o encapsulamento de TValor, só que dessa vez repassando String.

Utilizando a UML temos uma visão melhor do relacionamento:

Relacionamento entre Classes - UML

Figura 1: Relacionamento entre Classes - UML

Temos nossa estrutura de campos definida, mas onde iremos implementar a Lista de campos? Simples, em uma estrutura de tabela.

Listagem 7: Estrutura de tabela


unit Model.TabelasUnit;

interface

uses
Model.CampoUnit, Model.ICampoUnit, System.Generics.Collections;

type
TTabelas = class
private
var
fCampos: TList;
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
procedure AdicionaCampo(const ACampo: ICampo);
function RetornaCampo(const ANomeCampo: String): ICampo;
end;

implementation

{ TTabelas }

procedure TTabelas.AdicionaCampo(const ACampo: ICampo);
begin
fcampos.Add(aCampo)
end;

procedure TTabelas.AfterConstruction;
begin
inherited;
fCampos := TList.Create;
end;

procedure TTabelas.BeforeDestruction;
begin
inherited;
if (Fcampos <> Nil) then
begin
fCampos.Clear;
fCampos.Destroy;
fCampos := Nil;
end;
end;

function TTabelas.RetornaCampo(const ANomeCampo: String): ICampo;
var
oCampo: ICampo;
begin
for oCampo in fCampos do
if oCampo.NomeCampo = ANomeCampo then
begin
result := oCampo;
break;
end;
end;
end.

A classe TTabelas representa de uma maneira simplista uma tabela e seus campos, é somente um esqueleto básico. Como podemos ver, a lista de campos – Flist – utiliza a implementação de TList.

O objeto TList só recebe um único tipo, sendo que em caso de campos de tabelas podemos ter vários tipos(integer, varchar, float entre outros). Utilizando o tipo ICampo, esta restrição não ocorre, desde que seja enviado para a lista um tipo ICampo sempre.

Listagem 8: Exemplo de como ficaria esta implementação


procedure Tform1.Teste;
var
oCampo: ICampo;
oTabela: TTabelas;
begin
oTabela := TTabelas.Create;
try
oCampo := TCampo.Create;
TCampo(oCampo).NomeCampo := 'Teste';
TCampo(oCampo).Valor := 'Campo genérico';

oTabela.AdicionaCampo(oCampo);
finally
oTabela.Destroy;
oTabela := Nil;
end;
end;

Na implementação acima um objeto ICampo e um objeto TTabelas estão declarados no procedimento de forma local. Ao instanciar TTabelas, a classe já cria a lista de campos automaticamente, não havendo a necessidade de informar que a lista deve ser criada. Com o objeto ICampo, a história é um pouco diferente, mas você deve estar se perguntando “Porque?”.

O objeto oCampo deve ser criado com base na interface ICampo. Verificando o exemplo vemos que foi criado um TCampo, mas como assim? Vamos relembrar que TCampo implementa ICampo, aí vem a seguinte pergunta: “Como definir o valor de oCampo, sendo que o mesmo é do tipo ICampo?”. Simples, lembrai-vos da toda poderosa RTTI do Delphi. Se olharmos atentamente o exemplo, TCampo(oCampo) é um casting de TCampo para IVampo, assim podendo definir o valor do campo e o nome do campo. Se a rotina for executada em modo debug, poderá ser visto como o compilador interpreta a chamada.

Debugger do Delphi

Figura 2: Debugger do Delphi

Para um melhor entendimento, vamos definir uma classe usuário pelo método mais comum utilizado.

Listagem 9: Classe TUsuario


unit UsuarioUnit;

interface

type
  TUsuario = class
  private
    FLogin: String;
    FSenha: String;
    function GetLogin: String;
    function GetSenha: String;
    procedure SetLogin(const Value: String);
    procedure SetSenha(const Value: String);
  public
    property Login: String read GetLogin write SetLogin;
    property Senha: String read GetSenha write SetSenha;
  end;

implementation

{ TUsuario }

function TUsuario.GetLogin: String;
begin
  result := FLogin
end;

function TUsuario.GetSenha: String;
begin
  result := FSenha
end;

procedure TUsuario.SetLogin(const Value: String);
begin
  FLogin := Value
end;

procedure TUsuario.SetSenha(const Value: String);
begin
  FSenha := Value
end;

end.

Na implementação acima podemos ver que a classe TUsuario é implementada de maneira simples, onde as variáveis que irão conter os dados estão presentes na classe, sendo acessadas por métodos Get e Set.

De acordo com o que vimos, pode-se implementar classes de dados de maneira genérica, mas o que acontece quando precisamos utilizar um modelo de dados mais “estático” como o TUsuario descrito acima?

Podemos utilizar o modelo genérico descrito para criar uma classe TUsuario, que utilize o modelo descrito, sem precisar criar campos estáticos dentro da classe, segue abaixo a implementação.

Listagem 10: Implementação da classe TUsuario no modelo genérico


unit Model.UsuarioUnit;

interface

uses
  Model.TabelasUnit, Model.CampoUnit;

type
  TUsuario = class(TTabelas)
  private
    function GetAtivo: String;
    function GetDt_Cadastro: TDate;
    function GetHr_Cadastro: TTime;
    function GetLogin: String;
    function GetSenha: String;
    function GetUsu_Cadastro: String;
    procedure SetAtivo(const Value: String);
    procedure SetDt_Cadastro(const Value: TDate);
    procedure SetHr_Cadastro(const Value: TTime);
    procedure SetLogin(const Value: String);
    procedure SetSenha(const Value: String);
    procedure SetUsu_Cadastro(const Value: String);
    function GetId: Integer;
    procedure SetId(const Value: Integer);
  public
    procedure AfterConstruction; override;
    property Id: Integer read GetId write SetId;
    property Login: String read GetLogin write SetLogin;
    property Senha: String read GetSenha write SetSenha;
    property Dt_Cadastro: TDate read GetDt_Cadastro write SetDt_Cadastro;
    property Hr_Cadastro: TTime read GetHr_Cadastro write SetHr_Cadastro;
    property Usu_Cadastro: String read GetUsu_Cadastro write SetUsu_Cadastro;
    property Ativo: String read GetAtivo write SetAtivo;
  end;

implementation

{ TUsuario }

procedure TUsuario.AfterConstruction;
begin
  inherited;
  AdicionaCampo(TCampo.Create('ID',0));
  AdicionaCampo(TCampo.Create('LOGIN',''));
  AdicionaCampo(TCampo.Create('SENHA',''));
  AdicionaCampo(TCampo.Create('DT_CADASTRO'));
  AdicionaCampo(TCampo.Create('HR_CADASTRO'));
  AdicionaCampo(TCampo.Create('USU_CADASTRO',''));
  AdicionaCampo(TCampo.Create('ATIVO',''));
end;

function TUsuario.GetAtivo: String;
begin
  result := TCampo(RetornaCampo(6)).Valor
end;

function TUsuario.GetDt_Cadastro: TDate;
begin
  result := TCampo(RetornaCampo(3)).Valor
end;

function TUsuario.GetHr_Cadastro: TTime;
begin
  result := TCampo(RetornaCampo(4)).Valor
end;

function TUsuario.GetId: Integer;
begin
  result := TCampo(RetornaCampo(0)).Valor
end;

function TUsuario.GetLogin: String;
begin
  result := TCampo(RetornaCampo(1)).Valor
end;

function TUsuario.GetSenha: String;
begin
  result := TCampo(RetornaCampo(2)).Valor
end;

function TUsuario.GetUsu_Cadastro: String;
begin
  result := TCampo(RetornaCampo(5)).Valor
end;

procedure TUsuario.SetAtivo(const Value: String);
begin
  TCampo(RetornaCampo(6)).Valor := Value
end;

procedure TUsuario.SetDt_Cadastro(const Value: TDate);
begin
  TCampo(RetornaCampo(3)).Valor := Value
end;

procedure TUsuario.SetHr_Cadastro(const Value: TTime);
begin
  TCampo(RetornaCampo(4)).Valor := Value
end;

procedure TUsuario.SetId(const Value: Integer);
begin
  TCampo(RetornaCampo(0)).Valor := Value
end;

procedure TUsuario.SetLogin(const Value: String);
begin
  TCampo(RetornaCampo(1)).Valor := Value
end;

procedure TUsuario.SetSenha(const Value: String);
begin
  TCampo(RetornaCampo(2)).Valor := Value
end;

procedure TUsuario.SetUsu_Cadastro(const Value: String);
begin
  TCampo(RetornaCampo(5)).Valor := Value
end;

end.

Como vemos acima, a nossa nova classe TUsuario é uma classe descendente de TTabelas, recordando, TTabelas é uma classe que possui uma lista genérica de campos.

Dentro da nova TUsuario temos métodos e propriedades de acesso a dados como em qualquer outra classe, porém não definimos os campos que recebem os dados. O motivo: TTabelas possui uma lista genérica (fCampos: TList) que contém os campos de cada instância.

Muito bem, isso ainda não explica exatamente como acessar os dados.

Como podemos ver abaixo, a rotina SetUsu_Cadastro acessa a rotina herdada “RetornaCampo” para que um determinado campo de “fcampos” seja retornado e assim seu valor setado.

Listagem 11: Método SetUsu_Cadastro


procedure TUsuario.SetUsu_Cadastro(const Value: String);
begin
  TCampo(RetornaCampo(5)).Valor := Value
end;

Opa, mas como o campo foi criado?!

procedure TUsuario.AfterConstruction;
begin
  inherited;
  AdicionaCampo(TCampo.Create('ID',0));
  AdicionaCampo(TCampo.Create('LOGIN',''));
  AdicionaCampo(TCampo.Create('SENHA',''));
  AdicionaCampo(TCampo.Create('DT_CADASTRO'));
  AdicionaCampo(TCampo.Create('HR_CADASTRO'));
  AdicionaCampo(TCampo.Create('USU_CADASTRO',''));
  AdicionaCampo(TCampo.Create('ATIVO',''));
end;

No método “AfterConstruction”, a rotina “AdicionaCampo” é disparada. Esta rotina é herdada de TTabelas e tem como único objetivo adicionar um campo novo em “fcampos”. Pode-se notar que a rotina “Create” de TCampo (classe que encapsula os dados do campo) é chamada diretamente, repassando sempre o Nome do campo (Exemplo: ID).

Deste modo, temos uma classe que utiliza os conceitos genéricos dentro de uma estrutura bem definida e de modo estático.

Podemos ver também um reaproveitamento de código, assim só escrevendo as partes realmente necessárias de uma classe de modelo (creates, getters, setters, métodos e etc).

A codificação é até certo ponto complexa, mas quando se possui os tipos bem definidos no escopo da aplicação, utilizar este tipo de classes em views ou nos controllers da aplicação não fica realmente tão pesado quanto parece.

Deixo espaço aberto para dúvidas e ou sugestões ao artigo ou próximos temas.

Abraços.