Whenever I use a control of Delphi, I feel less, the shape is good, the color is good, the way the change is good, and the standards you need to have the standards you need. I have found some books and found below. The control is very available! ! !
The following is its source code:
UNIT DSFANCYBUTTON;
Interface
Uses Sysutils, Windows, Messages, Classes, Graphics, Controls, Forms
type TTextStyle = (txNone, txLowered, txRaised, txShadowed); TShape = (shCapsule, shOval, shRectangle, shRoundRect); TDsFancyButton = class (TGraphicControl) private FButtonColor: TColor; FIsDown: Boolean; FFrameColor: TColor; FFrameWidth: Integer; FCornerRadius: Integer; FRGN, MRGN: HRGN; FSHAPE: TSHAPE; FTEXTSTYLOR: TCOLOR; FTEXTSTYLE: TTEXTSTYLE
procedure SetButtonColor (Value: TColor); procedure CMEnabledChanged (var message: TMessage); message CM_ENABLEDCHANGED; procedure CMTextChanged (var message: TMessage); message CM_TEXTCHANGED; procedure CMDialogChar (var message: TCMDialogChar); message CM_DIALOGCHAR; procedure WMSize (var message: TWMSize); message WM_PAINT; protected procedure Click; override; procedure DrawShape; procedure Paint; override; procedure SetFrameColor (Value: TColor); procedure SetFrameWidth (Value: Integer); procedure SetCornerRadius (Value: Integer); procedure setShape (Value: TShape ); procedure SetTextStyle (Value: TTextStyle); procedure WMLButtonDown (var Message: TWMLButtonDown); message WM_LBUTTONDOWN; procedure WMLButtonUp (var Message: TWMLButtonUp); message WM_LBUTTONUP; procedure WriteCaption; public constructor Create (Aowner: TComponent); override; destructor Destroy Override; Published Property ButtonColor: TColor read FButtonColor write SetButtonColor; property Caption; property DragCursor; property DragMode; property Enabled; property Font; property FrameColor: TColor read FFrameColor write SetFrameColor; property FrameWidth: Integer read FFrameWidth write SetFrameWidth; property ParentFont; property ParentShowHint; property PopupMenu; property CornerRadius : Integer read FCornerRadius write SetCornerRadius; property Shape: TShape read FShape write setShape default shRoundRect; property ShowHint; property TextStyle: TTextStyle read FTextStyle write SetTExtStyle; property Visible;
Property OnClick; Property OnDragDrop; Property OnDragover; Property OnMouseDown; Property OnMouseUp; Property OnMouseMove; End; Procedure Register;
IMPLEMENTATION
constructor TDsFancyButton.Create (AOwner: TComponent); begin inherited Create (Aowner); ControlStyle: = [csClickEvents, csCaptureMouse, csSetCaption]; Enabled: = True; FButtonColor: = clBtnFace; FIsDown: = False; FFrameColor: = clGray; FFrameWidth: = 6; fcornerradius: = 10; FRGN: = 0; fshape: = shroundRect; fTextStyle: = txraised; height: = 25; visible: = true; width: = 97;
DeStructor TdsfancyButton.destroy; Begin deleteObject (FRGN); deleteObject (mrgn); inherited destroy;
Procedure tdsfancybutton.paint; var dia: integer; clrup, clrdown: tcolor; begin canvas.brush.style: = bsclear;
If FISDOWN THEN BEGIN CLRUP: = CLBTNSHADOW; CLRDOWN: = CLBTNHIGHLIGHT; ELSE BEGIN CLRUP: = CLBTNHIGHLIGHT; CLRDOWN: = CLBTNSHADOW;
with Canvas do begin case Shape of shRoundRect: begin Dia: = 2 * CornerRadius; Mrgn: = CreateRoundRectRgn (0, 0, Width, Height, Dia, Dia); end; shCapsule: begin if Width WARNA: = ColorTorgb (ButtonColor); Fc: = Colortorgb (Framecolor); canvas.brush.color: = Warna; Akhirr: = getrvalue (war); Akhang: = getBValue (Warna); Akalb: = getBValue (FC); Akhirb: = getBValue (Warna); frGn: = 0; with canvas do for n: = 0 to t - 1 do begin 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: = RGB (R, G, B); Case Shape of Shoval: FRGN: = CreatellipticRGN (1 N, 1 N, Width - N, Height - N); ShroundRect: Begin Dia: = Cornerradius; IF (DIA - N)> 0 THEN FRGN: = CreateroundRectRGN (1 N, 1 N, Width - N, Height - N, 2 * (DIA - N), 2 * (DIA - N)) ELSE FRGN: = CreateRectrGN (1 N, 1 N, Width - N - 1 , Height - N - 1); End; SHCAPSULE: Begin if width IF fisdown the fTextColor: = framecolor else fTextColor: = Self.font.color; WITH Canvas Do Begin BTNT: = (Height - TextHeight (CAPTION)) DIV 2; BTNB: = BTNT TextHeight (CAPTION); BTNL: = (Width - Textwidth (CAPTION)) DIV 2; btnr: = btnl TextWidth (CAPTION ); Tr: = RECT (BTNL, BTNT, BTNR, BTNB); R: = tr; if ((TextStyle = TXLOWERED) AND FISDOWN OR ((TextStyle = txraiad) and not fisdown) THEN BEGIN FONT.COLOR: = CLBTNHIGHLIGHT OffsetRECT (Tr, -1 1, -1 1); DrawText (Handle, Pchar (CAPTION), Length (Caption), Tr, Flags; ELSE IF ((TextStyle = TXLOWERED) AND NOT FISDOWN OR ( (TextStyle = TXRAISED) AND FISDOWN) THEN BEGIN FONT.COLOR: = CLBTNHighlight; OffsetRect (Tr, 2, 2); DrawText (Handle, Pchar (CAPTION), Length (Caption), Tr, Flags; ELSE IF (TextStyle = txshadowed) and fisdown kiln, font.color: = CLBTNSHADOW; OffsetRect (TR, 3 1, 3 1); DrawText (Handle, Pchar (CAPTION), Length (Caption), Tr, Flags; end else if (TextStyle = TXSHADOWED) and not fisdown kilnot.color: = CLBTNSHADOW; OffsetRect (TR, 2 1, 2 1 DrawText (Handle, Pchar (CAPTION), Length (Caption), Tr, Flags; if Enabled then Font.Color: = FTextColor // self.Font.Color else if (TextStyle = txShadowed) and not Enabled then Font.Color: = clBtnFace else Font.Color: = clBtnShadow; if FIsDown then OffsetRect (R, 1, 1) Else OffsetRECT (R, -1, -1); DrawText (Handle, Pchar (Caption), Length (Caption), R, Flags; end; end; procedure tdsfancyButton.setButtonColor (value: tcolor); Begin IF Value <> FButtonColor The begin FButtonColor: = Value; Invalidate; End; Procedure tdsfancyButton.wmlbuttondown (var message: twmlbuttondown); begin if not PtinRegion (mrgn, message.xpos, message.ypos) THEN EXIT; FISDOWN: = True; Paint; inherited; Procedure tdsfancyButton.wmlbuttonup (var message: twmlbutton); begin if not fisdown kiln ixit; fundown: = false; Procedure tdsfancyButton.Setshape (Value: Tshape); Begin IF Value <> fshape dam fshape: = value; invalidate; end; Procedure tdsfancyButton.SettextStyle (Value: TtextStyle); Begin IF Value <> fTextStyle The Begin fTextStyle: = value; invalidate; end; Procedure tdsfancyButton.SetFramecolor (Value: tcolor); Begin if Value <> fframecolor dam fframecolor: = value; invalidate; end; procedure TDsFancyButton.SetFrameWidth (Value: Integer); var w: integer; begin if Width height then w <: = Width else w: = Height; if Value <> FFrameWidth then FFrameWidth: = value; if FFrameWidth <4 then FFrameWidth: = 4; if fframewidth> (w VIV 2) THEN FFRAMEWIDTH: = (W Div 2); invalidate; procedure TDsFancyButton.SetCornerRadius (Value: integer); var w: integer; begin if Width Procedure TdsfancyButton.cmTextChanged (Var Message: tMessage); begin invalidate; Procedure tdsfancyButton.cmdialogchar (var message: tcmdialogchar); Begin with message DO if ISAccel (charcode, caption) and enabled dam clicks; result: = 1; end else inherited Procedure tdsfancybutton.wmsize (var message: twmsize); begin inherited; if width> 300 Then Width: = 300; if Height> 300 Then Height: = 300; Procedure tdsfancybutton.click; begin fisdown: = false; invalidate; inherited click; Procedure Register; Begin RegisterComponents ('WYM Component', [TDSFANCyButton]); End.
