Inicio
 
Creación de un componente paso a paso. VI

Texto.

Casi todos los controles de delphi que deben mostrar texto tienen un campo denominado Caption y/o un campo denominado Text. En nuestro caso vamos a tener los dos tipos de texto, como indicábamos en el primer capítulo I y vamos a llamarlos de la misma manera, uno Caption que será el texto que aparece el primero en el control y Text al segundo texto que podrá tener varias líneas y se deberá ajustar al tamaño del control de forma dinámica.

Podríamos pensar que, al igual que hemos hecho en otras ocasiones, deberíamos crear dos variables en la parte Private de nuestro componente y después dos propiedades que se encarguen de intercactuar con esas variables, pero muchas veces parte del trabajo lo tendremos hecho gracias a la herencia.

Vamos a hacer lo siguiente, en nuestro componente vamos a escribir el el apartado Published :

Published
   Property Capion;
   Property Text;
   ...

Ahora compilamos el paquete. Vemos que no nos ha dado ningún error de compilación y que estas propiedades aparecen en el inspector de objetos cuando dibujamos un control con nuestro componente, esto es gracias a la herencia. El componente PanelSel que estamos creando deriva o hereda de TCustomControl por lo que hereda todas las propiedades de él, éste a su vez hereda de TWinControl y este de TControl. Si nos fijamos en la definición de esta clase vemos que tiene estas dos propiedades.

En nuestro caso podemos aprovecharnos de esta característica para los dos textos, pero sólo lo vamos a hacer para Caption, mientras que para Text re-escribiremos la propiedad. Por lo tanto hacemos lo que siempre con esta nueva propiedad:

Private
   ...
   FText:TCaption;
   procedure SetText(Value:TCaption);
   ...
published
   ...
   Property Caption;
   property Text:TCaption read FText Write SetText;
...
implementation
...
constructor TPanelSel.Create(AOwner:TComponent);
begin
   inherited;
   ...
   FText:='';
end;
...
procedure TSelPanel.SetText(Value: TCaption);
begin
   if FText<>Value then
   begin
      FText:=Value;
      invalidate;
   end;
end;

Ya tenemos las dos propiedades de texto que necesitamos, pero aún no se dibuja nada en pantalla, tenemos varias funciones que dibujan texto en pantalla (Textout, TextRect, Drawtext) pero el estudio de las mismas queda fuera de lo que se pretende en estos artículos, sólo explicaremos la función que vamos a utilizar en este componente y esta es DrawText, esta es una llamada a la función de windows DrawTextA. Esta función escribe texto formateado dependiendo de una serie de flags que se le pasan como parámetros.

Para que nuestro componente se 'entere' de que hemos hecho cambios en la propiedad Caption heredada, debemos sobreescribir el procedimiento que responde al mensaje CM_TEXTCHANGED que es el que informa sobre un cambio en el texto :

procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;

Primero vamos a escribir nuestro Caption, queremos que aparezca en una sola línea justo después del borde superior del control, que no admita retornos de carro y que aparezcan puntos suspensivos cuando no pueda mostrarse completamente dentro del control, pues todo esto se lo diremos con los Flags antes mencionados. De momento también haremos que esté justificado a la izquierda todo lo anterior se indicaría de la siguiente manera :

Flags:=DT_LEFT or DT_NOPREFIX or DT_END_ELLIPSIS;

El formato de la llamada a Draw text está definido por Windows como :

int DrawText(

    HDC hDC,	// handle to device context 
    LPCTSTR lpString,	// pointer to string to draw 
    int nCount,	// string length, in characters 
    LPRECT lpRect,	// pointer to structure with formatting dimensions  
    UINT uFormat 	// text-drawing flags 
   );

El texto se dibuja en el canvas de nuestro control (Canvas.Handle) y dentro de un rectángulo cuyas coordenadas debemos pasar como parámetro, Delphi define una estructura denominada TRect que guarda los valores que determinan un rectángulo. En un primer momento vamos a suponer el rectángulo total del espacio ocupado por nuestro componente.

