xpbitbtn.pas

非常好的xp界面控件

{
 Copyright:      rhoStyle Developers team
 mailto:         [e-mail]
 Author:         rhoStyle
 Version:        2.4
 Delphi Version: Delphi 3-7
 Description:    This is Windows XP style button. You can use it with
		 Windows 95, 98, NT, ME, 2000 and XP

}

unit xpBitBtn;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, XPGraphUtil, xpReg;

type
  TxpBitBtn = class(TCustomControl)
  private
    FCaption : TCaption;
    FActive  : Boolean;
    FDowned  : Boolean;
    FEnabled : Boolean;
    FFont    : TFont;
    FFocused : Boolean;
    FModalResult : TModalResult;
    FHotKey  : Char;
    FCancel  : Boolean;
    FDefault : Boolean;
    FGradient: Boolean;

    FOnClick : TNotifyEvent;
    FOnEnter : TNotifyEvent;
    FOnExit  : TNotifyEvent;
    FOnKeyDown : TKeyEvent;
    FOnKeyUp : TKeyEvent;

    FGlyph   : TBitmap;
    FMonoGlyph : TBitmap;

    FImageList : TImageList;
    FImageIndex: Integer;

    procedure SetCaption (ACaption : TCaption);
    function  GetCaption : TCaption;

    procedure SetDowned (ADowned : Boolean);
    function  GetDowned : Boolean;

    procedure SetFont (AFont : TFont);
    function  GetFont : TFont;
    procedure OnFontChange (Sender : TObject);

    procedure SetModalResult (AModalResult : TModalResult);
    function  GetModalResult : TModalResult;

    procedure SetEnabled (AEnabled : Boolean);

    procedure SetGradient (Value : Boolean);
    function  GetGradient : Boolean;

    procedure SetGlyph (AGlyph : TBitmap);
    function  GetGlyph : TBitmap;

    procedure SetImageList (AList : TImageList);
    function GetImageList : TImageList;

    procedure SetImageIndex (AIndex : Integer);
    function GetImageIndex : Integer;

    procedure FOnButtonClick;
  protected
    procedure Paint; override;
    procedure MouseEnter (var Message : TMessage); message CM_MOUSEENTER;
    procedure MouseLeave (var Message : TMessage); message CM_MOUSELEAVE;
    procedure LMouseDown  (var Message : TMessage); message WM_LBUTTONDOWN;
    procedure RMouseDown  (var Message : TMessage); message WM_RBUTTONDOWN;
    procedure LMouseUp  (var Message : TMessage); message WM_LBUTTONUP;
    procedure RMouseUp  (var Message : TMessage); message WM_RBUTTONUP;
    procedure LMouseDblClick  (var Message : TMessage); message WM_LBUTTONDBLCLK;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure CMExit(var Message: TCMLostFocus); message CM_EXIT;
    procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TMessage); message WM_KILLFOCUS;
    procedure WMKeyDown(var Message: TMessage); message WM_KEYDOWN;
    procedure WMKeyUp(var Message: TMessage); message WM_KEYUP;
    procedure CMDialogChar(var Message : TCMDialogChar);  message CM_DIALOGCHAR;
    procedure CMDialogKey(var Message : TCMDialogKey);  message CM_DIALOGKEY;

    procedure Loaded; override;

  public
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property Caption : TCaption read GetCaption write SetCaption;
    property Font : TFont read GetFont write SetFont;
    property Glyph : TBitmap read GetGlyph write SetGlyph;
    property ImageList : TImageList read GetImageList write SetImageList;
    property ImageIndex : Integer read GetImageIndex write SetImageIndex default -1;
    property Enabled read FENabled write SetEnabled;
    property Gradient : Boolean read GetGradient write SetGradient;
    property ParentFont;
    property Hint;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property DragCursor;
    property DragMode; 
    property Cancel : Boolean read FCancel write FCancel default False;
    property Default : Boolean read FDefault write FDefault default False;
    property ModalResult : TModalResult read GetModalResult write SetModalResult default mrNone;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
    property OnExit: TNotifyEvent read FOnExit write FOnExit;
    property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
    property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
    property OnDragDrop;
    property OnDragOver;
    property OnStartDrag;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
  end;

procedure Register;


implementation

