Clonando um objeto – Blog do Luiz

Recentemente resolvi melhorar a forma como copio as propriedades de um objeto para o outro. Neste caso, clonando mesmo apenas as propriedades e não o objeto inteiro. Por exemplo:

– digamos que temos uma classe chamada TPessoa com três atributos, nome, sexo e tipo (homem ou mulher, por extenso). Em determinada parte do código, precisamos pegar as propriedades de um objeto chamado p1 (TPessoa) e passar para um outro objeto, p2 (TPessoa). Normalmente fazemos:

p2.nome := p1.nome;
p2.sexo := p1.sexo;
…

Ok, funciona. O problema é que, sempre que adicionarmos um novo atributo, devemos lembrar de copiar para o objeto de destino os dados deste novo campo, caso contrário ficará sem valor.

Pesquisei na internet algo que me desse a cópia de um objeto de forma automática, sem que eu precise me preocupar se todas as propriedades estão sendo setadas no novo objeto. Encontrei a seguinte função:

//insira a unit TypInfo em uses
procedure CopyObject(Source, Dest: TObject);
var
  TypInfo: PTypeInfo;
  PropList: TPropList;
  PropCount, i: integer;
  Value: variant;
begin
  TypInfo := Source.ClassInfo;
  PropCount := GetPropList(TypInfo, tkAny, @PropList);
  for i := 0 to PropCount - 1 do
  begin
    Value := GetPropValue (Source, PropList [i]^.Name);
    SetPropValue (Dest, PropList [i]^.Name, Value);
  end;
end;

Excelente! A ideia parece funcionar. Porém ela tem um problema.

Olhando rapidamente para o código, não percebemos qualquer erro. Mas basta fazermos uma análise mais profunda e iremos perceber que este código, em determinadas classes, irá gerar “Access Violation”, visto que com o loop varrendo todas as propriedades e setando-as no objeto destinatário, ao chegar numa propriedade “read only” obteremos uma exceção.

Para demonstrar isso, vamos criar um novo projeto console e criar uma classe chamada TPessoa:

program CloneObjects;
{$APPTYPE CONSOLE}
uses
  SysUtils, TypInfo, Classes, Dialogs;
type
  TPessoa = class (TPersistent)
  private
    FTipo: string;
    FNome: string;
    FSexo: string;
    procedure SetNome(const Value: string);
    procedure SetSexo(const Value: string);
  published
    property Nome: string read FNome write SetNome;
    property Sexo: string read FSexo write SetSexo;
    property Tipo: string read FTipo; //propriedade read only
  end;

Note que a classe deriva de TPersistent e que suas propriedades são “published”. Estes são requisitos para que a função consiga pegar o valor de cada propriedade.

No método SetSexo, definimos o valor do campo FTipo:

procedure TPessoa.SetSexo(const Value: string);
begin
  FSexo := Value;
  if FSexo = 'M' then
    FTipo := 'Homem'
  else if FSexo = 'F' then
    FTipo := 'Mulher'
  else
    raise Exception.Create('Digite M ou F para o sexo');
end;

Vamos criar uma classe chamada TUtils para inserirmos um método estático da função que copia as propriedades do objeto:

  TUtils = class
  public
    class procedure CopyObject(Source, Dest: TObject);
  end;

Na implementação, utilizamos:

class procedure tutils.CopyObject(Source, Dest: TObject);
var
  TypInfo: PTypeInfo;
  PropList: TPropList;
  PropCount, i: integer;
  Value: variant;
begin
  TypInfo := Source.ClassInfo;
  PropCount := GetPropList(TypInfo, tkAny, @PropList);
  for i := 0 to PropCount - 1 do
  begin
      Value := GetPropValue(Source, PropList[i]^.Name);
      SetPropValue(Dest, PropList[i]^.Name, Value);
  end;
end;

Vamos agora instanciar nossa classe, criando dois objetos:

var
  p1: TPessoa;
  p2: TPessoa;
begin
  p1 := tpessoa.create;
  p2 := tpessoa.create;
  try
    p1.Nome := 'João';
    p1.Sexo := 'M';
    try
      TUtils.CopyObject(p1,p2);
      writeln(p2.nome);
      writeln(p2.tipo);
    except
      on e: Exception do
      begin
        ShowMessage('Erro: '+e.Message);
      end;
    end;
    Readln;
  finally
    p1.free;
    p2.free;
  end;
