Boutons en vedette
Chaque fois que j'utilise les commandes fournies avec DELPHI, j'ai l'impression qu'il manque quelque chose, que ce soit la forme, la couleur, etc.
Quelle que soit la méthode de transformation, elles sont toutes différentes des normes exigées par votre propre projet. J'ai consulté quelques livres.
Plus tard, j’ai trouvé que les contrôles suivants sont très utiles ! ! !
Voici son code source :
unité DsFancyButton ;
interface
utilise
SysUtils, Windows, messages, classes, graphiques, contrôles, formulaires ;
taper
TTextStyle = (txNone, txLowered, txRaised, txShadowed);
TShape = (shCapsule, shOval, shRectangle, shRoundRect);
TDsFancyButton = classe (TGraphicControl)
Privé
FButtonColor : TColor ;
FIsDown : booléen ;
FFrameColor : TColor ;
FFrameWidth : entier ;
FCornerRadius : entier ;
FRgn, MRgn : HRgn;
Forme : Forme T ;
FTextColor : TColor ;
FTexteStyle : TTexteStyle ;
procédure SetButtonColor(Valeur : TColor);
procédure CMEnabledChanged(var message : TMessage);
message CM_ENABLEDCHANGED ;
procédure CMTextChanged(var message : TMessage);
message CM_TEXTCHANGED ;
procédure CMDialogChar(var message : TCMDialogChar);
messageCM_DIALOGCHAR ;
procédure WMSize(var message : TWMSize); message WM_PAINT;
protégé
procédure Cliquez sur ;
procédure DrawShape ;
procédure Peinture ; remplacement ;
procédure SetFrameColor(Valeur : TColor);
procédure SetFrameWidth (Valeur : Entier);
procédure SetCornerRadius (Valeur : Entier);
procédure SetShape(Valeur : TShape);
procédure SetTextStyle(Valeur : TTextStyle);
procédure WMLButtonDown(var Message : TWMLButtonDown);
WM_LBUTTONDOWN ;
procédure WMLButtonUp(var Message : TWMLButtonUp);
WM_LBUTTONUP ;
procédure WriteCaption ;
publique
constructeur Create (Aowner: TComponent);
destructeur Détruire ;
publié
propriété ButtonColor : TColor
lire FButtonColor écrire SetButtonColor ;
Légende de la propriété ;
propriété DragCursor ;
propriété DragMode ;
propriété Activé ;
propriété Police ;
propriété FrameColor : TColor
lire FFrameColor écrire SetFrameColor ;
propriété FrameWidth : entier
lire FFrameWidth écrire SetFrameWidth ;
propriété ParentFont ;
propriété ParentShowHint ;
propriété PopupMenu ;
propriété CornerRadius : entier
lire FCornerRadius écrire SetCornerRadius ;
propriété Forme : TShape
lire FShape écrire SetShape par défaut shRoundRect ;
propriété ShowHint ;
propriété TextStyle : TTextStyle
lire FTextStyle écrire SetTExtStyle ;
propriété Visible ;
propriété OnClick ; propriété OnDragDrop ;
propriété OnDragOver ; propriété OnEndDrag ;
propriété OnMouseDown ; propriété OnMouseUp ;
PropertyOnMouseMove ;
fin;
registre de procédure ;
mise en œuvre
constructeur TDsFancyButton.Create(AOwner : TComponent);
commencer
héritéCreate (propriétaire);
ControlStyle := [csClickEvents, csCaptureMouse, CSSetCaption];
Activé := Vrai ;
FButtonColor := clBtnFace;
FIsDown := Faux;
FFrameColor := clGray;
FFrameWidth := 6;
FCornerRadius := 10 ;
FRgn := 0;
FShape := shRoundRect;
FTextStyle := txRaised;
Hauteur := 25;
Visible := Vrai ;
Largeur := 97;
fin;
destructeur TDsFancyButton.Destroy ;
commencer
SupprimerObjet(FRgn);
SupprimerObjet(MRgn);
hérité Détruire;
fin;
procédure TDsFancyButton.Paint ;
var Dia : entier ;
ClrUp, ClrDown : TColor ;
commencer
Canvas.Brush.Style := bsClear;
si FIsDown alors
commencer ClrUp := clBtnShadow; ClrDown := clBtnHighlight;
autre
commencer ClrUp := clBtnHighlight; ClrDown := clBtnShadow fin;
avec Canvas faire
commencer
boîtier Forme de
shRoundRect :
commencer
Dia := 2*CornerRadius ;
Mrgn := CreateRoundRectRgn(0, 0, Largeur, Hauteur, Dia,
Dia);
fin;
shCapsule :
commencer
si Largeur < Hauteur alors Dia := Largeur sinon Dia :=
Hauteur;
Mrgn := CreateRoundRectRgn(0, 0, Largeur, Hauteur, Dia,
Dia);
fin;
shRectangle : MRgn := CreateRectRgn(0, 0, Largeur - 1, Hauteur
- 1);
shOval: MRgn := CreateEllipticRgn(0, 0, Largeur, Hauteur);
fin;//cas
Canvas.Brush.Color := FButtonColor;
FillRgn(Poignée, MRgn, Brosse.Poignée);
Brush.Color :=ClrUp;
FrameRgn(Poignée, MRgn, Brosse.Poignée, 1,1);
DécalageRgn(MRgn, 1, 1);
Brush.Color := ClrDown;
FrameRgn(Poignée, MRgn, Brosse.Poignée, 1, 1);
fin;//toile
DessinerForme ;
ÉcrireCaption ;
fin;
procédure TDsFancyButton.DrawShape ;
var
FC, Warna : TColor ;
R, V, B : octet ;
AwalR, AwalG, AwalB, AkhirR, AkhirG, AkhirB, n, t, Dia : Entier ;
commencer
si FFrameWidth mod 2=0 alors t := FFrameWidth
sinon t := FFrameWidth + 1;
Avertissement := ColorToRGB(ButtonColor);
FC := CouleurVersRGB(FrameColor);
Canvas.Brush.Color := Warna;
AwalR := GetRValue(FC); AkhirR := GetRValue(Warna);
AwalG := GetGValue(FC); AkhirG := GetGValue(Warna);
AwalB := GetBValue(FC); AkhirB := GetBValue(Warna);
FRgn := 0;
avec Canvas faire
pour n := 0 à t - 1 faire
commencer
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);
Brush.Color := RVB (R, V, B);
Forme du boîtier de
shOval : FRgn := CreateEllipticRgn(1 + n, 1 + n, Largeur - n,
Hauteur - n);
shRoundRect :
commencer
Dia := CoinRadius;
si (Dia - n) >0 alors
FRgn :=
CreateRoundRectRgn(1 + n, 1 + n, Largeur - n, Hauteur -
n, 2*(Diamètre - n), 2*(Diamètre - n))
sinon FRgn := CreateRectRgn( 1 + n, 1 + n, Largeur - n - 1,
Hauteur - n - 1);
fin;
shCapsule :
commencer
si Largeur < Hauteur alors Dia := Largeur div 2 sinon Dia :=
Division de hauteur 2 ;
si (Dia - n) > 0 alors
FRgn:=
CreateRoundRectRgn(1 + n, 1 + n, Largeur - n,
Hauteur - n, 2*(Dia - n), 2*(Dia - n))
sinon FRgn := CreateRectRgn(1 + n, 1 + n ,Width - n -
1, hauteur - n - 1);
fin;
sinon FRgn := CreateRectRgn(1 + n, 1 + n, Largeur - n - 1,
Hauteur - n - 1);
fin;//cas
FrameRgn(Poignée, FRgn, Brosse.Poignée, 1, 1);
fin;
fin;
procédure TDsFancyButton.WriteCaption ;
var
Drapeaux : Mot ;
BtnL, BtnT, BtnR, BtnB : nombre entier ;
R, TR : TRect ;
commencer
R := ClientREct; TR := ClientRect;
Canvas.Font := Self.Font;
Canvas.Brush.Style := bsClear;
Indicateurs := DT_CENTER ou DT_SINGLELINE ;
Canvas.Font := Police;
si FIsDown alors FTextColor := FrameColor
sinon FTextColor := Self.Font.Color;
avec de la toile faire
commencer
BtnT := (Hauteur - TextHeight(Caption)) div 2;
BtnB := BtnT + TextHeight(Légende);
BtnL := (Largeur - TextWidth(Légende)) div 2;
BtnR := BtnL + TextWidth(Légende);
TR := Rect(BtnL, BtnT, BtnR, BtnB);
R := TR;
if ((TextStyle = txLowered) et FIsDown ) ou
((TextStyle = txRaised) et non FIsDown) alors
commencer
Font.Color := clBtnHighLight;
DécalageRect(TR, -1 + 1, -1 + 1);
DrawText(Poignée, PChar(Légende), Longueur(Légende), TR,
drapeaux);
fin
sinon si ((TextStyle = txLowered) et non FIsDown) ou
((TextStyle = txRaised) et FIsDown) alors
commencer
Font.Color := clBtnHighLight;
DécalageRect(TR, + 2, + 2);
DrawText(Poignée, PChar(Légende), Longueur(Légende), TR,
drapeaux);
fin
sinon si (TextStyle = txShadowed) et FIsDown alors
commencer
Font.Color := clBtnShadow;
DécalageREct(TR, 3 + 1, 3 + 1);
DrawText (Poignée, PChar (Légende),
Longueur (légende), TR, drapeaux );
fin
sinon si (TextStyle = txShadowed) et non FIsDown
alors
commencer
Font.Color := clBtnShadow;
DécalageRect(TR, 2 + 1, 2 + 1);
DrawText (Poignée, PChar (Légende),
Longueur (légende), TR, drapeaux );
fin;
si activé, alors Font.Color := FTextColor//self.Font.Color
sinon si (TextStyle = txShadowed) et non activé alors
Font.Color := clBtnFace
sinon Font.Color := clBtnShadow;
si FIsDown alors OffsetRect(R, 1, 1)
sinon OffsetRect(R, -1, -1);
DrawText (Poignée, PChar (Légende), Longueur (Légende), R, Drapeaux);
fin;
fin;
procédure TDsFancyButton.SetButtonColor(valeur : TColor);
commencer
si valeur <> FButtonColor alors
commencer FButtonColor := valeur ; Invalider ;
fin;
procédure TDsFancyButton.WMLButtonDown(var message :
TWMLButtonDown);
commencer
sinon PtInRegion(MRgn, message.xPos, message.yPos) alors Exit ;
FIsDown := Vrai ;
Peinture;
hérité;
fin;
procédure TDsFancyButton.WMLButtonUp(var message : TWMLButtonUp);
commencer
sinon FIsDown, alors quittez ;
FIsDown := Faux;
peinture;
hérité;
fin;
procédure TDsFancyButton.SetShape(valeur : TShape);
commencer
si valeur <> FShape alors
début FShape := valeur ; Invalider ;
fin;
procédure TDsFancyButton.SetTextStyle(valeur : TTextStyle);
commencer
si valeur<>FTextStyle alors
début FTextStyle := valeur ; Invalider ;
fin;
procédure TDsFancyButton.SetFrameColor(valeur : TColor);
commencer
si Valeur<>FFrameColor alors
commencer FFrameColor := Valeur ; Invalider ; fin ;
fin;
procédure TDsFancyButton.SetFrameWidth(Valeur : entier);
var
w : entier ;
commencer
si Largeur<hauteur alors w := Largeur sinon w := Hauteur ;
si Value<>FFrameWidth alors FFrameWidth := valeur ;
si FFrameWidth < 4 alors FFrameWidth := 4;
si FFrameWidth >(w div 2) alors FFrameWidth := (w div 2) ;
Invalider;
fin;
procédure TDsFancyButton.SetCornerRadius(Valeur : entier);
var
w : entier ;
commencer
si Largeur<Hauteur alors w := Largeur sinon w := Hauteur ;
si valeur<>FCornerRadius alors FCornerRadius := valeur ;
si FCornerRadius<3 alors FCornerRadius := 3;
si FCornerRadius>w alors FCornerRadius := w;
Invalider;
fin;
procédure TDsFancyButton.CMEnabledChanged(var message: Tmessage);
commencer
hérité;
invalider;
fin;
procédure TDsFancyButton.CMTextChanged(var message: TMessage);
commencer
Invalider;
fin;
procédure TDsFancyButton.CMDialogChar(var message:TCMDialogChar);
commencer
Avec message faire
si IsAccel (CharCode, Caption) et Enabled alors
commencer Clic ; Résultat := 1 ;fin
sinon hérité;
fin;
procédure TDsFancyButton.WMSize (var Message : TWMSize);
commencer
hérité;
si largeur>300 alors largeur := 300 ;
si Hauteur>300 alors Hauteur := 300 ;
fin;
procédure TDsFancyButton.Click ;
commencer
FIsDown := Faux;
Invalider;
Clic hérité ;
fin;
registre de procédure ;
commencer
RegisterComponents('COMPOSANT WYM',[TDsFancyButton]);
fin;
fin.
Geng Baiqiang.