 |
 |
Código en Delphi 6, válido para Delphi for win32 y CodeGear RAD Studio (Delphi win32) | ||||||||||||
|
||||||||||||||
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.