constructor TxpBitBtn.Create (AOwner : TComponent);
begin
  Inherited Create (AOwner);
  Width := 75;
  Height := 25;
  FFont := TFont.Create;
  FFont.Style := [fsBold];
  FFont.Color := clNavy;
  FFont.OnChange := OnFontChange;

  FCaption := 'XP BitBtn';
  Enabled := True;
  FEnabled := True;
  FActive := False;
  FDowned := False;
  FFocused := False;
  FGradient := true;
  FGlyph := TBitmap.Create;
  FGlyph.TransparentMode := tmAuto;
  FGlyph.Transparent := true;

  FMonoGlyph := TBitmap.Create;
  FMonoGlyph.TransparentMode := tmAuto;
  FMonoGlyph.Transparent := true;

  FImageIndex := -1;
  FImageList := nil;
end;

destructor TxpBitBtn.Destroy;
begin
  FFont.Free;
  FGlyph.Free;
  FMonoGlyph.Free;
  inherited;
end;

procedure TxpBitBtn.Loaded;
begin
  inherited Loaded;
  FMonoGlyph.Assign (FGlyph as TBitmap);
  ConvertBitmapToGrayscale (FMonoGlyph);
  FMonoGlyph.Transparent := true;
  FMonoGlyph.TransparentMode := tmAuto;
end;

procedure TxpBitBtn.CMDialogKey(var Message : TCMDialogKey);
begin
  if Enabled and  ((FCancel and (Message.CharCode = VK_ESCAPE)) or
  (FDefault and (Message.CharCode = VK_RETURN))) then
    FOnButtonClick;
end;


procedure TxpBitBtn.Paint;
var
  AText : String;
  AImageWidth : Integer;
  AImageHeigth : Integer;
  ACanvas : TBitmap;
begin
  AText := FCaption;
  if Pos ('&', FCaption) <> 0 then Delete (AText, Pos ('&', AText), 1);

  ACanvas := TBitmap.Create;

  try
    ACanvas.Width := ClientWidth;
    ACanvas.Height := ClientHeight;

    {if Enabled then
    begin
      ACanvas.Canvas.Pen.Width := 1;
      ACanvas.Canvas.Brush.Style := bsSolid;
      if FGradient then
      begin
        ACanvas.Canvas.Brush.Color := RGB (214, 211, 211);
        ACanvas.Canvas.Pen.Color := RGB (214, 211, 211);
      end
      else
      begin
        ACanvas.Canvas.Brush.Color := clBtnFace;
        ACanvas.Canvas.Pen.Color := clBtnShadow;
      end;
      ACanvas.Canvas.RoundRect (0, 0, Width, Height, 3, 3);

      if FGradient then
      begin
        ACanvas.Canvas.Brush.Style := bsClear;
        ACanvas.Canvas.Pen.Color := RGB (0, 60, 116);
        ACanvas.Canvas.RoundRect (1, 1, Width-1, Height-1, 5, 5);

        if (FDowned) and FActive then
          GradientFillRect (ACanvas.Canvas, Rect (4, 4, Width-4, Height-4), RGB (253, 253, 253),
              RGB (205, 204, 223), fdBottomToTop, HeightOf (ClientRect) div 2)
        else
          GradientFillRect (ACanvas.Canvas, Rect (4, 4, Width-4, Height-4), RGB (253, 253, 253),
              RGB (205, 204, 223), fdTopToBottom, HeightOf (ClientRect) div 3);
      end
      else
      begin
      end;


      ACanvas.Canvas.Pen.Color := RGB (206, 231, 255);
      ACanvas.Canvas.MoveTo (3, 2);
      ACanvas.Canvas.LineTo (Width - 3, 2);

      ACanvas.Canvas.Pen.Color := RGB (105, 130, 238);
      ACanvas.Canvas.MoveTo (3, Height-3);
      ACanvas.Canvas.LineTo (Width - 3, Height-3);

      ACanvas.Canvas.Pen.Color := RGB (188, 212, 246);
      ACanvas.Canvas.Rectangle (2, 3, Width-2, Height-3);

      ACanvas.Canvas.Pen.Color := RGB (255, 255, 255);
      ACanvas.Canvas.MoveTo (3, 4);
      ACanvas.Canvas.LineTo (3, Height-4);

      ACanvas.Canvas.Pen.Color := RGB (255, 255, 255);
      ACanvas.Canvas.MoveTo (Width-4, 4);
      ACanvas.Canvas.LineTo (Width-4, Height-4);

      ACanvas.Canvas.Pen.Color := RGB (255, 255, 255);
      ACanvas.Canvas.MoveTo (3, Height-1);
      ACanvas.Canvas.LineTo (Width-3, Height-1);
      ACanvas.Canvas.MoveTo (Width-1, Height-4);
      ACanvas.Canvas.LineTo (Width-1, 2);

      if FActive then
      begin
        ACanvas.Canvas.Brush.Style := bsClear;
        ACanvas.Canvas.Pen.Color := RGB (248, 179, 48);
        ACanvas.Canvas.Pen.Width := 1;
        ACanvas.Canvas.RoundRect (3, 3, Width-3, Height-3, 2, 2);
      end;}