end.

Ao executarmos o código acima, obteremos um erro:

O erro acontece quando a função tenta setar a propriedade Tipo e esta não pode ser alterada diretamente, visto que é read only.

Uma forma de contonar este problema é fazermos com que o Delphi ignore o erro e apenas pule para a propriedade seguinte quando tentar setar uma propriedade apenas de leitura.

Para isso, vamos colocar um try except na função:

class procedure tutils.CopyObject(Source, Dest: TObject);
var
  TypInfo: PTypeInfo;
  PropList: TPropList;
  PropCount, i: integer;
  Value: variant;
begin
  TypInfo := Source.ClassInfo;
  PropCount := GetPropList(TypInfo, tkAny, @PropList);
  for i := 0 to PropCount - 1 do
  begin
    try
      Value := GetPropValue(Source, PropList[i]^.Name);
      SetPropValue(Dest, PropList[i]^.Name, Value);
    except
      // quando encontrar uma read only, gera um except mas não faz nada
    end;
  end;
end;

Veja que agora, quando a função tentar setar uma propriedade read only, ela cai no except que não faz nada, apenas vai para o próximo atributo.

Executando novamente temos:

Em tempo de compilação, continua aparecendo a mensagem de erro, mas veja que ele conclui a cópia. Executando o exe diretamente não é mostrado qualquer mensagem, visto que ignoramos o erro.

ATUALIZAÇÃO: Uma alternativa para try except na função CopyObject seria utilizar a dica do Fabricio Colombo(em comentários):

class procedure tutils.CopyObject(Source, Dest: TObject);
var
  TypInfo: PTypeInfo;
  PropList: TPropList;
  PropCount, i: integer;
  Value: variant;
begin
  TypInfo := Source.ClassInfo;
  PropCount := GetPropList(TypInfo, tkAny, @PropList);
  for i := 0 to PropCount - 1 do
  begin
    if (PropList[i]^.SetProc<> nil) then //Verifica se possui acesso a escrita na propriedade
    begin
      Value := GetPropValue(Source, PropList[i]^.Name);
      SetPropValue(Dest, PropList[i]^.Name, Value);
    end;
  end;
end;

Assim, acabamos com a exceção em tempo de compilação. Obrigado Fabricio!

Segue código completo:

program CloneObjects;

{$APPTYPE CONSOLE}

uses
  SysUtils, TypInfo, Classes, Dialogs;
type
  TPessoa = class(TPersistent)
  private
    FTipo: string;
    FNome: string;
    FSexo: string;
    procedure SetNome(const Value: string);
    procedure SetSexo(const Value: string);
  published
    property Nome: string read FNome write SetNome;
    property Sexo: string read FSexo write SetSexo;
    property Tipo: string read FTipo; //propriedade read only
  end;

  TUtils = class
  public
    class procedure CopyObject(Source, Dest: TObject);
  end;

class procedure tutils.CopyObject(Source, Dest: TObject);
var
  TypInfo: PTypeInfo;
  PropList: TPropList;
  PropCount, i: integer;
  Value: variant;
begin
  TypInfo := Source.ClassInfo;
  PropCount := GetPropList(TypInfo, tkAny, @PropList);
  for i := 0 to PropCount - 1 do
  begin
    if (PropList[i]^.SetProc<> nil) then //Verifica se possui acesso a escrita na propriedade
    begin
      Value := GetPropValue(Source, PropList[i]^.Name);
      SetPropValue(Dest, PropList[i]^.Name, Value);
    end;
  end;
end;

{ TPessoa }

procedure TPessoa.SetNome(const Value: string);
begin
  FNome := Value;
end;

procedure TPessoa.SetSexo(const Value: string);
begin
  FSexo := Value;
  if FSexo = 'M' then
    FTipo := 'Homem'
  else if FSexo = 'F' then
    FTipo := 'Mulher'
  else
    raise Exception.Create('Digite M ou F para o sexo');
end;

var
  p1: TPessoa;
  p2: TPessoa;
