Código en Delphi 6, válido para Delphi for win32 y CodeGear RAD Studio (Delphi win32) | ||
Vamos a hacer que nuestro componente una vez en el form (con lo que pasará a ser un control) cambie de color cuando se sitúe sobre él el ratón o cuando tenga el foco, es decir, tendremos tres estados posibles: Normal, Enfocado y con el Cursor del ratón sobre el control. Definiremos 2 colores por cada estado uno para el borde y otro para el fondo del control, es decir tendremos que guardar en el componente 6 colores para lograr lo que queremos hacer. Las propiedades vamos a llamarlas : Color, BorderColor para el estado normal, FocusedColor, FocusedBorderColor cuando tiene el foco y OverColor, OverBorderColor cuando tiene situado el ratón sobre él.
Es decir deberemos tener 6 variables que guarden estos valores de propiedades. Por otra parte cuando cambie el valor de estas propiedades (por ejemplo en el inspector de objetos cambiamos cualquiera de ellos), se deberá reflejar de forma automática en la ventana, como ya hemos dicho en múltiples ocasiones para que esto ocurra deberemos escribir un procedimiento SetPropiedad(Value) para cada propiedad. Pero en este caso observamos una cosa, por una parte queremos mantener todas las propiedades de color mencionadas anteriormente pero por otra parte vemos que el tratamiento para cada una de ellas es el mismo :
Procedure SetPropiedad(Value:TColor) begin if value<>propiedad then begin propiedad:=value; invalidate; end; end;
¿Qué hacer para no duplicar código? La solución es crear un array de tipo TColor para guardar los 6 colores, y asignar a cada una de las filas del array una de las propiedades. Por otra parte podemos crear, a mayores, otra propiedad denominada Colors que será el reflejo del array.
private FColors:array[0..5] of TColor; ... ... procedure SetColors(Index:Integer;Value:TColor);
function GetColors(Index:integer):TColor; ... ... public ... property Colors[Index:Integer]:TColor read GetColors Write SetColors; plublished ... 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; ...
En el código anterior hay varias cosas que observar:
1.- Guardamos los colores dentro de la variable FColors.
2.- La propiedad Colors la situamos en el apartado Public y no en el Published.
Esto se debe a que el inspector de objetos no permite arrays como propiedades.
3.- Asignamos un índice a cada color. De esta manera nos ahorramos
procedimientos distintos para el mismo tratamiento de los datos.
4.- No sólo escribimos un procedimiento SetPropiedad, sino que además
debemos escribir una función que nos devuelva el color. Si los
procedimientos que escriben se les pasa como parámetro un valor
del tipo de la variable, la función debe devolver un valor del
mismo tipo que la variable. En este caso en el que utilizamos un array
para distintas propiedades, además del parámetro normal,
se le pasa un índice que es el que aparece en la definición
de la propiedad:
constructor TSelPanel.Create(AOwner:TComponent);Como veis el tratamiento no hace referencia más que al array y a través del índice asociado a cada propiedad se sabe que color estamos cambiando o leyendo.
begin
... ... FColors[0]:= clBtnFace; FColors[1]:=clBlack; FColors[2]:=clBtnHighlight; FColors[3]:=clBlack; FColors[4]:= clBtnShadow; FColors[5]:=clBlack; ... ... end; procedure TSelPanel.SetColors(Index:Integer;Value:TColor); begin if FColors[Index]<>Value then begin FColors[Index]:=Value; Invalidate; end; end; Function TSelPanel.GetColors(Index:Integer):TColor; begin Result:=FColors[Index]; end;
Figura 4
El código completo del componente hasta ahora es :
unit PanelSel; interface uses Windows, Messages, SysUtils, Classes, Controls, Graphics; type TPanelSel = class(TCustomControl) private FColors:array[0..5] of TColor; FBorder:Boolean; FBorderWidth:Integer; FOver:Boolean; procedure SetColors(Index:Integer;Value:TColor); function GetColors(Index:integer):TColor; procedure SetBorder(Value:Boolean); procedure SetBorderWidth(Value:integer); { 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 Paint; override; procedure Click;override; { Protected declarations } public constructor Create(AOwner:TComponent);override; property Colors[Index:Integer]:TColor read GetColors Write SetColors; { Public declarations } published 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 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; 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.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; begin 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 focused then TextOut(0,0,'FOCUS'); if Border then Rectangle(X, Y, X + W, Y + H); if FOver then TextOut(0,TextHeight('FOCUS')+2,'OVER'); end; end; procedure Register; begin RegisterComponents('Ejemplo', [TPanelSel]); end; end.
En el próximo artículo veremos como guardar en el componente una imagen y como dibujarla, así como la escritura de texto dentro del componente.