Una etiqueta más util…

No se si resultará util o no, pero el comentario al menos yo creo que sí. Así que me gustaría compartir esta reflexion con vosotros.

Veamos… El tema es que andaba estos días trabajando sobre un pequeño framework que me tiene bastante distraido de todo, y tras repetir en una de las fichas, la inserción de una etiqueta para cada campo que debía aparecer, y tener que modificar el captión de la etiqueta para que apareciera el display que iba a ver el usuario, se me ocurrió que me sería util que dicha etiqueta mostrase directamente el valor asignado al campo DisplayLabel vinculado al control de edición (no es exactamente así pero creo que me entendéis ya que la propiedad DisplayLabel pertenece a los campos persistentes vinculados). Hoy no ando demasiado fino explicandome 😀

En realidad, lo verdaderamente util sería que se pudiera arrastar los campos persistentes del dataset sobre el formulario y que se convirtieran por arte de magia en los controles de edición deseados. Esta operación no resulta util desgraciadamente porque tal y como esta implementada esta característica, por defecto generaría los controles de la pestaña de edición de bases de datos (TDbEdit, etc…) y no los que pudiera elegir el usuario (el programador podría querer utilizar componentes de terceros). ¿Tiene algun sentido arrastrar para crear y luego borrarlos porque no son los que necesitas? Ese tipo de cosas, si se analizan bien, son las que nacen de una buena inspiración pero que el espiritu humano abandona con la misma presteza.

Así, que se me ocurrio distraerme un rato modificando una etiqueta (el componente ancestral que llamamos como TLabel) 🙂 para que tuviera el comportamiento que deseaba. La etiqueta debía modificar el valor del campo Caption si el componente asignado a la propiedad FocusControl era un componente de edición de bases de datos. Para reconocerlo como tal, me podría bastar saber que disponía de la propiedades FieldName y DataSource, cosa que pensaba se podría saber mediante información de tipos (RTTI).

Pues vamos a ello.

Lo primero es crear el descendiente de la etiqueta y sobrescribir la propiedad FocusControl para darle el comportamiento deseado.

 TLabelAsociado = class(TLabel)

private

//metodos de escritura y lectura

procedure SetFocusControl(Value: TWinControl);

function GetFocusControl: TWinControl;

{ Private declarations }

published

{ Published declarations }

property FocusControl: TWinControl read
GetFocusControl write SetFocusControl;

end;

function TLabelAsociado.GetFocusControl: TWinControl;

begin

Result:= inherited FocusControl;

end;

procedure TLabelAsociado.SetFocusControl(Value: TWinControl);

begin

  inherited FocusControl := Value;

//aquí actuaremos…
end;

Será en el método de escritura en el que intentaremos obtener el valor de la etiqueta.
En la web de Neftali (la dirección esta en uno de los enlaces) hay un truco para obtener una lista de las propiedades en tiempo de ejecución. Lo que vamos a hacer es sobre ese truco, modificarlo un poco para que por un lado nos devuelva el valor de la propiedad FieldName (el procedimiento GetRTTIControlInfo)
y por otro lado la instacia del DataSource que apunta a la tabla de datos (la función GetRTTIDataSourceObject).

Esta es la únidad resultante por si quereis echarle un vistazo:

unit uLabelAsociado;

//*********************************************
// Componente TLabelAsociado
//
//*********************************************
// Fecha creación: 15/06/2006
// Autor         : Salvador Jover
// Mail          : salvador@sjover.com
// HTTP          : http://www.sjover.com/delphi
//
//*********************************************
//
// Objetivo : Modificar el caption de la etiqueta vinculandolo con el valor
//            de la propiedad DisplayLabel de los campos persistentes de las
//            tablas
//
// Reflexión: Es un ejercicio sobre el uso de RTTI para cuando uno se aburre…
//
// Ver      : Página de Neftali
//

Neftali (truco)

//

interface

uses
SysUtils, Classes, Controls, StdCtrls, Dialogs, TypInfo, DB;

type

 PObjetoInfo = ^TObjetoInfo;
TObjetoInfo = record
AInfo: PPropInfo;
AObjeto: TObject;
end;

 TLabelAsociado = class(TLabel)
private
//metodos de escritura y lectura
procedure SetFocusControl(Value: TWinControl);
function GetFocusControl: TWinControl;
{ Private declarations }
published
{ Published declarations }
property FocusControl: TWinControl read GetFocusControl write SetFocusControl;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents(‘Samples’, [TLabelAsociado]);
end;

{ TLabelAsociado }

// *********************************************
// *********************************************
// Metodo    : GetRTTIDataSourceObject
// Parametros: AControl: TObject

// Resultado : TDataSource

//
// Objetivo  : Obtener la instacia del datasource al que pertenece la propiedad
//
// *********************************************

function GetRTTIDataSourceObject(AControl: TObject): TDataSource;
var
i: integer;
props: PPropList;
tData: PTypeData;
FObject: TObject;
begin
  // Inicial
Result := nil;

  // No asignado el control ==> Salimos
  if (AControl = nil) or (AControl.ClassInfo = nil)then begin
Exit;
  end;
  // Obtener la información
tData := GetTypeData(AControl.ClassInfo);
  // Tipo desconocido o sin propiedades ==> Salimos
  if (tData = nil) or (tData^.PropCount = 0) then Exit;
  //Obtenemos memoria para la estructura que almacenará la propiedades
GetMem(props, tData^.PropCount * SizeOf(Pointer));
  try
     //rellenamos la estructura con la información de clase

GetPropInfos(AControl.ClassInfo, props);
  //recorremos la lista de propiedades
for i := 0 to tData^.PropCount – 1 do begin
  //si la propiedad es de tipo clase (capaz de convertirse en un objeto)

if Props^[i]^.PropType^^.Kindin [tkClass] then begin
 //vamos a apuntar hacia dicho objeto
FObject:= GetObjectProp(AControl, Props^[i]);
  //solo consideraremos aquellos objetos referenciados
if (FObject <> nil) and (FObject is TDataSource) then begin
  //hemos encontrado nuestro datasource
Result:= (FObject as TDataSource);
Exit; //abur…
end
else if FObject <> nil then begin
  //es una instancia pero no de la clase que buscamos pero…

//¿estará dentro de dicha instancia el datasource buscado?
//recursivamente lo sabermos
Result:= GetRTTIDataSourceObject(FObject);
  //si tuviera exito nos vamos…
if Result <> nil then Exit; //abur…
end;
end;
end;
  finally
FreeMem(props); //liberamos finalmente la memoria asignada dinámicamente
  end;
end;

// *********************************************
// *********************************************
// Metodo    : GetRTTIControlInfo
// Parametros: var AObjetoInfo: TObjetoInfo; AControl: TObject; AProperty: string
//
// Objetivo  : Devolver el par Objeto-Informacion_Extructur_propiedades
//             en la variable AObjetoInfo que nos permita obtener el valor
//             de la propiedad consultada (FieldName).
//
// Comentario: No solo nos hace falta la estructura de propiedades del objeto
//             sino también el mismo objeto puesto que de estar anidadas
//             no coincidiría con el original que es pasado como parámetro
//
// *********************************************

procedure GetRTTIControlInfo(var AObjetoInfo: TObjetoInfo; AControl: TObject; AProperty: string);
var
i: integer;
props: PPropList;
tData: PTypeData;
begin
//Inicializamos la estructura que va a contener el par de retorno Info-Objeto
//la Precondicion AInfo = nil garantiza la finalización con el valor de estructura
with AObjetoInfo do begin
AInfo:= nil;
AObjeto:= nil;
end;
// No asignado el control ==> Salimos
if (AControl = nil) or (AControl.ClassInfo = nil) then begin
Exit;
end;
// Obtener la información
tData := GetTypeData(AControl.ClassInfo);
// Tipo desconocido o sin propiedades ==> Salimos
if (tData = nil) or (tData^.PropCount = 0) then Exit;
//Obtenemos memoria para la estructura que almacenará la propiedades

GetMem(props, tData^.PropCount * SizeOf(Pointer));
try

//rellenamos la estructura con la información de clase

GetPropInfos(AControl.ClassInfo, props);
//recorremos la lista de propiedades
for i := 0 to tData^.PropCount – 1 do begin

//si la propiedad es de tipo clase (capaz de convertirse en un objeto)
if Props^[i]^.PropType^^.Kind in [tkClass] then begin
GetRTTIControlInfo(AObjetoInfo, GetObjectProp(AControl, Props^[i]), AProperty);
//si ha tenido exito
if AObjetoInfo.AInfo <> nil then begin
Exit; //nos vamos…
end;
end
else
if (Props^[i]^.Name = AProperty) then begin
with AObjetoInfo do begin
AInfo:= Props^[i];
AObjeto:= AControl;
end;
Exit; //nos vamos… Encontrado par [Objeto/Info]
end;
end;
finally
FreeMem(props);
end;
end;