begin
  p1 := tpessoa.create;
  p2 := tpessoa.create;
  try
    p1.Nome := 'João';
    p1.Sexo := 'M';
    try
      TUtils.CopyObject(p1,p2);
      Writeln(p2.nome);
      Writeln(p2.tipo);
    except
      on e: Exception do
      begin
        ShowMessage('Erro: '+e.Message);
      end;
    end;
    Readln;
  finally
    p1.free;
    p2.free;
  end;
end.

No exemplo, temos apenas 2 propriedades copiadas. Imagine uma classe com 10 ou mais atributos. Imagine o trabalho que irá poupar caso utilize esta função toda vez que necessitar copiar as propriedades de um objeto. Você não teria com que se preocupar, visto que bastaria uma linha para fazer isso.

AH! Eu ia esquecendo… A classe TPersistent tem uma método virtual chamado Assign (atribuir). O objetivo deste método é de implementarmos o método de atribuição específico de cada classe. Então, vamos sobrescrever este método da seguinte forma:

  TPessoa = class(TPersistent)
  private
    FTipo: string;
    FNome: string;
    FSexo: string;
    procedure SetNome(const Value: string);
    procedure SetSexo(const Value: string);
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Nome: string read FNome write SetNome;
    property Sexo: string read FSexo write SetSexo;
    property Tipo: string read FTipo; //propriedade read only
  end;

Na implementação, usamos:

procedure TPessoa.Assign(Source: TPersistent);
begin
  if Source is TPessoa then
    TUtils.CopyObject(Source, Self)  // faz cópia das propriedades
  else
  inherited Assign(Source); //se não for a classe requerida emite mensagem de erro
end;

Agora nosso código fica assim:

var
  p1: TPessoa;
  p2: TPessoa;
begin
  p1 := tpessoa.create;
  p2 := tpessoa.create;
  try
    p1.Nome := 'João';
    p1.Sexo := 'M';
    try
      p2.Assign(p1);    //Note que agora usamos diretamente o Assign em vez da função CopyObject
      Writeln(p2.nome);
      Writeln(p2.tipo);
    except
      on e: Exception do
      begin
        ShowMessage('Erro: '+e.Message);
      end;
    end;
    Readln;
  finally
    p1.free;
    p2.free;
  end;
end.

As propriedades que utilizo no componente são geralmente strings e integers. Eu não testei com propriedades mais, digamos, “elaboradas”: arrays, objetos, listas, etc…

Se gostou deste artigo, clique Curtir na caixa do Facebook acima na lateral.

Abraços.

Luiz Carlos

Contato: luiz_sistemas@hotmail.com

Twitter: twitter.com/luiz_sistemas

3 thoughts on “Clonando um objeto”

Fabricio Colombo disse:

13 de outubro de 2011 às 10:28

Uma alternativa para retirar esse try..except que suprime todas as mensagens de erro é fazer a seguinte verificação:

if (PropList[i]^.SetProc nil) then //Verifica se possui acesso a escrita na propriedade
begin
Value := GetPropValue(Source, PropList[i]^.Name);

SetPropValue(Dest,PropList[i]^.Name, Value);
end;

Responder
1. Luiz Carlos disse:
  
  13 de outubro de 2011 às 12:08
  
  Obrigado pela participação Fabrício. Realmente é uma ótima dica.
  
  Responder
Luiz Carlos disse:

24 de outubro de 2011 às 6:45

Segue um ótimo artigo sobre RTTI:

RTTI (Run-time Type Information)
Por: Rodrigo Leonhardt
Você já se perguntou como o Object Inspector da IDE do Delphi conhece as propriedades e eventos de um objeto? E como um arquivo texto (DFM) resulta em um formulário com componentes bem definidos, em tempo de execução?

Mesmo que pareça, não é mágica! É o uso intenso de um recurso chamado RTTI (Run-time Type Information) disponível desde sempre nas versões do Delphi.

Apesar de presente, este recurso não era devidamente documentado e poucos eram os “curiosos” que descobriam esse tesouro. A partir do Delphi 2010 a RTTI recebeu a atenção que merecia e foi reformulada, incrementada e documentada…

Link para o artigo completo:
http://t.co/NTp6M1PU

Responder

Deixe um comentário para Luiz Carlos Cancelar resposta

Este site utiliza o Akismet para reduzir spam. Saiba como seus dados em comentários são processados.