procedure TPanelSel.Paint;
var
   X, Y, W, H: Integer;
   r:TRect;
   Flags:Cardinal;
begin
   with Canvas do
   begin
   ...
   ...
      Flags:=DT_LEFT or DT_NOPREFIX or DT_END_ELLIPSIS;
      R:=ClientRect; // Devuelve el área de cliente del control
      Drawtext(handle,PChar(caption),-1,R,flags);
   end;
end;

El resultado es el siguiente :


Figura 6

Observamos que el texto aparece en el componente pero no parece que quede muy estético, así que vamos a afinar, primero tendremos que tener en cuenta el ancho del borde, que no se escriba encima de la imagen y el rectángulo en el que tiene que aparecer sea como máximo el alto del texto y no el alto del control. Al igual que en el caso de picture vamos a definir una propiedad que indique una coordenada X del texto dentro del control. El código es el mismo que para la propiedad PosXPicture y la llamaremos PosXText.

El código del método Paint completo en en que se marca las partes del código que hace lo que se indica en el párrafo anterior ;

procedure TPanelSel.Paint;
var
   X, Y, W, H: Integer;
   r:TRect;
   Flags:Cardinal;
   despv,desph:Integer;
begin
   despv:=3;
   Desph:=0;
   if border then
   begin
      despv:=despv+BorderWidth; //Desplazamiento vertical
      Desph:=BorderWidth-1;     //Desplazamiento horizontal
   end;
   with Canvas do
   begin
      setbkmode(Handle,TRANSPARENT);
      Pen.Width:=BorderWidth;
      Pen.Color:=BorderColor;
      Brush.Style:=bsSolid;
      Brush.Color:=Color;
      X := Pen.Width div 2;
      Y := X;
      W := Width - Pen.Width + 1;
      H := Height - Pen.Width + 1;
      if Focused then
      begin
         Pen.Color:=FocusedBorderColor;
         Brush.Color:=FocusedColor;
      end;
      if FOver then
      begin
         Pen.Color:=OverBorderColor;
         Brush.Color:=OverColor;
      end;
      FillRect(ClientRect);
      Brush.Style:=bsClear;
      if Assigned(Picture.Graphic) then
      begin
         Picture.Graphic.Transparent:=true;
         Draw(BorderWidth+PosXPicture,((Height-Picture.Graphic.Height) div 2),Picture.Graphic);
      end;
      if Border then Rectangle(X, Y, X + W, Y + H);
      Flags:=DT_LEFT or DT_NOPREFIX or DT_END_ELLIPSIS;
      // Tenemos en cuenta la propiedad PosXText y los desplazamientos horizontal y vertical
      R:=Rect(posxText+desph,despv,width-desph,height-despv);
      Drawtext(handle,PChar(caption),-1,R,flags);
   end;
end;

El resultado es el siguiente :


Figura 7

El segundo texto (propiedad Text) debe aparecer después del Caption pero en este caso el texto debe admitir retornos de carro y debe ajustar el texto al tamaño del control. Utilizaremos la misma función para escribir el texto, pero cambiando los Flags y el rectángulo al que el texto debe circunscribirse. Esto se consigue con el siguiente código :

      Flags:=DT_WORDBREAK or DT_LEFT or DT_NOPREFIX;
      R:=Rect(posxText+desph,TextHeight(Caption)+despv,width-despv,height-despv);

Con DT_WORDBREAK, permitimos que el texto cambie de línea para ajustarse al tamaño de las coordenadas del rectángulo que se le pasa como parámetro. Para calcular estas coordenadas utilizamos el método TextHeight del canvas de devuelve el alto del texto que se le pasa en pixels, el valor depende de la fuente utilizada.

El resultado :


Figura 8

Fuentes del texto.

