Botones destacados
Cada vez que uso los controles que vienen con DELPHI, siento que falta algo, ya sea la forma, el color, etc.
Independientemente del método de transformación, todos son diferentes de los estándares requeridos por su propio proyecto. Consulté algunos libros.
Más tarde, descubrí que los siguientes controles son muy útiles. ! !
Aquí está su código fuente:
unidad DsFancyButton;
interfaz
usos
SysUtils, Windows, Mensajes, Clases, Gráficos, Controles, Formularios;
tipo
TTextStyle = (txNone, txLowered, txRaised, txShadowed);
TShape = (shCapsule, shOval, shRectangle, shRoundRect);
TDsFancyButton = clase(TGraphicControl)
Privado
Color del botón F: TColor;
FIsDown: booleano;
FColor del marco: TColor;
FFrameWidth: entero;
FCornerRadius: Entero;
FRgn, MRgn: HRgn;
Forma F: Forma T;
FTextColor: TColor;
FTextStyle: TTextStyle;
procedimiento SetButtonColor(Valor: TColor);
procedimiento CMEnabledChanged (mensaje var: TMessage);
mensaje CM_ENABLEDCHANGED;
procedimiento CMTextChanged (var mensaje: TMessage);
mensaje CM_TEXTCHANGED;
procedimiento CMDialogChar(mensaje var: TCMDialogChar);
mensaje CM_DIALOGCHAR;
procedimiento WMSize(var mensaje: TWMSize mensaje WM_PAINT);
protegido
procedimiento Haga clic; anular;
procedimiento DrawShape;
procedimiento Pintura; anulación;
procedimiento SetFrameColor(Valor: TColor);
procedimiento SetFrameWidth(Valor: Entero);
procedimiento SetCornerRadius(Valor: Entero);
procedimiento SetShape(Valor: TShape);
procedimiento SetTextStyle(Valor: TTextStyle);
procedimiento WMLButtonDown(var Mensaje: mensaje TWMLButtonDown);
WM_LBUTTONDOWN;
procedimiento WMLButtonUp(var Mensaje: mensaje TWMLButtonUp);
WM_LBUTTONUP;
procedimiento WriteCaption;
público
constructor Create(Aowner: TComponent anulación);
destructor Destruir; anular;
publicado
propiedad ButtonColor: TColor
leer FButtonColor escribir SetButtonColor;
título de propiedad;
propiedad ArrastrarCursor;
propiedad ModoArrastrar;
propiedad Habilitada;
propiedad Fuente;
propiedad FrameColor: TColor
leer FRameColor escribir SetFrameColor;
propiedad FrameWidth: Entero
leer FFrameWidth escribir SetFrameWidth;
propiedad ParentFont;
propiedad ParentShowHint;
propiedad PopupMenu;
propiedad CornerRadius: Entero
leer FCornerRadius escribir SetCornerRadius;
propiedad Forma: TShape
leer FShape escribir SetShape predeterminado shRoundRect;
propiedad ShowHint;
propiedad TextStyle: TTextStyle
leer FTextStyle escribir SetTExtStyle;
propiedad visible;
propiedad OnClick; propiedad OnDragDrop;
propiedad OnDragOver; propiedad OnEndDrag;
propiedad OnMouseDown; propiedad OnMouseUp;
PropiedadOnMouseMove;
fin;
Registro de trámites;
implementación
constructor TDsFancyButton.Create(AOwner: TComponent);
comenzar
heredadoCrear(Unpropietario);
ControlStyle := [csClickEvents, csCaptureMouse, CSSetCaption];
Habilitado := Verdadero;
FButtonColor := clBtnFace;
FIsDown := Falso;
FFrameColor := clGray;
FFrameWidth: = 6;
FCornerRadius := 10;
FRgn := 0;
FormaF := shRoundRect;
FTextStyle := txRaised;
Altura: = 25;
Visible := Verdadero;
Ancho := 97;
fin;
destructor TDsFancyButton.Destroy;
comenzar
EliminarObjeto(FRgn);
EliminarObjeto(MRgn);
heredado Destruir;
fin;
procedimiento TDsFancyButton.Paint;
var Dia: entero;
Limpiar arriba, Limpiar abajo: TColor;
comenzar
Canvas.Brush.Style := bsClear;
si FI está abajo entonces
comenzar ClrUp:= clBtnShadow; ClrDown:= clBtnHighlight;
demás
comenzar ClrUp:= clBtnHighlight; ClrDown:= clBtnShadow;
con lienzo hacer
comenzar
caso Forma de
shRoundRect:
comenzar
Diámetro := 2*Radio de esquina;
Mrgn := CreateRoundRectRgn(0, 0, Ancho, Alto, Diámetro,
Día);
fin;
shCápsula:
comenzar
si Ancho < Alto entonces Dia := Ancho else Dia :=
Altura;
Mrgn := CreateRoundRectRgn(0, 0, Ancho, Alto, Diámetro,
Día);
fin;
shRectangle: MRgn := CreateRectRgn(0, 0, Ancho - 1, Alto
- 1);
shOval: MRgn := CreateEllipticRgn(0, 0, Ancho, Alto);
fin;//caso
Lienzo.Brush.Color := FButtonColor;
FillRgn(Mango, MRgn, Pincel.Mango);
Pincel.Color :=ClrUp;
FrameRgn(Mango, MRgn, Pincel.Mango, 1,1);
CompensaciónRgn(MRgn, 1, 1);
Pincel.Color := ClrDown;
FrameRgn(Mango, MRgn, Pincel.Mango, 1, 1);
fin;//lienzo
Dibujar forma;
Escribir título;
fin;
procedimiento TDsFancyButton.DrawShape;
var
FC, Warna: TColor;
R, G, B: byte;
AwalR, AwalG, AwalB, AkhirR, AkhirG, AkhirB, n, t, Dia: Entero;
comenzar
si FFrameWidth mod 2=0 entonces t:= FFrameWidth
más t := FFrameWidth + 1;
Advertencia := ColorToRGB(ButtonColor);
FC := ColorToRGB(ColorDeMarco);
Lienzo.Brush.Color := Warna;
AwalR := ObtenerRValue(FC); AkhirR := ObtenerRValue(Warna);
AwalG := ObtenerGValue(FC); AkhirG := ObtenerGValue(Warna);
AwalB := ObtenerBValue(FC); AkhirB := ObtenerBValue(Warna);
FRgn := 0;
con lienzo hacer
para n := 0 a t - 1 hacer
comenzar
R := AwalR + Trunc(Sqrt(t*t - Sqr(tn))*(AkhirR - AwalR)/t);
G := AwalG + Trunc(Sqrt(t*t - Sqr(tn))*(AkhirG - AwalG)/t);
B := AwalB + Trunc(Sqrt(t*t - Sqr(tn))*(AkhirB - AwalB)/t);
Pincel.Color := RGB(R, G, B);
Forma del caso de
shOval: FRgn := CreateEllipticRgn(1 + n, 1 + n, Ancho - n,
Altura - n);
shRoundRect:
comenzar
Diámetro := Radio de esquina;
si (Dia - n) >0 entonces
FRgn :=
CreateRoundRectRgn(1 + n, 1 + n, Ancho - n, Alto -
n, 2*(Diámetro - n), 2*(Diámetro - n))
else FRgn := CreateRectRgn( 1 + n, 1 + n, Ancho - n - 1,
Altura - n - 1);
fin;
shCápsula:
comenzar
si Ancho < Alto entonces Dia := Ancho div 2 else Dia :=
División de altura 2;
si (Dia - n) > 0 entonces
FRgn:=
CreateRoundRectRgn(1 + n, 1 + n, Ancho - n,
Altura - n, 2*(Diámetro - n), 2*(Diámetro - n))
else FRgn := CreateRectRgn(1 + n, 1 + n ,Ancho - n -
1, Altura - n - 1);
fin;
else FRgn := CreateRectRgn(1 + n, 1 + n, Ancho - n - 1,
Altura - n - 1);
fin;//caso
FrameRgn(Mango, FRgn, Pincel.Mango, 1, 1);
fin;
fin;
procedimiento TDsFancyButton.WriteCaption;
var
Banderas: Palabra;
BtnL, BtnT, BtnR, BtnB: Entero;
R, TR: TRect;
comenzar
R := ClienteRect; TR := ClienteRect;
Canvas.Font := Self.Font;
Canvas.Brush.Style := bsClear;
Banderas:= DT_CENTER o DT_SINGLELINE;
Lienzo.Fuente := Fuente;
si FIsDown entonces FTextColor: = FrameColor
else FTextColor := Self.Font.Color;
con lienzo hacer
comenzar
BtnT := (Altura - Altura del texto (título)) div 2;
BtnB := BtnT + TextHeight(Título);
BtnL := (Ancho - TextWidth(Caption)) div 2;
BtnR := BtnL + TextWidth(Caption);
TR := Rect(BtnL, BtnT, BtnR, BtnB);
R := TR;
si ((TextStyle = txLowered) y FIsDown) o
((TextStyle = txRaised) y no FIsDown) entonces
comenzar
Fuente.Color := clBtnHighLight;
DesplazamientoRect(TR, -1 + 1, -1 + 1);
DrawText(Mango, PChar(Título), Longitud(Título), TR,
Banderas);
fin
de lo contrario si ((TextStyle = txLowered) y no FIsDown) o
((TextStyle = txRaised) y FIsDown) entonces
comenzar
Fuente.Color := clBtnHighLight;
DesplazamientoRect(TR, + 2, + 2);
DrawText(Mango, PChar(Título), Longitud(Título), TR,
Banderas);
fin
de lo contrario, si (TextStyle = txShadowed) y FIsDown, entonces
comenzar
Fuente.Color := clBtnShadow;
DesplazamientoREct(TR, 3 + 1, 3 + 1);
DrawText (mango, PChar (título),
Longitud (título), TR, banderas);
fin
de lo contrario si (TextStyle = txShadowed) y no FIsDown
entonces
comenzar
Fuente.Color := clBtnShadow;
DesplazamientoRect(TR, 2 + 1, 2 + 1);
DrawText (mango, PChar (título),
Longitud (título), TR, banderas);
fin;
si está habilitado, entonces Font.Color := FTextColor//self.Font.Color
de lo contrario, si (TextStyle = txShadowed) y no está habilitado, entonces
Fuente.Color := clBtnFace
más Fuente.Color := clBtnShadow;
si FIsDown entonces OffsetRect(R, 1, 1)
de lo contrario OffsetRect(R, -1, -1);
DrawText(Mango, PChar(Título), Longitud(Título), R, Banderas);
fin;
fin;
procedimiento TDsFancyButton.SetButtonColor(valor: TColor);
comenzar
si valor <> FButtonColor entonces
comenzar FButtonColor: = valor; finalizar;
fin;
procedimiento TDsFancyButton.WMLButtonDown(var mensaje:
TWMLButtonDown);
comenzar
si no es PtInRegion(MRgn, message.xPos, message.yPos), salga;
FIsDown := Verdadero;
Pintar;
heredado;
fin;
procedimiento TDsFancyButton.WMLButtonUp (mensaje var: TWMLButtonUp);
comenzar
si no es FIsDown, entonces salga;
FIsDown := Falso;
pintar;
heredado;
fin;
procedimiento TDsFancyButton.SetShape(valor: TShape);
comenzar
si valor <> FShape entonces
comenzar FShape: = valor; invalidar;
fin;
procedimiento TDsFancyButton.SetTextStyle(valor: TTextStyle);
comenzar
si valor<>FTextStyle entonces
comenzar FTextStyle: = valor; invalidar;
fin;
procedimiento TDsFancyButton.SetFrameColor(valor: TColor);
comenzar
si Valor<>FFrameColor entonces
comenzar FFrameColor: = Valor; finalizar;
fin;
procedimiento TDsFancyButton.SetFrameWidth(Valor: entero);
var
w: número entero;
comenzar
si Ancho<alto entonces w := Ancho else w := Alto;
si Valor<>FFrameWidth entonces FFrameWidth := valor;
si FFrameWidth < 4 entonces FFrameWidth := 4;
si FFrameWidth >(w div 2) entonces FFrameWidth := (w div 2);
Invalidar;
fin;
procedimiento TDsFancyButton.SetCornerRadius(Valor: entero);
var
w: número entero;
comenzar
si Ancho<Alto entonces w := Ancho else w := Alto;
si valor<>FCornerRadius entonces FCornerRadius := valor;
si FCornerRadius<3 entonces FCornerRadius := 3;
si FCornerRadius>w entonces FCornerRadius := w;
Invalidar;
fin;
procedimiento TDsFancyButton.CMEnabledChanged (mensaje var: Tmessage);
comenzar
heredado;
invalidar;
fin;
procedimiento TDsFancyButton.CMTextChanged (var mensaje: TMessage);
comenzar
Invalidar;
fin;
procedimiento TDsFancyButton.CMDialogChar(var mensaje:TCMDialogChar);
comenzar
Con mensaje hacer
si IsAccel (CharCode, Caption) y está habilitado, entonces
comenzar Haga clic; Resultado := 1 ;finalizar
demás heredado;
fin;
procedimiento TDsFancyButton.WMSize(var Mensaje: TWMSize);
comenzar
heredado;
si ancho>300 entonces ancho:= 300;
si Altura>300 entonces Altura:= 300;
fin;
procedimiento TDsFancyButton.Click;
comenzar
FIsDown := Falso;
Invalidar;
clic heredado;
fin;
Registro de trámites;
comenzar
RegisterComponents('COMPONENTE WYM',[TDsFancyButton]);
fin;
fin.
Geng Baiqiang.