Hace mucho que quiero compartir este componente. Pero lamentablemente por falta de tiempo no pude dejarlo en una forma aislada y depende en gran parte de una unidad llamada regiones.
Actualmente la pasé en el hilo iniciado por Escafandra, pero dado que sigue un camino algo diferente, creo correcto publicarlo aparte.
Este es el código del componente, al cual le quité de la lista de uses a la unidad regiones y lo modifiqué un poquito para que solo tome dos tipos de forma.
El componente desciende de TCustomControl y se trata de un botón con cuatro estados posible:
1. Normal
2. Enfocado (hover, cuando el puntero del ratón pasa por encima o se queda encima de él)
3. Pulsado (cuando el botón recibe el evento Click
4. Deshabilitado (grisado, cuando el botón omite los eventos del ratón).
El bitmap se arma siguiendo el sentido izquierda - derecha en el orden especificado en la lista y una imagen seguida de otra.
Se sobreentiende que el tamaño del coontrol en pantalla es la cuarta parte del ancho y la altura es la misma respecto de las dimensiones del bitmap.
Es probable que al quitarle, partes el componente no funcione a la primera así que si alguien está interesado, me avisa.
Espero les sirva
Ah... el nombre CRamButton, pueden cambiarlo fácilmente usando el editor, buscan CRaM y le reemplazan por cualquier otro nombre.
Saludos
{ **************************************************************************************************** COMPONENTE CRAM BUTTON versión 1.4 Programador: Carlos Micolis Empresa: CRaM Fecha: Posadas, Misiones, RA; mayo 2003 CRaM Button es un botón que responde a tres acciones de ratón, no responde a teclado. Cambia la ubicación de la imagen principal a segundo estado, cuando el usuario mueve el puntero de ratón sobre el control y pasa al tercer estado, cuando el usuario mantiene pulsado el botón principal del ratón. Se puede asociar varios estados al mismo control y leerlo desde la propiedad estado, de acuerdo al estado se despliega el aspecto del botón. La imagen que constituye los estados del control se pueden ver como una matriz de 4 columnas por n filas, donde n es la cantidad de estados que se puede asignar al control. **************************************************************************************************** } unit CRaMButton; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type TCRaMButton = class(TCustomControl) private FBitmap: TBitmap; // Bitmap que contiene la gráfica del botón FContorno: String; // Nombre del archivo de contorno del objeto *.msk FSoundHoverFile: String; // Nombre del archivo de sonido para MouseHover FSoundDownFile: String; // Nombre del archivo de sonido para MouseDown FForma: Byte; // FForma 0: Rectangular, 1: Rectangular redondeada, // 2: Elíptica, 3: Desde máscara FRoundH, FRoundV: Byte; // Redondeo Horizontal y Vertical RG: HRgn; // Región del botón FEstadosExtra: Byte; // Indica la cantidad de estados FEstado: Byte; // Indica el estado del botón // Variables auxiliares utilizadas para controlar el comportamiento del control Enfocado, AntEnfocado, Pulsado: Boolean; protected procedure Paint; override; procedure CMMouseLeave(var Msg:TMessage); message CM_MouseLeave; procedure CMMouseEnter(var Msg:TMessage); message CM_MouseEnter; procedure MouseDown(Button:TMouseButton; Shift:TShiftState; X, Y:Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; public constructor Create(AOwner: TComponent); override; procedure GetBitmap(Value:TBitmap); procedure GetForma(Value:byte); procedure GetRoundX(Value:byte); procedure GetRoundY(Value:byte); procedure GetContorno(Value: String); procedure GetEstadosExtra(value:byte); procedure GetEstado(Value:byte); destructor Destroy; override; published property Bitmap: TBitmap read FBitmap write GetBitmap; property Mask: String read FContorno write GetContorno; property SoundHoverFile: string read FSoundHoverFile write FSoundHoverFile; property SoundDownFile: string read FSoundDownFile write FSoundDownFile; property TipoRegion: Byte read FForma write GetForma; property RoundX: Byte read FRoundH write GetRoundX; property RoundY: Byte read FRoundV write GetRoundY; property Enabled; property EstadosExtra: Byte read FEstadosExtra write GetEstadosExtra default 0; property Estado: Byte read FEstado write GetEstado; property OnClick; property OnMouseMove; property OnDblClick; property OnMouseDown; property OnMouseUp; property Visible; end; procedure Register; // ************************************************************************************************ // Comienzo del área de implemetación // ************************************************************************************************ implementation uses MMSystem; // ------------------------------------------------------------------------------------------------- // Constructor del objeto, los valores son inicializados constructor TCRaMButton.Create; begin inherited Create(AOwner); Width:=90; Height:=25; FBitmap:=TBitmap.Create; FForma:=0; FRoundH:=0; FRoundV:=0; Enfocado:=False; AntEnfocado:=True; Pulsado:=False; end; // ------------------------------------------------------------------------------------------------- procedure TCRaMButton.GetBitmap; begin FBitmap.Assign(Value); Repaint; end; // ------------------------------------------------------------------------------------------------- // Toma la región del control de acuerdo con el valor de FForma procedure TCRaMButton.GetForma; begin if Value <> FForma then begin FForma:=Value; case FForma of 0: RG:=CreateRectRgn(0, 0, Width, Height); 1: RG:=CreateRoundRectRgn(0, 0, Width, Height, FRoundH, FRoundV); 2: RG:=CreateEllipticRgn(0, 0, Width, Height); end; if FForma < 3 then SetWindowRgn(Handle, RG, True); Repaint; end; end; // ------------------------------------------------------------------------------------------------- // Redondez horizontal procedure TCRaMButton.GetRoundX; begin if Value <> FRoundH then begin FRoundH:=Value; if FForma = 1 then begin RG:=CreateRoundRectRgn(0, 0, Width, Height, FRoundH, FRoundV); SetWindowRgn(Handle, RG, True); Repaint; end; end; end; // ------------------------------------------------------------------------------------------------- // Redondez vertical procedure TCRaMButton.GetRoundY; begin if Value <> FRoundV then begin FRoundV:=Value; if FForma = 1 then begin RG:=CreateRoundRectRgn(0, 0, Width, Height, FRoundH, FRoundV); SetWindowRgn(Handle, RG, True); Repaint; end; end; end; // ------------------------------------------------------------------------------------------------- procedure TCRaMButton.GetEstadosExtra; begin if Value <> FEstadosExtra then begin FEstadosExtra:=Value; Repaint; end; end; // ------------------------------------------------------------------------------------------------- procedure TCRaMButton.GetEstado; begin if (Value <> FEstado) then begin FEstado:=Value; Repaint; end; end; // ------------------------------------------------------------------------------------------------- // El método Paint es llamado cada vez que uno de los métodos llama a Repaint o bien cuando Windows // lo haga. Este método es responsable de mostrar los estados de la imagen pricipal asociada al // control de acuerdo con el estado del ratón sobre el mismo. // La imagen principal está dividida en tres partes. // 1. Estado neutro. 2. Estado Enfocado y 3. Estado Pulsado. // Este corrimiento de la imagen se realiza mediante el uso de la instrucción CopyRect. procedure TCRaMButton.Paint; begin inherited Paint; // Llama al método Paint del ancestro. if Enabled then // Si habilitado begin if Enfocado then // Si Enfocado if Pulsado // Si pulsado then Canvas.CopyRect(Rect(0, 0, Width, Height),FBitmap.Canvas, Rect(Width*2, Height * FEstado, Width*3, Height * (FEstado + 1))) else Canvas.CopyRect(Rect(0, 0, Width, Height),FBitmap.Canvas, Rect(Width, Height * FEstado, Width*2, Height * (FEstado + 1))) else Canvas.CopyRect(Rect(0, 0, Width, Height),FBitmap.Canvas, Rect(0, Height * FEstado, Width, Height * (FEstado + 1))); end else Canvas.CopyRect(Rect(0, 0, Width, Height),FBitmap.Canvas, Rect(Width*3, Height * FEstado, Width*4, Height * (FEstado + 1))); end; // ------------------------------------------------------------------------------------------------- // Se ejecuta el sonido de presión de botón procedure TCRaMButton.MouseDown; begin if Button=mbLeft then begin Pulsado:=True; sndPlaySound(pchar(FSoundDownFile), snd_Async or snd_NoDefault); Repaint; end; end; // ------------------------------------------------------------------------------------------------- // Si el botón pulsado es el principal (izquierdo) entonces se procede al cambio de estado // consistente en un valor entre 0 y FEstadosExtra. procedure TCRaMButton.MouseUp; begin if Button=mbLeft then begin if FEstado < FEstadosExtra then Inc(FEstado) else FEstado:= 0; Pulsado:= False; Repaint; end; end; // ------------------------------------------------------------------------------------------------- procedure TCRaMButton.CMMouseLeave; begin Enfocado:=False; Repaint; Cursor:= crDefault; end; // ------------------------------------------------------------------------------------------------- procedure TCRaMButton.CMMouseEnter; begin Enfocado:=True; Cursor:= crHandPoint; sndPlaySound(pchar(FSoundHoverFile), snd_Async or snd_NoDefault); Repaint; end; // ------------------------------------------------------------------------------------------------- destructor TCRaMButton.Destroy; begin inherited Destroy; FBitmap.Free; end; // ------------------------------------------------------------------------------------------------- procedure Register; begin RegisterComponents('CRaM', [TCRaMButton]); end; end.