DsFancyButton.zip_delphi dsfancybutton_delphi 按钮_delphi按钮_dsfanc

特色按钮 每当用到DELPHI自带的控件都感到少了一点什么，形状也好，颜色也好，变化的方式也好，都与自已的项目所需要的标准相差了一些，查阅了一些书籍后发现下面的控件很有可用之处！！！ 以下是它的源代码： 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; FTextColor: 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 OnEndDrag; 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; end; destructor TDsFancyButton.Destroy; begin DeleteObject(FRgn); DeleteObject(MRgn); inherited Destroy; end; procedure TDsFancyButton.Paint; var Dia: integer; ClrUp, ClrDown: TColor; begin Canvas.Brush.Style := bsClear; if FIsDown then begin ClrUp := clBtnShadow; ClrDown := clBtnHighlight; end else begin ClrUp := clBtnHighlight; ClrDown := clBtnShadow; end; 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 < Height then Dia := Width else Dia := Height; Mrgn := CreateRoundRectRgn(0, 0, Width , Height, Dia, Dia); end; shRectangle: MRgn := CreateRectRgn(0, 0, Width - 1, Height - 1); shOval: MRgn := CreateEllipticRgn(0, 0, Width, Height); end;//case Canvas.Brush.Color := FButtonColor; FillRgn(Handle, MRgn, Brush.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); end;//canvas DrawShape; WriteCaption; end; procedure TDsFancyButton.DrawShape; var FC, Warna: TColor; R, G, B: Byte; AwalR, AwalG, AwalB, AkhirR, AkhirG, AkhirB, n, t, Dia: Integer; begin if FFrameWidth mod 2=0 then t := FFrameWidth else t := FFrameWidth + 1; Warna := ColorToRGB(ButtonColor); FC := ColorToRGB(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; with Canvas do for n := 0 to t - 1 do begin R := AwalR + Trunc(Sqrt(t*t - Sqr(t-n))*(AkhirR - AwalR)/t); G := AwalG + Trunc(Sqrt(t*t - Sqr(t-n))*(AkhirG - AwalG)/t); B := AwalB + Trunc(Sqrt(t*t - Sqr(t-n))*(AkhirB - AwalB)/t); Brush.Color := RGB(R, G, B); Case Shape of shOval: FRgn := CreateEllipticRgn(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 < Height then Dia := Width div 2 else Dia := Height div 2; 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; else FRgn := CreateRectRgn(1 + n, 1 + n, Width - n - 1, Height - n - 1); end;//case FrameRgn(Handle, FRgn, Brush.Handle, 1, 1); end; end; procedure TDsFancyButton.WriteCaption; var Flags: Word; BtnL, BtnT, BtnR, BtnB: Integer; R, TR: TRect; begin R := ClientREct; TR := ClientRect; Canvas.Font := Self.Font; Canvas.Brush.Style := bsClear; Flags := DT_CENTER or DT_SINGLELINE; Canvas.Font := Font; if FIsDown then 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 = txRaised) and not FIsDown) then begin Font.Color := clBtnHighLight; OffsetRect(TR, -1 + 1, -1 + 1); DrawText(Handle, PChar(Caption), Length(Caption), TR, Flags); end 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); end else if (TextStyle = txShadowed) and FIsDown then begin 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 then begin Font.Color := clBtnShadow; OffsetRect(TR, 2 + 1, 2 + 1); DrawText(Handle, PChar(Cap