Hasta ahora no hemos tenido en cuenta el tipo de letra ni tamaño con la que escribir los textos. Si miramos en el inspector de objetos las propiedades del nuestro componente vemos que hay una que se llama Font. Vamos a utilizar ésta como fuente para escribir el texto de la propiedad Caption, para el otro texto veremos que hacer más adelante.

Para escribir con la fuente de la propiedad del componente, basta asignar ésta a la propiedad Font del objeto Canvas de nuestro componente :

procedure TPanelSel.Paint;
var
   X, Y, W, H: Integer;
   r:TRect;
   Flags:Cardinal;
   despv,desph:Integer;
begin
   ...
   ...
      Flags:=DT_LEFT or DT_NOPREFIX or DT_END_ELLIPSIS;
      R:=Rect(posxText+desph,despv,width-desph,height-despv);
      Font:=self.Font;
      Drawtext(handle,PChar(caption),-1,R,flags);
      Flags:=DT_WORDBREAK or DT_LEFT or DT_NOPREFIX;
      R:=Rect(posxText+desph,TextHeight(Caption)+despv,width-despv,height-despv);
      DrawText(Handle, PChar(Text), -1, R, Flags);
   end;
end;

Si compilamos el componente y modificamos el valor de la propiedad Font vemos que en pantalla nos cambia el texto escrito con la nueva fuente, pero observamos que también se escribe con la misma fuente el segundo texto. Para evitar esto y a la vez dar la posibilidad de cambiar a una fuente distinta el texto de la propiedad Text vamos a añadir una propiedad nueva TextFont.

Private
	  ...
   FTextFont:TFont;
   ...
   procedure SetTextFont(Value:TFont);
   ...
published
   ...
   property TextFont:TFont read FTextFont Write SetTextFont;
   ...
implementacion
...
constructor TPanelSel.Create(AOwner:TComponent);
begin
   inherited;
   ...
   FTextFont:=TFont.Create;
   ...
end;
destructor TPanelSel.Destroy;
begin
   FTextFont.Free;
   FPicture.Free;
   inherited;
end;
...
procedure TPanelSel.SetTextFont(Value:TFont);
begin
   FTextFont.Assign(Value);
   Invalidate;//observamos que esta orden no hace que nuestro componente responda
end;
...
procedure TPanelSel.Paint;
var
   X, Y, W, H: Integer;
   r:TRect;
   Flags:Cardinal;
   despv,desph:Integer;
begin
 ...
      Font:=self.Font;
      Drawtext(handle,PChar(caption),-1,R,flags);
      Flags:=DT_WORDBREAK or DT_LEFT or DT_NOPREFIX;
      R:=Rect(posxText+desph,TextHeight(Caption)+despv,width-despv,height-despv);
      Font:=self.TextFont;
      DrawText(Handle, PChar(Text), -1, R, Flags);
   end;
end;

La nueva propiedad hace referencia a un objeto, por lo que debemos crearlo y destruirlo antes de que nuestro control se destruya.(Observe que se asigna la fuente al canvas después de calcular el rectángulo donde se debe escribir el texto, si se asignara antes de este cálculo, TextHeight devolverían el tamaño de la nueva fuente y no la que nos interesa que es la de la fuente con que se escribió el Caption).

Pero sólo con esto no conseguimos que se actualice automáticamente al modificar su valor en el inspector de objetos. ¿Qué hacer para que el texto cambie en pantalla en cuanto se cambia alguna de las propiedades del objeto Font referenciado por nuestra propiedad TextFont? Si miramos la ayuda de delphi del objeto TFont vemos que aparte de propiedades y métodos tenemos también un evento : OnChange, si podemos asignar a este evento un procedimiento definido en nuestro componente, podríamos hacer que este respondiera a los cambios, pues esto es lo que hacemos :

