Botões em destaque
Sempre que utilizo os controles que acompanham o DELPHI, sinto que falta alguma coisa, seja a forma, a cor, etc.
Independentemente do método de transformação, todos são diferentes dos padrões exigidos pelo seu próprio projeto. Consultei alguns livros.
Mais tarde, descobri que os seguintes controles são muito úteis! ! !
Aqui está seu código fonte:
unidade DsFancyButton;
interface
usa
SysUtils, Windows, Mensagens, Classes, Gráficos, Controles, Formulários;
tipo
TTextStyle = (txNone, txLowered, txRaised, txShadow);
TShape = (shCapsule, shOval, shRectangle, shRoundRect);
TDsFancyButton = classe(TGraphicControl)
Privado
FButtonColor: TColor;
FIsDown: Booleano;
FFrameColor: TColor;
FFrameWidth: Inteiro;
FCornerRadius: Inteiro;
FRgn, MRgn: HRgn;
FormaF: FormaT;
FTextColor: TColor;
FTextStyle: TTextStyle;
procedimento SetButtonColor(Valor: TColor);
procedimento CMEnabledChanged(var mensagem: TMessage);
mensagem CM_ENABLEDCHANGED;
procedimento CMTextChanged(var mensagem: TMessage);
mensagem CM_TEXTCHANGED;
procedimento CMDialogChar(var mensagem: TCMDialogChar);
mensagem CM_DIALOGCHAR;
procedimento WMSize(var mensagem: mensagem TWMSize WM_PAINT);
protegido
substituição de procedimento Clique;
procedimento DrawShape;
substituição de procedimento;
procedimento SetFrameColor(Valor: TColor);
procedimento SetFrameWidth(Valor: Inteiro);
procedimento SetCornerRadius(Valor: Inteiro);
procedimento SetShape(Valor: TShape);
procedimento SetTextStyle(Valor: TTextStyle);
procedimento WMLButtonDown(var Mensagem: mensagem TWMLButtonDown);
WM_LBUTTONDOWN;
procedimento WMLButtonUp(var Mensagem: mensagem TWMLButtonUp);
WM_LBUTTONUP;
procedimento WriteCaption;
público
construtor Criar (Aowner: substituição de TComponent);
substituição do destruidor;
publicado
propriedade ButtonColor: TColor
leia FButtonColor escreva SetButtonColor;
Legenda da propriedade;
propriedade DragCursor;
propriedade DragMode;
propriedade Habilitada;
propriedade Fonte;
propriedade FrameColor: TColor
leia FFrameColor escreva SetFrameColor;
propriedade FrameWidth: Inteiro
leia FFrameWidth escreva SetFrameWidth;
propriedade ParentFont;
propriedade ParentShowHint;
propriedade PopupMenu;
propriedade CornerRadius: Inteiro
leia FCornerRadius escreva SetCornerRadius;
propriedade Forma: TShape
ler FShape escrever SetShape padrão shRoundRect;
propriedade ShowHint;
propriedade TextStyle: TTextStyle
leia FTextStyle escreva SetTExtStyle;
propriedade Visível;
propriedade OnClick; propriedade OnDragDrop;
propriedade OnDragOver; propriedade OnEndDrag;
propriedade OnMouseDown; propriedade OnMouseUp;
PropertyOnMouseMove;
fim;
Cadastro de procedimento;
implementação
construtor TDsFancyButton.Create(AOwner: TComponent);
começar
herdadoCriar(Aproprietário);
ControlStyle := [csClickEvents, csCaptureMouse, CSSetCaption];
Habilitado := Verdadeiro;
FButtonColor := clBtnFace;
FIsDown := Falso;
FFrameColor := clGray;
FFrameWidth := 6;
FCornerRadius := 10;
FRgn:= 0;
FShape := shRoundRect;
FTextStyle := txRaised;
Altura:= 25;
Visível := Verdadeiro;
Largura:= 97;
fim;
destruidor TDsFancyButton.Destroy;
começar
DeleteObject(FRgn);
DeleteObject(MRgn);
Destruição herdada;
fim;
procedimento TDsFancyButton.Paint;
var Dia: inteiro;
ClrUp, ClrDown: TColor;
começar
Canvas.Brush.Style := bsClear;
se FIsDown então
começar ClrUp := clBtnShadow;
outro
começar ClrUp := clBtnHighlight;
com tela fazer
começar
caso Forma de
shRoundRect:
começar
Diâmetro := 2*CornerRadius;
Mrgn := CreateRoundRectRgn(0, 0, Largura, Altura, Diâmetro,
Diâmetro);
fim;
cápsula:
começar
if Largura <Altura então Dia := Largura else Dia :=
Altura;
Mrgn := CreateRoundRectRgn(0, 0, Largura, Altura, Diâmetro,
Diâmetro);
fim;
shRectangle: MRgn := CreateRectRgn(0, 0, Largura - 1, Altura
-1);
shOval: MRgn := CreateEllipticRgn(0, 0, Largura, Altura);
fim; //caso
Canvas.Brush.Color := FButtonColor;
FillRgn(Alça, MRgn, Pincel.Handle);
Brush.Color :=ClrUp;
FrameRgn(Handle, MRgn, Brush.Handle, 1,1);
OffsetRgn(MRgn, 1, 1);
Brush.Color := ClrDown;
FrameRgn(Handle, MRgn, Brush.Handle, 1, 1);
fim; // tela
Desenhar Forma;
EscreverCaption;
fim;
procedimento TDsFancyButton.DrawShape;
var
FC, Warna: TColor;
R, G, B: Byte;
AwalR, AwalG, AwalB, AkhirR, AkhirG, AkhirB, n, t, Dia: Inteiro;
começar
se FFrameWidth mod 2=0 então t := FFrameWidth
senão t := FFrameWidth + 1;
Atenção := ColorToRGB(ButtonColor);
FC := ColorToRGB(FrameColor);
Canvas.Brush.Color := Warna;
AwalR := GetRValue(FC);
AwalG := GetGValue(FC);
AwalB := GetBValue(FC);
FRgn:= 0;
com tela fazer
para n := 0 a t - 1 faça
começar
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.Cor := RGB(R, G, B);
Formato da caixa de
shOval: FRgn := CreateEllipticRgn(1 + n, 1 + n, Largura - n,
Altura - n);
shRoundRect:
começar
Diâmetro := CornerRadius;
se (Dia - n) >0 então
FRgn :=
CreateRoundRectRgn(1 + n, 1 + n,Largura - n, Altura -
n, 2*(Diâmetro - n), 2*(Diâmetro - n))
senão FRgn := CreateRectRgn( 1 + n, 1 + n, Largura - n - 1,
Altura - n - 1);
fim;
cápsula:
começar
if Largura <Altura então Dia := Largura div 2 else Dia :=
Divisão de altura 2;
se (Dia - n) > 0 então
FRgn:=
CreateRoundRectRgn(1 + n, 1 + n, Largura - n,
Altura - n, 2*(Diâmetro - n), 2*(Diâmetro - n))
senão FRgn := CreateRectRgn(1 + n, 1 + n ,Largura - n -
1, Altura - n - 1);
fim;
senão FRgn := CreateRectRgn(1 + n, 1 + n, Largura - n - 1,
Altura - n - 1);
fim; //caso
FrameRgn(Handle, FRgn, Brush.Handle, 1, 1);
fim;
fim;
procedimento TDsFancyButton.WriteCaption;
var
Bandeiras: Palavra;
BtnL, BtnT, BtnR, BtnB: Inteiro;
R, TR: TRect;
começar
R := ClienteREct; TR := ClienteRect;
Canvas.Font := Self.Font;
Canvas.Brush.Style := bsClear;
Sinalizadores := DT_CENTER ou DT_SINGLELINE;
Canvas.Font := Fonte;
se FIsDown então FTextColor := FrameColor
senão FTextColor := Self.Font.Color;
com tela fazer
começar
BtnT := (Altura - TextHeight (Legenda)) div 2;
BtnB := BtnT + TextHeight(Legenda);
BtnL := (Largura - TextWidth(Caption)) div 2;
BtnR := BtnL + TextWidth(Legenda);
TR := Rect(BtnL, BtnT, BtnR, BtnB);
R:= TR;
if ((TextStyle = txLowered) e FIsDown ) ou
((TextStyle = txRaised) e não FIsDown) então
começar
Font.Color := clBtnHighLight;
OffsetRect(TR, -1 + 1, -1 + 1);
DrawText(Handle, PChar(Legenda), Comprimento(Legenda), TR,
Bandeiras);
fim
senão if ((TextStyle = txLowered) e não FIsDown) ou
((TextStyle = txRaised) e FIsDown) então
começar
Font.Color := clBtnHighLight;
OffsetRect(TR, + 2, + 2);
DrawText(Handle, PChar(Legenda), Comprimento(Legenda), TR,
Bandeiras);
fim
senão if (TextStyle = txShadowed) e FIsDown então
começar
Font.Color := clBtnShadow;
DeslocamentoREct(TR, 3 + 1, 3 + 1);
DrawText(Handle, PChar(Legenda),
Comprimento (Legenda), TR, Bandeiras);
fim
senão if (TextStyle = txShadowed) e não FIsDown
então
começar
Font.Color := clBtnShadow;
OffsetRect(TR, 2 + 1, 2 + 1);
DrawText(Handle, PChar(Legenda),
Comprimento(Legenda), TR, Bandeiras);
fim;
se ativado, então Font.Color := FTextColor // self.Font.Color
senão if (TextStyle = txShadowed) e não ativado então
Fonte.Color := clBtnFace
senão Font.Color := clBtnShadow;
se FIsDown então OffsetRect(R, 1, 1)
senão OffsetRect(R, -1, -1);
DrawText(Handle, PChar(Legenda), Comprimento(Legenda), R, Flags);
fim;
fim;
procedimento TDsFancyButton.SetButtonColor(valor: TColor);
começar
se valor <> FButtonColor então
começar FButtonColor := valor Invalidar;
fim;
procedimento TDsFancyButton.WMLButtonDown(var mensagem:
TWMLButtonDown);
começar
se não for PtInRegion(MRgn, message.xPos, message.yPos) então Sair;
FIsDown := Verdadeiro;
Pintar;
herdado;
fim;
procedimento TDsFancyButton.WMLButtonUp(var mensagem: TWMLButtonUp);
começar
se não for FIsDown, então saia;
FIsDown := Falso;
pintar;
herdado;
fim;
procedimento TDsFancyButton.SetShape(valor: TShape);
começar
se valor <> FShape então
início FShape := valor Invalidar;
fim;
procedimento TDsFancyButton.SetTextStyle(valor: TTextStyle);
começar
se valor<>FTextStyle então
começar FTextStyle := valor Invalidar;
fim;
procedimento TDsFancyButton.SetFrameColor(valor: TColor);
começar
se Valor<>FFrameColor então
começar FFrameColor := Valor Invalidar;fim;
fim;
procedimento TDsFancyButton.SetFrameWidth(Valor: Inteiro);
var
w: inteiro;
começar
if Largura<altura então w := Largura senão w := Altura;
se Valor<>FFrameWidth então FFrameWidth := valor;
se FFrameWidth < 4 então FFrameWidth := 4;
se FFrameWidth >(w div 2) então FFrameWidth := (w div 2);
Invalidar;
fim;
procedimento TDsFancyButton.SetCornerRadius(Valor: inteiro);
var
w: inteiro;
começar
if Largura<Altura então w := Largura senão w := Altura;
se valor<>FCornerRadius então FCornerRadius := valor;
se FCornerRadius<3 então FCornerRadius := 3;
se FCornerRadius>w então FCornerRadius := w;
Invalidar;
fim;
procedimento TDsFancyButton.CMEnabledChanged(var mensagem: Tmessage);
começar
herdado;
invalidar;
fim;
procedimento TDsFancyButton.CMTextChanged(var mensagem: TMessage);
começar
Invalidar;
fim;
procedimento TDsFancyButton.CMDialogChar(var mensagem:TCMDialogChar);
começar
Com mensagem faça
se IsAccel (CharCode, Caption) e Enabled então
começar Clique Resultado := 1 ;fim
caso contrário, herdado;
fim;
procedimento TDsFancyButton.WMSize(var Mensagem: TWMSize);
começar
herdado;
se largura> 300 então largura := 300;
se Altura>300 então Altura := 300;
fim;
procedimento TDsFancyButton.Click;
começar
FIsDown := Falso;
Invalidar;
clique herdado;
fim;
Cadastro de procedimento;
começar
RegisterComponents('COMPONENTE WYM',[TDsFancyButton]);
fim;
fim.
Geng Baiqiang.