¿Te topaste con un Variant…? [y Parte 2]

Tras una pequeña pausa…

Comentaba en la anterior entrada que la solución, aunque nos resolvía a primera vista el problema, no me dejaba del todo satisfecho. Así que lo mejor era consultar en la ayuda de delphi por ver si encontrabamos información al respecto. A fin de cuenta, tampoco ibamos a ser los primeros y los útlimos en encontrarnos con la necesidad de pasar como parametro una referencia a un objeto.

Lo que no tenía demasiado sentido era que un tipo duro como lo es el Variant, con más caras y disfraces que Mortadelo, capaz de meterse en la piel de un entero, de una cadena y de varios tipos mas (y si no basta mirar esta tabla que os reproduzco a continuación sacada directamente de la ayuda de Delphi).
En fin, que pensaba para mi que por algun lado habrían previsto algo para el caso…

VarType	Contents of variant
varEmpty	The variant is Unassigned.
varNull	The variant is Null.
varSmallint	16-bit signed integer
varInteger	32-bit signed integer
varSingle	Single-precision floating-point value
varDouble	Double-precision floating-point value
varCurrency	Currency floating-point value
varDate	Date and time value
varOleStr	Ref. to a dynamically allocated UNICODE string.
varDispatch	Reference to an Automation object
varError	Operating system error code.
varBoolean	16-bit boolean
varVariant	A variant.
varUnknown	Reference to an unknown object
varShortInt	8-bit signed integer
varByte	A Byte
varWord	unsigned 16-bit value
varLongWord	unsigned 32-bit value
varInt64	64-bit signed integer
varStrArg	COM-compatible string.
varString	Reference to a dynamically allocated string
varAny	A CORBA Any value.

Al final, tras varios minutos leyendo la ayuda, entendí tras hojear el modulo VarCmplx que el tipo Variant, además nos permitía definir tipos complejos, y entre ellos, los propios, si es que en algun momento nos podemos ver en la necesidad de definirlos. Os invito, si tenéis tiempo a revisar dicho módulo.

Así que manos a la obra. He dejado los nombres lo más similares a los que aparecen en el módulo, puesto que nos invitan a crear un descendiente de la clase TCustomVariantType para gestionar los tipos complejos. Vamos a modificar el codigo fuente…

Un momento… upssss…

ok… (leerlo y ahora comentamos)

unit uPruebaVariants;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 
  Graphics, Controls, Forms,  Dialogs, StdCtrls, VarCmplx;

type
  TObjetoMio = class(TComponent)
  private
    FNombre: String;
    procedure SetNombre(const Value: String);
  public
     property Nombre: String read FNombre write SetNombre;
  end;

  TComplexVarData = packed record
    VType: TVarType;
    Reserved1, Reserved2, Reserved3: Word;
    VComplex: TObjetoMio;
    Reserved4: LongInt;
  end;

  TForm1 = class(TForm)
    btnOk: TButton;
    lbxLista: TListBox;
    procedure btnOkClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure RecorrerLista(ALista: Array of Variant);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type

 TMyVariantType = class(TCustomVariantType)
 public
    procedure Clear(var V: TVarData); override;
    procedure Copy(var Dest: TVarData; const Source: TVarData;
      const Indirect: Boolean); override;
 end;

var
  ComplexVariantType: TMyVariantType;

function VarComplex: TVarType;
begin
  Result := ComplexVariantType.VarType;
end;

procedure VarComplexCreateInto(var ADest: Variant;
const AComplex: TObjetoMio);
begin 
  VarClear(ADest);
  TComplexVarData(ADest).VType := VarComplex;
  TComplexVarData(ADest).VComplex := AComplex;
end;

function VarComplexCreate(AObject: TObjetoMio): Variant; overload;
begin
  VarComplexCreateInto(Result, AObject);
end;


function VarIsComplex(const AValue: Variant): Boolean;
begin
  Result := (TVarData(AValue).VType and varTypeMask) = VarComplex;
end;


{ TObjetoMio }

procedure TObjetoMio.SetNombre(const Value: String);
begin
  FNombre := Value;
end;

{ TForm }

procedure TForm1.btnOkClick(Sender: TObject);
var
  MiObjeto: TObjetoMio;
  i: Integer;