constructor TPanelSel.Create(AOwner:TComponent);
begin
   inherited;
   ...
   FTextFont:=TFont.Create;
   FTextFont.OnChange:=FontChanged;
   ...
end;

FontChanged es un procedimiento que definimos en el apartado Private de la definición de nuestro componente y en la implementación lo único que haremos será invalidar el control :

procedure TPanelSel.FontChanged(Sender: TObject);
begin
   invalidate;
end;


Figura 9

El código del componente es hasta ahora :

unit PanelSel;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Graphics;

type
  TPanelSel = class(TCustomControl)
  private
    FPicture:TPicture;
    FColors:array[0..5] of TColor;
    FBorder:Boolean;
    FBorderWidth:Integer;
    FOver:Boolean;
    FPosXPicture:Word;
    FText:TCaption;
    FTextFont:TFont;
    FPosXText:Word;
    procedure SetPicture(Value:TPicture);
    procedure SetColors(Index:Integer;Value:TColor);
    function GetColors(Index:integer):TColor;
    procedure SetBorder(Value:Boolean);
    procedure SetBorderWidth(Value:integer);
    procedure SetPosXPicture(Value:Word);
    procedure SetText(Value:TCaption);
    procedure SetPosXText(Value:Word);
    procedure SetTextFont(Value:TFont);
    procedure FontChanged(Sender: TObject);
    { Private declarations }
  protected
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure Paint; override;
    procedure Click;override;
    { Protected declarations }
  public
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    property Colors[Index:Integer]:TColor read GetColors Write SetColors;
    { Public declarations }
  published
     property Picture:TPicture read FPicture Write SetPicture;
     property Border:Boolean read FBorder Write SetBorder default True;
     property BorderWidth:integer read FBorderWidth Write SetBorderWidth default 1;
     property Color:TColor Index 0 read GetColors Write SetColors default clBtnFace;
     property BorderColor:TColor Index 1 read GetColors Write SetColors default clBlack;
     property FocusedColor:TColor Index 2 read GetColors Write SetColors default clBtnHighlight;
     property FocusedBorderColor:TColor Index 3 read GetColors Write SetColors default clBlack;
     property OverColor:TColor Index 4 read GetColors Write SetColors default clBtnShadow;
     property OverBorderColor:TColor Index 5 read GetColors Write SetColors default clBlack;
     property PosXPicture:Word read FPosXPicture Write SetPosXPicture default 10;
     property PosXText:Word read FPosXText Write SetPosXText default 50;
     property Caption;
     property Text:TCaption read FText Write SetText;
     property TextFont:TFont read FTextFont Write SetTextFont;
     property Font;
     property Tabstop;
    { Published declarations }
  end;

procedure Register;

implementation
constructor TPanelSel.Create(AOwner:TComponent);
begin
   inherited;
   FOver:=False;
   Tabstop:=True;
   FBorder:=True;
   FBorderWidth:=1;
   FColors[0]:= clBtnFace;
   FColors[1]:=clBlack;
   FColors[2]:=clBtnHighlight;
   FColors[3]:=clBlack;
   FColors[4]:= clBtnShadow;
   FColors[5]:=clBlack;
   FPicture:=TPicture.Create;
   FTextFont:=TFont.Create;
   FTextFont.OnChange:=FontChanged;
   FPosXPicture:=10;
   FPosXText:=50;
   FText:='';
   Font.Style:=[fsBold];
end;
destructor TPanelSel.Destroy;
begin
   FTextFont.Free;
   FPicture.Free;
   inherited;
end;
procedure TPanelSel.CMTextChanged(var Message: TMessage);
begin
   inherited;
   invalidate;
end;
procedure TPanelSel.WMSetFocus(var Message: TWMSetFocus);
begin
   inherited;
   Invalidate;
end;

procedure TPanelSel.WMKillFocus(var Message: TWMSetFocus);
begin
   inherited;
   Invalidate;
end;

procedure TPanelSel.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  FOver:=True;
  Invalidate;