// *********************************************
// *********************************************
// Metodo : GetFocusControl
// Parametros:
// Resultado : TWinControl
//
// Objetivo : Metodo de lectura de la propiedad FocusControl
//
// *********************************************

function TLabelAsociado.GetFocusControl: TWinControl;
begin
Result:= inherited FocusControl;
end;

// *********************************************
// *********************************************
// Metodo : SetFocusControl
// Parametros: Value: TWinControl
// Resultado : Void
//
// Objetivo : Metodo de escritura de la propiedad FocusControl
//
// *********************************************

procedure TLabelAsociado.SetFocusControl(Value: TWinControl);
var
pOInfo: PObjetoInfo;
FDataSource: TDataSource;
FFieldName: String;
begin
  //asignamos el valor al ascendente y que haga lo
que tenga que hacer
  inherited FocusControl := Value;
  //ahora empezamos nosotros…
  //solo actuaremos en tiempo de diseño
  if (Value = nil) or (ComponentState <> [csDesigning]) then Exit;
  //reservamos memoria a la estructura TObjetoInfo que vamos a apuntar
GetMem(pOInfo, SizeOf(TObjetoInfo));
  try
     // Acceder a la info de la propiedad
GetRTTIControlInfo(poInfo^, Value, ‘DataField’);
     //comprobamos que hemos tenido un resultado positivo y la estructura
//contiene la propiedad deseada.
     if (pOInfo.AInfo <> nil) then begin
        //esta comprobación es redundante pero la dejo como segurida
//puesto que pudiera darse el caso de existir un componente
//con el mismo nombre de propiedad y distinto tipo…
        if (pOInfo.AInfo.PropType^^.Kind in [tkLString]) then begin
           // Obtenemos el valor
FFieldName:=
Format(‘%s’, [GetStrProp(pOInfo.AObjeto, pOInfo.AInfo)]);
           //Vamos a obtener el datasource
FDataSource:= GetRTTIDataSourceObject(Value);
           //si ha tenido exito y se puede obtener el valor de la etiqueta
           if Assigned(FDataSource) and Assigned(FDataSource.DataSet)
and ;(Trim(FFieldName) <> »)then begin
Caption:=
FDataSource.DataSet.FieldByName(FFieldName).DisplayLabel;
Exit; //hemos acabado
           end;
end;
end;
Caption:= »; //falló lo anterior y aquí vaciamos el valor del Caption
  finally
FreeMem(pOInfo); //liberamos la memoria dinámica
  end;
end;

end.

Bueno… la he probado varias veces y aparentemente funciona.

El ejercicio me ha valido para reflexionar un tanto sobre la RTTI y quizás sobre otros aspectos que aparecen al hilo de la reflexion:
* ¿Por qué acabé finalmente resignandome a utilizarlo en tiempo de diseño?
* En teoría debería haber utilizado una función para devolver el resultado en lugar de un procedimiento con una variable por referencia en GetRTTIControlInfo…
* ¿Funcionará en cualquier caso?

Y quizás la última reflexión que se me ocurre, es que ante un problema cualquiera, cada programador encontrará soluciones quizás no validas globalmente, pero si útiles. Pensad por ejemplo si en lugar de querer crear un descendiente de TLabel lo hubiera hecho de un TDbEdit con el fin de acompañar en tiempo de diseño y ejecución una etiqueta. Bastaría crear la etiqueta en el contstructor del TDbEdit y situarla sobre el mismo parent asociado al componente, guardando la distancia deseada del TdbEdit. En ese caso, la idea base sería sobrescribir la propiedad DataField en el TdbEdit y modificar el captión de la etiqueta de acuerdo al nuevo valor. En ese caso, no nos haria falta jugar con la RTTI.

Hubiera sido otra posible solución, sin embargo, la experiencia del día a día me dice que para eso, tendría que tener preparados en la paleta de componentes, una bateria adicional de descendientes de los mas utilizados, que a la larga quedaría sin uso y arrumbada. Sin embargo, para un programador que siempre usara los mismos controles de edición de datos, podría ser una buena dinámica de trabajo.

Os dejo que saqueis vuestras propias conclusiones… (yo vuelvo al trabajo y a mi FrameWork dichoso)

Que tengáis un buen día.

Descargar el codigo fuente: uLabelAsociado.pas