Clonando um objeto

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:

[sourcecode language=”delphi”]
//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;
[/sourcecode]

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:

[sourcecode language=”delphi”]
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;
[/sourcecode]

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:

[sourcecode language=”delphi”]
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;
[/sourcecode]

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

[sourcecode language=”delphi”]
TUtils = class
public
class procedure CopyObject(Source, Dest: TObject);
end;
[/sourcecode]

Na implementação, utilizamos:

[sourcecode language=”delphi”]
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;
[/sourcecode]

Vamos agora instanciar nossa classe, criando dois objetos:

[sourcecode language=”delphi”]
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.
[/sourcecode]

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:

[sourcecode language=”delphi”]
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;
[/sourcecode]

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):

[sourcecode language=”delphi”]
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;
[/sourcecode]

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

Segue código completo:

[sourcecode language=”delphi”]
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.
[/sourcecode]

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:

[sourcecode language=”delphi”]
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;
[/sourcecode]

Na implementação, usamos:

[sourcecode language=”delphi”]
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;
[/sourcecode]

Agora nosso código fica assim:

[sourcecode language=”delphi”]
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.
[/sourcecode]

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.

Twitter: twitter.com/luiz_sistemas