////////////////////////////////////////
    if Enabled then
    begin
      ACanvas.Canvas.Pen.Width := 1;
      ACanvas.Canvas.Brush.Style := bsSolid;
      if FGradient then
      begin
        ACanvas.Canvas.Brush.Color := RGB (214, 211, 211);
        ACanvas.Canvas.Pen.Color := RGB (214, 211, 211);
        ACanvas.Canvas.RoundRect (0, 0, Width, Height, 3, 3);
      end
      else
      begin
        ACanvas.Canvas.Brush.Color := clBtnFace;
        ACanvas.Canvas.Pen.Color := clBtnShadow;
      end;

      if FGradient then
      begin
        ACanvas.Canvas.Brush.Style := bsClear;
        ACanvas.Canvas.Pen.Color := RGB (0, 60, 116);
        ACanvas.Canvas.RoundRect (1, 1, Width-1, Height-1, 5, 5);

        if (FDowned) and FActive then
          GradientFillRect (ACanvas.Canvas, Rect (4, 4, Width-4, Height-4), RGB (253, 253, 253),
              RGB (205, 204, 223), fdBottomToTop, HeightOf (ClientRect) div 2)
        else
          GradientFillRect (ACanvas.Canvas, Rect (4, 4, Width-4, Height-4), RGB (253, 253, 253),
               RGB (205, 204, 223), fdTopToBottom, HeightOf (ClientRect) div 3);
      end
      else
      begin
        ACanvas.Canvas.Brush.Color := clBtnFace;
        ACanvas.Canvas.Pen.Color := clBlack;
        ACanvas.Canvas.FillRect (Rect (0, 0, Width, Height));
      end;

      if FGradient then
      begin
        ACanvas.Canvas.Pen.Color := RGB (206, 231, 255);
        ACanvas.Canvas.MoveTo (3, 2);
        ACanvas.Canvas.LineTo (Width - 3, 2);

        ACanvas.Canvas.Pen.Color := RGB (105, 130, 238);
        ACanvas.Canvas.MoveTo (3, Height-3);
        ACanvas.Canvas.LineTo (Width - 3, Height-3);

        ACanvas.Canvas.Pen.Color := RGB (188, 212, 246);
        ACanvas.Canvas.Rectangle (2, 3, Width-2, Height-3);

        ACanvas.Canvas.Pen.Color := RGB (255, 255, 255);
        ACanvas.Canvas.MoveTo (3, 4);
        ACanvas.Canvas.LineTo (3, Height-4);

        ACanvas.Canvas.Pen.Color := RGB (255, 255, 255);
        ACanvas.Canvas.MoveTo (Width-4, 4);
        ACanvas.Canvas.LineTo (Width-4, Height-4);

        ACanvas.Canvas.Pen.Color := RGB (255, 255, 255);
        ACanvas.Canvas.MoveTo (3, Height-1);
        ACanvas.Canvas.LineTo (Width-3, Height-1);
        ACanvas.Canvas.MoveTo (Width-1, Height-4);
        ACanvas.Canvas.LineTo (Width-1, 2);
      end
      else
      begin
        if FDowned then ACanvas.Canvas.Pen.Color := clWhite
          else ACanvas.Canvas.Pen.Color := cl3DDkShadow;
        ACanvas.Canvas.MoveTo (1, Height-1);
        ACanvas.Canvas.LineTo (Width - 1, Height-1);
        ACanvas.Canvas.LineTo (Width - 1, 1);

        if FDowned then ACanvas.Canvas.Pen.Color := cl3DDkShadow
          else ACanvas.Canvas.Pen.Color := clWhite;
        ACanvas.Canvas.MoveTo (1, Height-1);
        ACanvas.Canvas.LineTo (1, 1);
        ACanvas.Canvas.LineTo (Width - 1, 1);
      end;

      if FActive then
      begin
        ACanvas.Canvas.Brush.Style := bsClear;
        if FGradient then ACanvas.Canvas.Pen.Color := RGB (248, 179, 48)
          else ACanvas.Canvas.Pen.Color := clSilver;
        ACanvas.Canvas.Pen.Width := 1;
        ACanvas.Canvas.RoundRect (3, 3, Width-3, Height-3, 2, 2);
      end;

///////////////////////////////////////