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

Respondiendo al teclado.

En el capítulo III vimos como podíamos responder a la pulsación con el ratón sobre nuestro componente (Click) este método estaba definido en el ancestro de nuestro componente TControl, si vais a la ayuda de delphi de esta clase lo podéis ver.

En nuestro componente queremos, además, que cuando se pulse la barra espaciadora o la tecla Return, el control se comporte como si se hubiera pulsado con el ratón, es decir, que se hubiera hecho Click. Si, como vimos, ya existía un método definido para el ratón, podemos intuir que también lo puede haber para la pulsación del teclado, para ello buscamos en sus ancestros un método que pueda servirnos y hayamos que en TWinControl tenemos tres métodos que podrían servirnos :

    procedure KeyDown(var Key: Word; Shift: TShiftState); dynamic;
    procedure KeyUp(var Key: Word; Shift: TShiftState); dynamic;
    procedure KeyPress(var Key: Char); dynamic;

A nosotros nos basta con saber si las teclas Return y Barra espaciadora se han pulsado, independientemente de si las teclas de mayúsculas, control o Alt están también pulsadas, así que lo que haremos será sobreescribir el método KeyPress para que responda a la pulsación de estas dos teclas y haga caso omiso al resto.

  protected
    ...
    procedure KeyPress(var Key: Char);override;
    ...
