用DELPHI实现特色按钮

时间:2010-01-30 08:19:47  来源:第二电脑网  作者:第二电脑网

  第二电脑网导读:0" cellspacing="0" bordercolordark="#ffffff" cellpadding="5" width="99%" bgcolor="#ffffc0" border="1">unit DsFancyButton;interfaceusesSysUtils,Windows, Messages, Classes, Graphics, Controls, Forms;typeTTextStyle = (txNone, txLowered, txRaised, txShadowed);TShape = (shCapsule, sh...
  正文:每当用到Delphi自带的控件都感到少了一点什么,形状也好,颜色也好,变化的方式也好,都与自已的项目所需要的标准相差了一些,查阅了一些书籍后发现下面的控件很有可用之处!!!

以下是它的源代码



unit DsFancyButton;

interface

uses
SysUtils,Windows, Messages, Classes, Graphics, Controls, Forms;

type
TTextStyle = (txNone, txLowered, txRaised, txShadowed);
TShape = (shCaphotoshop/ target=_blank class=infotextkey>psule, 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

"用DELPHI实现特色按钮"由第二电脑网原创提供,转载请注明:http://www.002pc.com/master/College/Language/Delphi/12619.html

 1/4    1 2 3 4 下一页 尾页


关键字:

关于《用DELPHI实现特色按钮》文章的评论

站内搜索: 高级搜索

热门搜索: Windows style 系统 tr IP QQ CPU 安装 function 注册 if td