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

'Clavos'. Propiedad Bitmap

Anteriormente dijimos que íbamos a utilizar dos tipos de objetos de imagen, TPicture ya utilizado y uno TBitmap. Éste último lo utilizaremos para dibujar 4 clavos alrededor del control cuando éste tiene el foco (que se muestren estos 'clavos' va a ser opcional dependiendo de otra propiedad). Por lo tanto definiremos dos propiedades Screw y ShowScrew, la primera será el bitmap que queremos utilizar como 'clavo' y la segunda si queremos mostrarlos o no.

Los pasos a seguir con los de siempre, definir dos variables en la parte 'Private' de nuestro componente, definir las propiedades basadas 'manejadoras' de las variables anteriores. En el constructor crearemos el objeto imagen, que destruiremos en el destructor.

Pero queremos algo más, por defecto y en el caso de que no se elija ninguna imagen como 'clavo' haremos que aparezca uno por defecto (sólo si ShowCrew es true, claro). Para conseguir esto, vanos a crear un archivo de tipo recurso(.res) que añadiremos en nuestro componente, para ello utilizaremos ImageEdit, que es una herramienta que se encuentra en directorio Bin de delphi : "C:\Archivos de programa\Borland\Delphi6\Bin\imagedit.exe" :

Al fichero los llamaremos "panselre.res" y lo guardaremos en el mismo directorio que el código de nuestro componente. Después creamos el bitmap (de 8x8) en este fichero de recursos, al bitmap le pondremos de nombre 'CLAVO':

Ahora, para que al compilar se incluya el recurso dentro del código compilado, habrá que añadir la directiva : {$R panresel}

para cargar un recurso de bitmap dentro de un objeto usaremos el método de la Clase TBitmap : LoadFromResourceName (FScrew.LoadFromResourceName(Hinstance,'CLAVO');).

(El código completo del componente después del siguiente apartado)

Icono para la paleta de componentes.

Una vez completado el componente (o si se prefiere en cualquier momento de la creación del mismo) deberíamos dibujar un icono que represente a nuestro componente en la paleta de componentes de delphi :


Figura 11- Paleta de componentes

Nosotros cuando en la definición de nuestro componente escribimos en el procedimiento Register el siguiente código :

RegisterComponents('Ejemplo', [TPanelSel]);

estamos diciendo al entorno de Delphi que añada nuestro componente a la carpetilla (pestaña) 'Ejemplo' de la paleta de componentes, en caso de no existir, el entorno (IDE) de delphi creará una con dicho nombre y dentro de ella aparecerá un icono como representación de nuestro componente :


Figura 12 - Componente PanelSel

El icono mostrado es que que el IDE de delphi asigna por defecto cuando no le hemos indicado otro.

Para crear uno propio debemos seguir los siguientes pasos :

1.- Mediante ImageEdit debéis crear un archivo nuevo de tipo .dcr (Component Resource File) que debe llamarse igual que la unidad de nuestro componente (PanelSel.dcr), y dentro de este fichero crear un recurso Bitmap de 24x24 pixels y cuyo nombre debe ser el del tipo de nuestro componente en mayúsculas : TPANELSEL :

  
Figuras 13,14,15

Edite el bitmap y haga el dibujo que crea que mejor representa al componente, guarde el archivo en el mismo directorio que nuestro componente. Para que el IDE acepte esto cambios debemos añadir al paquete dentro del cual definimos nuestro componente (figura 1), para ello lo mejor es que eliminemos nuestro componente del paquete y después volvamos a añadirlo, con esto conseguimos que los ficheros PanelSel.pas y PanelSel.dcr se incorporen al paquete, después compilar y 'voilá' en la pestaña ejemplo aparecerá nuestro bitmap :


Figura 16

Código Completo.

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;
    FScrew:TBitmap;
    FShowScrew:Boolean;
    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);
    procedure SetScrew(Value:TBitmap);
    { 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 Screw:TBitmap read FScrew Write SetScrew;
     property ShowScrew:Boolean read FShowScrew Write FShowScrew default false;
     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
{$R panselre}
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;
   FScrew:=TBitmap.Create;
   FScrew.LoadFromResourceName(Hinstance,'CLAVO');
   FShowScrew:=False;
   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.SetScrew(Value:TBitmap);
begin
   if Assigned(Value) then
   begin
      if (Value.Width>8) or (Value.Height>8) then
         raise Exception.Create('La imagen debe ser como máximo de 8x8 pixels')
      else
         FScrew.Assign(Value);
   end
   else
      FScrew.LoadFromResourceName(Hinstance,'CLAVO');
   Invalidate;
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);
      if Focused and ShowScrew then
      begin
         FScrew.Transparent:=True;
         FScrew.TransparentMode:=tmAuto;
         Draw(desph+2,desph+2,FScrew);
         Draw(Width-desph-2-FScrew.Width,desph+2,FScrew);
         Draw(desph+2,Height-desph-2-FScrew.Height,FScrew);
         Draw(Width-desph-2-FScrew.Width,Height-desph-2-FScrew.Height,FScrew);
      end;
   end;
end;
procedure Register;
begin
  RegisterComponents('Ejemplo', [TPanelSel]);
end;

end.