begin
   //creamos dos objetos cualquiera
   MiObjeto:= TObjetoMio.Create(self);
   MiObjeto.Nombre:= 'Mi objeto';
   i:= 265;
   RecorrerLista([VarComplexCreate(MiObjeto), i])
end;

procedure TForm1.RecorrerLista(ALista: Array of Variant);
var
  i: Integer;
  FObjeto: TObjetoMio;
begin
   for i:= Low(ALista) to High(ALista) do begin
      if VarIsComplex(ALista[i]) then begin
         FObjeto:= TComplexVarData(ALista[i]).VComplex;
         lbxLista.Items.Add(FObjeto.Nombre);
      end
      else begin
         case VarType(ALista[i]) of
            varInteger: lbxLista.Items.Add(IntToStr(ALista[i]));
         end;
      end;
   end;
end;

{ TMyVariantType }

procedure TMyVariantType.Clear(var V: TVarData);
begin
  inherited;
  V.VType := varEmpty;
  TComplexVarData(V).VComplex:= Nil;
end;

procedure TMyVariantType.Copy(var Dest: TVarData; const Source: TVarData;
  const Indirect: Boolean);
begin
  inherited;
  if Indirect and VarDataIsByRef(Source) then
    VarDataCopyNoInd(Dest, Source)
  else
    with TComplexVarData(Dest) do
    begin
      VType := VarType;
      VComplex := TComplexVarData(Source).VComplex;   
    end;
end;

initialization
  ComplexVariantType := TMyVariantType.Create;

finalization
  FreeAndNil(ComplexVariantType);

end.

Para explicar brevemente los cambios, diremos que se ha definido una nueva clase TMyVariantType, descendiente de TCustomVariantType. No podemos usar directamente esta última, puesto que declara publicamente algunos metodos abstractos que son necesarios para el correcto funcionamiento. Dichos métodos son respectivamente Copy y Clear. Si poneis puntos de parada en ellos, advertireis que el primero se ejecuta en el momento que es extraida la variable del array, momento en el que necesita conocer su tipo y ejecuta diversas acciones. El método clear permite limpiar el contenido de la estructura TComplexVarData, que es la que permite enlazar la referencia al objeto, a traves del campo VComplex. Es posible que en este punto (y en otros casos), necesiteis liberar la memoria llamando al metodo Free del objeto. Yo por ejemplo, para este caso he elegido expresamente la clase TObjetoMio, descendiente de TComponent, de esa forma me inhibia de ese punto ya que el formulario se encargara de eliminarlo en su destrucción.

También se han añadido, siguiendo el modelo establecido en el modulo VarCmplx, varias funciones y procedimientos que nos permitiran limpiamente trabajar con el nuevo tipo complejo. Esta son:

• VarComplex: Devuelve el tipo asignado a la nueva variable compleja, con el fin de que se pueda comparar con otros tipos Variant
• VarComplexCreate: Crea una nueva variable compleja.
• VarComplexCreateInto: Este procedimiento se encarga de rellenar la entructura TComplexVarData.
• VarIsComplex: Devuelve un booleano true/false si la variable es de tipo compleja.

Con todo esto… si analizais y comparais el bucle que recorre el array de Variants, entre este modulo de código y el anterior, apreciareis que ahora se resuelve el tipo sin necesidad de usar excepciones, distinguiendo nuestro objeto de la variable de tipo entero.

   for i:= Low(ALista) to High(ALista) do begin
      if VarIsComplex(ALista[i]) then begin
         FObjeto:= TComplexVarData(ALista[i]).VComplex;
         lbxLista.Items.Add(FObjeto.Nombre);
      end
      else begin
         case VarType(ALista[i]) of
            varInteger: lbxLista.Items.Add(IntToStr(ALista[i]));
         end;
      end;
   end;

Nada más…

Por cierto… si habeis visto por encima el modulo VarCmplx os dareis cuenta de que existen definidas en el multitud de funciones que os permitiran trabajar con variables de tipo matemático, (quizás por eso el título de complejas)… 😀

Seguro que Juan se rie si está leyendo estas lineas… (no os he dicho que Juan es un compañero de trabajo con el que existe una buena amistad. Precisamente, estas dos entradas del blog se puede decir que nacieron de uno de los correos que cruzamos, con motivo de corregir varias lineas de código).

Descargar el codigo fuente: pruebaVariants2