end;

procedure TPanelSel.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  FOver:=False;
  Invalidate;
end;

procedure TPanelSel.SetPicture(Value:TPicture);
begin
   FPicture.Assign(Value);
   repaint;
end;
procedure TPanelSel.SetPosXPicture(Value:Word);
begin
   if FPosXPicture<>Value then
      if value>0 then
      begin
         FPosXPicture:=Value;
         invalidate;
      end;
end;

procedure TPanelSel.SetPosXText(Value:Word);
begin
   if FPosXText<>Value then
      if Value>0 then
      begin
         FPosXText:=Value;
         invalidate;
      end;
end;

procedure TPanelSel.SetText(Value: TCaption);
begin
   if FText<>Value then
   begin
      FText:=Value;
      invalidate;
   end;
end;

procedure TPanelSel.SetTextFont(Value:TFont);
begin
   FTextFont.Assign(Value);
end;

procedure TPanelSel.FontChanged(Sender: TObject);
begin
   invalidate;
end;

procedure TPanelSel.SetBorder(Value:Boolean);
begin
   if FBorder<>Value then
   begin
      FBorder:=Value;
      Invalidate;
   end;
end;

procedure TPanelSel.SetBorderWidth(Value:integer);
begin
   if FBorderWidth<>Value then
   begin
      if Value>0 then
         FBorderWidth:=Value;
      Invalidate;
   end;
end;
procedure TPanelSel.SetColors(Index:Integer;Value:TColor);
begin
   if FColors[Index]<>Value then
   begin
      FColors[Index]:=Value;
      Invalidate;
   end;
end;
Function TPanelSel.GetColors(Index:Integer):TColor;
begin
   Result:=FColors[Index];
end;

procedure  TPanelSel.Click;
begin
   inherited;
   SetFocus;   
end;
procedure TPanelSel.Paint;
var
   X, Y, W, H: Integer;
   r:TRect;
   Flags:Cardinal;
   despv,desph:Integer;
begin
   despv:=3;
   Desph:=0;
   if border then
   begin
      despv:=despv+BorderWidth;
      Desph:=BorderWidth-1;
   end;
   with Canvas do
   begin
      setbkmode(Handle,TRANSPARENT);
      Pen.Width:=BorderWidth;
      Pen.Color:=BorderColor;
      Brush.Style:=bsSolid;
      Brush.Color:=Color;
      X := Pen.Width div 2;
      Y := X;
      W := Width - Pen.Width + 1;
      H := Height - Pen.Width + 1;
      if Focused then
      begin
         Pen.Color:=FocusedBorderColor;
         Brush.Color:=FocusedColor;
      end;
      if FOver then
      begin
         Pen.Color:=OverBorderColor;
         Brush.Color:=OverColor;
      end;
      FillRect(ClientRect);
      Brush.Style:=bsClear;
      if Assigned(Picture.Graphic) then
      begin
         Picture.Graphic.Transparent:=true;
         Draw(BorderWidth+PosXPicture,((Height-Picture.Graphic.Height) div 2),Picture.Graphic);
      end;
      if Border then Rectangle(X, Y, X + W, Y + H);
      Flags:=DT_LEFT or DT_NOPREFIX or DT_END_ELLIPSIS;
      R:=Rect(posxText+desph,despv,width-desph,height-despv);
      Font:=self.Font;
      Drawtext(handle,PChar(caption),-1,R,flags);
      Flags:=DT_WORDBREAK or DT_LEFT or DT_NOPREFIX;
      R:=Rect(posxText+desph,TextHeight(Caption)+despv,width-despv,height-despv);
      Font:=self.TextFont;
      DrawText(Handle, PChar(Text), -1, R, Flags);
   end;
end;
procedure Register;
begin
  RegisterComponents('Ejemplo', [TPanelSel]);
end;

end.

Nota : Las distintas alineaciones del texto se tratarán más adelante.