Visibilidad de propiedades, métodos y eventos.

Como se ha comentado anteriormente la herencia permite que mucha de la funcionalidad de nuestros nuevos componentes esté ya construida. Hemos visto, por ejemplo, el caso de Caption, Font o TabStop como casos de propiedades que ya estaban definidas y que nosotros sólo hemos tenido que cambiar la visibilidad (published). Pues lo mismo ocurre con otras muchas propiedades y que nos pueden resultar interesantes para nuestro componente, por ejemplo, no tenemos ninguna propiedad para habilitar/inhabilitar los controles creados con nuestro componente, tampoco tenemos una que haga que desaparezca de pantalla así que vamos a cambiar la visibilidad del siguiente grupo de propiedades (conviene que se vean los distintos ancestros de nuestro componente para ver las propiedades, métodos y eventos ya definidos):

published
     ...
     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;

Alguna de ellas para que nos sean útiles debemos utilizarlas en el código de nuestro componente (BiDiMode) ya que sólo informan y no ejecutan ninguna acción, en cambio otras tienen un efecto inmediato al cambiarlas de valor (Visible).

Esto mismo ocurre con los eventos que pudieran estar definidos en alguno de los antecesores de nuestro componente (OnClick,OnKeyPress...) :

Published
     ...
     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;

Al igual que hemos podido crear nuevas propiedades, podemos crear métodos y eventos. Los métodos van a ejecutar acciones (normalmente sobre el objeto, por ejemplo R:=PanelSel1.ClientRect) estos se definen como procedures o functions en el componente. Por otra parte los eventos, son sucesos provocados por alguna causa y a los que se puede asignar algo a hacer cuando ocurren, por ejemplo podemos querer que cuando se pulse sobre el control (OnClick) se abra una ventana con un mensaje.

Un ejemplo de creación de un método podría ser uno al que se le pase una cadena de caracteres y con ella asigne las propiedades caption y text de nuestro control, para ello dentro de la cadena el caption se consideraría, por ejemplo, hasta el primer carácter '|' :

public
   ...
   Procedure SetAllTexts(S:String);
   ...
...
implementation
...
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;
...

Para definir eventos se hace de manera parecida a como se definen propiedades, de hecho para delphi son propiedades pero las variables sobre las que actúan estas propiedades son de un tipo especial denominado procedimiento de objeto :

Tipo:=procedure(...) of Object;

En nuestro componente aprovechando que tenemos que controlar la entrada y salida del ratón sobre nuestro componente, vamos a definir dos eventos nuevos : OnMouseEnter y OnMouseLeave. Como hemos dicho debemos definir dos variables que vamos a denominar igual que los eventos pero precedidas por la letra 'F' (para seguir el método utilizado por delphi) con lo que las variables se llamarán FOnMouseEnter y FOnMouseLeave, por otra parte lo único que nos interesa es que se se produzca el evento al entrar y salir el cursor del ratón sobre nuestro componente, por lo que no necesitamos pasar información al programador que vaya a utilizar nuestro componente, bueno como mínimo conviene pasar un parámetro Sender (como hace por ejemplo OnCLick) que sea una referencia al objeto, luego el nuevo tipo 'especial' a definir será :

Types
   TMouseEnterLeaveEvent=procedure(Sender:TObject) of Object;

Ahora nuestras variables serán de este nuevo tipo :

FOnMouseEnter, FOnMouseLeave:TMouseEnterLeaveEvent; 

En párrafo anterior hemos dicho que el evento OnClick sólo envía como parámetro Sender como en nuestro caso, por lo que en vez de definir un tipo nuevo (que se puede definir y funcionará correctamente) podemos utilizar el mismo tipo que utiliza OnClick este tipo en delphi se llama TNotiFyEvent entonces :

  private
     ...
     FOnMouseEnter,
     FOnMouseLeave:TNotifyEvent;
     ...
     ...
  published
     ...
     property OnMouseEnter:TNotifyEvent read FOnMouseEnter Write FOnMouseEnter;
     property OnMouseLeave:TNotifyEvent read FOnMouseLeave Write FOnMouseLeave;
     ...

Como vemos se definen como cualquier otra propiedad (que leen y escriben las variables declaradas anteriormente).

Con esto hemos conseguido que el inspector de objetos tenga una referencia de dónde leer y guardar el código que los programadores que utilicen nuestro componente escriban, pero ¿cómo hacer que éste se ejecute cuando se produzca el evento?, pues observe los cambios en el código de nuestro componente :

...
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;
...

Sencillo, ¿no?, simplemente comprobamos que la variable(que es un puntero a un procedimiento) tenga asignado algún valor y si es así se llama al procedimiento con el parámetro que estera, en este caso él mismo.

El código completo es hasta aquí :

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;
    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;
    Procedure SetAllTexts(S:String);
    { 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;
     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;

procedure Register;

implementation
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];
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.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.