implementation
...
procedure TPanelSel.KeyPress(var Key: Char);
begin
   if (Key=#13) or (Key=#32) then
      Click;
   Key:=#0;
end;
...

Como podéis ver, lo único que hace este procedimiento es comprobar si se ha pulsado Return (#13) o espacio (#32), si es así se llama al método Click. Después se pone a nulo (#0) la tecla pulsada.

Alineación del texto.

Hasta este momento el texto de las propiedades Caption y Text sólo está alineado a la izquierda, y si nos fijamos en el método Paint vemos que esto lo fija el Flag DT_LEFT, yendo a la ayuda vemos que además existe DT_RIGHT y DT_CENTER, por lo que usando cualquiera de estos flags podemos cambiar la justificación del texto. Por otra parte si nos fijamos en las propiedades del control Label, podemos observar que tiene una propiedad Alignment que es la misma que nos interesa a nosotros, así que utilizaremos su misma denominación y tipo para nuestro componente, esta propiedad es de tipo TAlignment que delphi define así :

TAlignment = (taLeftJustify, taRightJustify, taCenter);

En nuestro componente deberemos tener dos propiedades distintas, una para Caption y otra para Text, la de Caption la llamaremos Alignment y la de Text la denominaremos TextAlign las dos del tipo TAlignment :

   private
     ...
     FAlignment,
     FTextAlign: TAlignment;
     ...
     procedure SetAlignment(Value: TAlignment);
     procedure SetTextAlign(Value: TAlignment);
     ...
   published
     ...
     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
     property TextAlign: TAlignment read FTextAlign write SetTextAlign default taLeftJustify;
     ...
implementation
...
constructor TPanelSel.Create(AOwner:TComponent);
begin
   inherited;
   ...
   Alignment:=taLeftJustify;
   TextAlign:=taLeftJustify;
   ...
end;
...
procedure TPanelSel.SetAlignment(Value: TAlignment);
begin
   if FAlignment<>Value then
   begin
      FAlignment:=Value;
      Invalidate;
   end;
end;
procedure TPanelSel.SetTextAlign(Value: TAlignment);
begin
   if FTextAlign<>Value then
   begin
      FTextAlign:=Value;
      Invalidate;
   end;
end;
...

Ya tenemos definidas las propiedades, ahora nos falta tenerlas en cuenta cuando dibujamos el texto en el método Paint de nuestro control. Debemos hacer algo para transformar los valores de las propiedades a los que nosotros necesitamos, o sea, de taLeftJustity a DT_LEFT e igual para el resto. Una forma sería mediante la estructura 'Case var of' de delphi, pero en este caso que tenemos dos propiedades que hacen lo mismo, nos veríamos duplicar código o sacar el código a una función y hacer dos llamadas, una con cada una de las propiedades. Hay una forma más 'elegante' de hacerlo :

const
   AAlignment : array[taLeftJustify..taCenter] of uchar=(DT_LEFT,DT_RIGHT,DT_CENTER);

¿Qué hace esto?, pues define una constante que es un array unidimensional con tres valores, los índices de este array son los contenidos de las propiedades de Alineación y los valores del mismo son los Flags que nosotros necesitamos, así que bastará hacer AAlignment[TextAlign] para obtener el flag que haga que el texto contenido en la propiedad Text esté justificado de acuerdo a esa propiedad:

procedure TPanelSel.Paint;
const
   AAlignment : array[taLeftJustify..taCenter] of uchar=(DT_LEFT,DT_RIGHT,DT_CENTER);
var
   X, Y, W, H: Integer;
   ...
   ...
      Flags:=AAlignment[Alignment] 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 AAlignment[TextAlign] 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;
...


Figura 10

Podemos pensar que ya hemos conseguido lo que queríamos, pero nos falta un detalle, si observamos las propiedades de nuestro componente, vemos una propiedad que tiene que ver con la alineación del texto y que nosotros no hemos tenido en cuenta : BiDiMode (Bidirectional Mode) esta propiedad ajusta la apariencia del texto cuando el componente se ejecuta en un país en el que se lee de derecha a izquierda, por ello, en el caso de que esto sea así, lo que nosotros llamaremos justificado a la izquierda para otros países será a la derecha y viceversa. Vea los cambios hechos en el código para tener en cuenta esta propiedad :

unit PanelSel;

interface

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

type
  TPanelSel = class(TCustomControl)
  private
    FPicture:TPicture;
    FColors:array[0..5] of TColor;
    FOnMouseEnter,
    FOnMouseLeave:TNotifyEvent;
    FBorder:Boolean;
    FBorderWidth:Integer;
    FOver:Boolean;
    FPosXPicture:Word;
    FText:TCaption;
    FTextFont:TFont;
    FPosXText:Word;
    FAlignment,
    FTextAlign: TAlignment;
    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);
    procedure SetAlignment(Value: TAlignment);
    procedure SetTextAlign(Value: TAlignment);
    { 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 KeyPress(var Key: Char);override;
    procedure Click;override;
    { Protected declarations }
  public
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    property Colors[Index:Integer]:TColor read GetColors Write SetColors;
    Procedure SetAllTexts(S:String);
    { Public declarations }
  published
     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
     property TextAlign: TAlignment read FTextAlign write SetTextAlign default taLeftJustify;
     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;
     property BiDiMode;
     property TabOrder;
     property Action;
     property Align;
     property Anchors;
     property Visible;
     property Enabled;
     property Constraints;
     property DragCursor;
     property DragKind;
     property DragMode;
     property ParentBiDiMode;
     property ParentFont;
     property ParentShowHint;
     property PopupMenu;
     property ShowHint;
     property OnMouseEnter:TNotifyEvent read FOnMouseEnter Write FOnMouseEnter;
     property OnMouseLeave:TNotifyEvent read FOnMouseLeave Write FOnMouseLeave;
     property OnClick;
     property OnContextPopup;
     property OnDblClick;
     property OnDragDrop;
     property OnDragOver;
     property OnEndDock;
     property OnEndDrag;
     property OnMouseDown;
     property OnMouseMove;
     property OnMouseUp;
     property OnStartDock;
     property OnStartDrag;
     property OnEnter;
     property OnExit;
    { Published declarations }
  end;
Function _BiDiMode(Alignment: TAlignment;BiDi:TBiDiMode):TAlignment;
procedure Register;

implementation
Function _BiDiMode(Alignment: TAlignment;BiDi:TBiDiMode):TAlignment;
begin
  Result :=Alignment;
  if (SysLocale.MiddleEast) and (BiDi= bdRightToLeft) then
  case Alignment of
    taLeftJustify:  Result := taRightJustify;
    taRightJustify: result := taLeftJustify;
  end;
end;
Procedure TPanelSel.SetAllTexts(S:String);
begin
   if S='' then
   begin
      Caption:='';
      Text:='';
   end
   else
      if pos('|',S)>0 then
      begin
         caption:=copy(S,1,pos('|',S)-1);
         text:=copy(S,pos('|',S)+1,length(S));
      end
      else
         Caption:=S;
end;
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];
   FAlignment:=taLeftJustify;
   FTextAlign:=taLeftJustify;
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;
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
  FOver:=True;
  Invalidate;
end;

procedure TPanelSel.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
  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.KeyPress(var Key: Char);
begin
   if (Key=#13) or (Key=#32) then
      Click;
   Key:=#0;
end;
procedure TPanelSel.SetAlignment(Value: TAlignment);
begin
   if FAlignment<>Value then
   begin
      FAlignment:=Value;
      Invalidate;
   end;
end;
procedure TPanelSel.SetTextAlign(Value: TAlignment);
begin
   if FTextAlign<>Value then
   begin
      FTextAlign:=Value;
      Invalidate;
   end;
end;
procedure TPanelSel.Paint;
const
   AAlignment : array[taLeftJustify..taCenter] of uchar=(DT_LEFT,DT_RIGHT,DT_CENTER);
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:=AAlignment[_BiDiMode(Alignment,BiDiMode)] 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 AAlignment[_BiDiMode(TextAlign,BiDiMode)] 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.