2 replies to this topic

[cram]

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

delphi

{
****************************************************************************************************
 
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.

 

 

 

Imágenes de ejemplo:

 

Este es un programa de ejemplo con regiones en la ventana. El error deben omitir, pues se trata de que no encuentra el alias de la base de datos.

 muestra.7z   1,33MB   10 descargas

 

 

[egostar]

Hola

Me gusta mucho el desarrollo de componentes, ahora mismo estoy intentando hacer uno para firemonkey, pero me parece que es una empresa un poco compleja y aún estoy en pañales, ya veremos si logro sacarlo  .

 

Lo que normalmente hago son objetos de proposito particular y me siento cómodo haciendolos.

 

 

Saludos

[cram]

Hola

Me gusta mucho el desarrollo de componentes, ahora mismo estoy intentando hacer uno para firemonkey, pero me parece que es una empresa un poco compleja y aún estoy en pañales, ya veremos si logro sacarlo  .

 

Lo que normalmente hago son objetos de proposito particular y me siento cómodo haciendolos.

 

 

Saludos

 

Me parece excelente idea.

Te cuento que pasé este componente y la unidad regiones, que menciono, a Lazarus. Tuve un problema con los arreglos dinámicos y pude solucionarlo ggracias a la ayuda de un colega (en un foro que no recuerdo).

Pero, me arriesgo a asegurarte que en Firemonkey con todo lo bueno que tiene para control de la imagen, será superior. Sobre todo teniendo en cuenta los efectos sobre la imagen y las animaciones, que de por sí solas ya superan a un componente como éste.

 

Saludos