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

5 comentarios sobre “Una etiqueta más util…

  1. Está guapo 🙂

    Me parece buena idea dejarlo sólo para tiempo de diseño, quizás alguna vez quieras poner un texto distinto a DisplayLabel. Y entonces tendrías que comerte el coco para saber si se carga primero la propiedad Caption o FocusControl.

  2. Hola Nico.

    Gracias por el comentario.

    Sobre el tema del uso del componente en tiempo de diseño, había una reflexión muy interesante ya que si se hacen distintas pruebas eliminando esta condición, es decir comentamos el trozo de código:
    {or (ComponentState [csDesigning]) }
    nos daremos cuenta de que la etiqueta desaparece al ejecutarse, por obra y gracia de la misma asignación de la propiedad.
    Creo que eso nos abriría las puertas a reflexionar sobre un nuevo tema y sobre el modo en que carga el formulario los valores almacenados en el dfm y la asignación de valores sobre las propiedades, No debería ser así pero en algunos casos concretos el orden de creación, no solo de los controles sino de los módulos, podrían tener efectos indeseados (o mejor dicho “imprevistos”).

  3. Eso está documentado… más o menos. O sea que viene en alguna parte de la ayuda y ha salido en algunos libros, pero no es realmente fácil dar con la referencia. En su día descubrí a una panda de gente, encabezada por Ray Lischner con sus libros (Secrets of Delphi 2, Hidden Paths of Delphi 3), que trataban de cosas como la RTTI, los DFM y otros rincones pobremente documentados. Cuando mantenía la sección de enlaces de Club Delphi puse enlaces a los sitios que conocía, no sólo Lischner, sino Gerald Nunn (GExperts) o Sergei Orlik (de Borland Rusia). Ahora supongo que en la web de Lischner (o “en Google”) hay de donde tirar, aunque hacen falta inglés y paciencia.

    Una buena parte de los problemas que aparecen al hacer componentes propios se solucionan sobreescribiendo Loaded en vez de Create. El método Loaded se ejecuta después de que se han leído los componentes desde el DFM. Pero no es toda la historia, claro. ComponentState desde luego es otra posibilidad, aunque no recuerdo bien cómo iba.

    Respecto a lo de que hay distintas formas de hacer lo mismo… es rigurosamente cierto. A mí se me ocurre una más (que no tiene que ser mejor o peor, sólo distinta) que sería lo mismo que hace Delphi para arrastrar campos desde un dataset: crear un experto o algo similar y meter allí este código.

    Una cosa al margen: ¿modificas la historia? Me llega repetidísima al agregador y suele pasar cuando se modifica la parte principal. No es una queja, sólo te aviso 🙂 Para evitarlo, puedes meter los añadidos o correcciones en comentarios, salvo que realmente quieras que salga una nueva versión, que también puede ser.

  4. Impresionante Salva!
    Debo estar muy oxidado con el Delphi, componentes, RTTI y demás zarandajas, porque no entiendo nada de nada (-8

    if (pOInfo.AInfo.PropType^^.Kind in [tkLString])

    ¿¿¿¿¿???????

    Por cierto, lo que sí recuerdo es que para crear componentes propios, es mejor heredar de los TCustomXXX en vez de heredar directamente de TXXX. Esto te permite publicar las propiedades que tu quieras. Pero vamos, del resto, ni papa (:

    Abrazos

    JM

  5. if (pOInfo.AInfo.PropType^^.Kind in [tkLString])

    Tampoco yo entiendo para qué sirven los paréntesis 🙂

    Si te referías a ^^, significa que lo que hay antes es un puntero que apunta a otro puntero.

Los comentarios están cerrados.

Blog de WordPress.com.

Subir ↑

Recetas y consejos nutricionales

Indicadas para personas con diabetes, recomendadas para todos.

¡Buen camino!

ANÉCDOTAS Y REFLEXIONES SOBRE UN VIAJE A SANTIAGO…

http://lfgonzalez.visiblogs.com/

Algunas reflexiones y comentarios sobre Delphi

It's All About Code!

A blog about Delphi and related technologies

The Podcast at Delphi.org

The Podcast about the Delphi programming language, tools, news and community.

Blog de Carlos G

Algunas reflexiones y comentarios sobre Delphi

The Road to Delphi

Delphi - Free Pascal - Oxygene

La web de Seoane

Algunas reflexiones y comentarios sobre Delphi

El blog de cadetill

Cosas de programación....... y de la vida

Delphi-losophy

A Lover of Delphi Wisdom

Delphi en Movimiento

Algunas reflexiones y comentarios sobre Delphi

marcocantu.blog

Algunas reflexiones y comentarios sobre Delphi

/*Prog*/ Delphi-Neftalí /*finProg*/

Blog sobre programación de Neftalí -Germán Estévez-

Press F9

Algunas reflexiones y comentarios sobre Delphi

El blog de jachguate

Un blog sobre tecnología y la vida en general

A %d blogueros les gusta esto: