xppanel.pas

非常好的xp界面控件

unit xpPanel;

interface

{$I xpDelphi.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, xpGraphUtil, xpReg, xpCtrlStyle;

const
  // Rounded corner radius. Must be even number
  cCornerRadius : Integer = 10;

  //
  clXPStartBGColor : TColor = $FBF1ED;
  clXPEndBGColor : TColor = $F7DFD6;
  clXPTitleStartColor : TColor = $FFFFFF;
  clXPTitleEndColor : TColor = $F0BDAA;

  //HandPoint (System cursor)
  crSystemHand : TCursor = 10;

  //WParam for WM_NCPAINT
  wmNCPaintOnlyBorder : LongInt = 666;

  //Title button sizes
  cTitleButtonSize : Integer = 20;
type
  //Background image align type
  TBGImageAlign = (iaCenter, iaStretch, iaTile);

  //Title image align type
  TTitleImageAlign = (tiaCenter, tiaLeft, tiaRight, tiaStretch, tiaTile);

  //Title buttons
  TTitleButton = (tbClose, tbMinimize, tbMaximize);
  TTitleButtons = Set of TTitleButton;

  TxpPanel = class;

  //Event types
  TAfterSizeChanged = procedure (Sender : TxpPanel; ASizeRestored : Boolean) of object;

  TxpPanel = class(TCustomPanel)
  private
    FCloseBtnRect : TRect;
    FMaxBtnRect   : TRect;
    FMinBtnRect   : TRect;
    FOldBounds    : TRect;
    FOldAlign     : TAlign;
    FOldMinimize  : Boolean;
    FMinimizing   : Boolean;

    FGradientFill : Boolean;
    FStartColor   : TColor;
    FEndColor     : TColor;
    FFillDirection: TFillDirection;
    FShadow       : Boolean;
    FShadowDist   : Integer;
    FHeight       : Integer;

    FDefaultHeight : Integer;
    FShowHeader : Boolean;
    FCaption    : String;
    FTitle      : String;
    FTitleFont  : TFont;
    FTitleHeight: Integer;
    FTitleAlignment : TAlignment;
    FTitleShadowOnMouseEnter : Boolean;
    FTitleGradient : Boolean;
    FTitleStartColor : TColor;
    FTitleEndColor : TColor;
    FTitleColor : TColor;
    FTitleFillDirect : TFillDirection;
    FTitleImage : TBitmap;
    FTitleImageAlign : TTitleImageAlign;
    FTitleImageTransparent : Boolean;
    FTitleCursor : TCursor;
    FTitleButtons : TTitleButtons;
    FAnimation : Boolean;

    FMovable : Boolean;
    FSizable : Boolean;

    FMinimized : Boolean;
    FMaximized : Boolean;

    FBorderSize : Integer;
    FBorderColor: TColor;
    FShowBorder : Boolean;
    FRoundedCorner : TRoundedCorners;

    FBGImage : TBitmap;
    FBGImageAlign : TBGImageAlign;
    FBGImageTransparent : Boolean;

    FMouseOnHeader : Boolean;

    FOnTitleClick : TNotifyEvent;
    FOnTitleDblClick : TNotifyEvent;
    FOnTitleMouseDown : TMouseEvent;
    FOnTitleMouseUp : TMouseEvent;
    FOnTitleMouseEnter: TNotifyEvent;
    FOnTitleMouseExit : TNotifyEvent;
    FOnMouseEnter     : TNotifyEvent;
    FOnMouseExit      : TNotifyEvent;
    FAfterMinimized   : TAfterSizeChanged;
    FAfterMaximized   : TAfterSizeChanged;
    FBeforeMoving     : TNotifyEvent;
    FAfterMoving      : TNotifyEvent;
    FAfterClose       : TNotifyEvent;

    procedure SetGradientFill (AValue : Boolean);
    procedure SetStartColor (AColor : TColor);
    procedure SetEndColor (AColor : TColor);
    procedure SetFillDirection (AFillDirection : TFillDirection);
    procedure SetShadow (AValue : Boolean);
    procedure SetShadowDist (AValue : Integer);

    procedure SetShowHeader (AValue : Boolean);
    procedure SetCaption (ACaption : String);
    procedure SetTitle (ATitle : String);
    procedure SetTitleFont (AFont : TFont);
    procedure OnTitleFontChange (Sender : TObject);
    procedure SetDefaultHeight (AValue : Integer);

    procedure SetTitleHeight (AHeight : Integer);
    procedure SetTitleAlignment (AValue : TAlignment);
    procedure SetShadowTitleOnMouseEnter (AShadow : Boolean);
    procedure SetTitleGradient (AValue : Boolean);
    procedure SetTitleStartColor (AValue : TColor);
    procedure SetTitleEndColor (AValue : TColor);
    procedure SetTitleFillDirect (AValue : TFillDirection);
    procedure SetTitleColor (AValue : TColor);
    procedure SetTitleImage (AValue : TBitmap);
    procedure SetTitleCursor (AValue : TCursor);
    procedure SetTitleImageAlign (AValue : TTitleImageAlign);
    procedure SetTitleImageTransparent (AValue : Boolean);
    procedure SetTitleButtons (AValue : TTitleButtons);

    procedure SetAnimation (AValue : Boolean);
    procedure SetBorderSize (AValue : Integer);
    procedure SetBorderColor (AValue : TColor);
    procedure SetShowBorder (AValue : Boolean);
    procedure SetRoundedCorner (AValue : TRoundedCorners);

    procedure SetMovable (AValue : Boolean);
    procedure SetSIzable (AValue : Boolean);
    procedure SetMinimized (AValue : Boolean);
    procedure SetMaximized (AValue : Boolean);

    procedure SetBGImage (AImage : TBitmap);
    procedure SetBGImageAlign (AImageAlign : TBGImageAlign);
    procedure SetBGImageTransparent (ATrans : Boolean);
  protected
    procedure DrawTitle (ACanvas : TCanvas; ATitleRect : TRect);
    procedure DrawAllTitleButtons (ACanvas : TCanvas; ATitleRect : TRect);
    procedure DrawTitleButton (ACanvas : TCanvas; AButtonRect : TRect; ABtnType : TTitleButton);
    procedure DrawBorder (ACanvas : TCanvas; ARect : TRect; AClient : Boolean); //AClient = true - draw client area border only
    procedure DrawBGImage (ACanvas : TCanvas);
    procedure ForceReDraw;
    procedure Loaded; override;
    procedure SetShape (ARounded : TRoundedCorners);

    procedure WMSize (var Message : TMessage); message WM_SIZE;

    procedure MouseEnter (var Message : TMessage); message CM_MOUSEENTER;
    procedure MouseLeave (var Message : TMessage); message CM_MOUSELEAVE;
    procedure NCHitTest (var Message : TWMNCHitTest); message WM_NCHITTEST;
    procedure NCMouseDown (var Message : TWMNCLBUTTONDOWN); message WM_NCLBUTTONDOWN;
    procedure NCMouseUp (var Message : TWMNCLBUTTONUP); message WM_NCLBUTTONUP;
    procedure NCMouseDblClick (var Message : TWMNCLButtonDblClk); message WM_NCLBUTTONDBLCLK;

    procedure WMNCPaint (var Message : TWMNCPaint); message WM_NCPAINT;
    procedure WMNCCalcSize (var Message : TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCACTIVATE (var Message : TWMNCActivate); message WM_NCACTIVATE;
    procedure Paint; override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    { Published declarations }
    property GradientFill : Boolean read FGradientFill write SetGradientFill default True;
    property StartColor : TColor read FStartColor write SetStartColor;
    property EndColor : TColor read FEndColor write SetEndColor;
    property FillDirection : TFillDirection read FFillDirection write SetFillDirection;
    property TitleShow : Boolean read FShowHeader write SetShowHeader default True;
    property Caption : String read FCaption write SetCaption;
    //property Shadow : Boolean read FShadow write SetShadow default true;
    //property ShadowDist : Integer read FShadowDist write SetShadowDist default 5;

    property Minimized : Boolean read FMinimized write SetMinimized default False;
    property Maximized : Boolean read FMaximized write SetMaximized default False;
    property Title : String read FTitle write SetTitle;
    property TitleFont : TFont read FTitleFont write SetTitleFont;
    property TitleHeight : Integer read FTitleHeight write SetTitleHeight default  30;
    property TitleAlignment : TAlignment read FTitleAlignment write SetTitleAlignment;
    property TitleShadowOnMoseEnter : Boolean read FTitleShadowOnMouseEnter write SetShadowTitleOnMouseEnter default True;
    property TitleGradient : Boolean read FTitleGradient write SetTitleGradient default True;
    property TitleStartColor : TColor read FTitleStartColor write SetTitleStartColor;
    property TitleEndColor : TColor read FTitleEndColor write SetTitleEndColor;
    property TitleColor : TColor read FTitleColor write SetTitleColor;
    //property TitleCursor : TCursor read FTitleCursor write SetTitleCursor;
    property TitleImage : TBitmap read FTitleImage write SetTitleImage;
    property TitleFillDirect : TFillDirection read FTitleFillDirect write SetTitleFillDirect;
    property TitleImageAlign : TTitleImageAlign read FTitleImageAlign write SetTitleImageAlign;
    property TitleImageTransparent : Boolean read FTitleImageTransparent write SetTitleImageTransparent default True;
    property TitleButtons : TTitleButtons read FTitleButtons write SetTitleButtons;

    //property BorderSize  : Integer read FBorderSize write SetBorderSize default 1;
    property Animation : Boolean read FAnimation write SetAnimation default True;
    property DefaultHeight : Integer read FDefaultHeight write SetDefaultHeight;
    property Movable : Boolean read FMovable write SetMovable default False;
    property Sizable : Boolean read FSizable write SetSizable default False;
    property ShowBorder  : Boolean read FShowBorder write SetShowBorder default True;
    property BorderColor : TColor read FBorderColor write SetBorderColor;
    property RoundedCorner : TRoundedCorners read FRoundedCorner write SetRoundedCorner default [rcTopLeft, rcTopRight];
    property BGImage : TBitmap read FBGImage write SetBGImage;
    property BGImageAlign : TBGImageAlign read FBGImageAlign write SetBGImageAlign;
    property BGImageTransparent : Boolean read FBGImageTransparent write SetBGImageTransparent default True;
    property Color;
    property Align;
    property Visible;
    property TabOrder;
    property TabStop;
    property DragMode;

    //Events
    property OnResize;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnEnter;
    property OnExit;
    //
    property AfterMinimized : TAfterSizeChanged read FAfterMinimized write FAfterMinimized;
    property AfterMaximized : TAfterSizeChanged read FAfterMaximized write FAfterMaximized;
    property BeforeMove     : TNotifyEvent read FBeforeMoving write FBeforeMoving;
    property AfterMove      : TNotifyEvent read FAfterMoving write FAfterMoving;
    property AfterClose : TNotifyEvent read FAfterClose write FAfterClose;
    property OnTitleClick : TNotifyEvent read FOnTitleClick write FOnTitleClick;
    property OnTitleDblClick : TNotifyEvent read FOnTitleDblClick write FOnTitleDblClick;
    property OnTitleMouseDown : TMouseEvent read FOnTitleMouseDown write FOnTitleMouseDown;
    property OnTitleMouseUp : TMouseEvent read FOnTitleMouseUp write FOnTitleMouseUp;
    property OnTitleMouseEnter: TNotifyEvent read FOnTitleMouseEnter write FOnTitleMouseEnter;
    property OnTitleMouseExit : TNotifyEvent read FOnTitleMouseExit write FOnTitleMouseExit;
    property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseExit : TNotifyEvent read FOnMouseExit write FOnMouseExit;
    //
  end;

procedure Register;

implementation

constructor TxpPanel.Create(AOwner: TComponent);
begin
  inherited Create (AOwner);

  FGradientFill := true;
  FStartColor := clXPStartBGColor;
  FEndColor := clXPEndBGColor;
  FFillDirection := fdLeftToRight;
  FShadow := true;
  FShadowDist := 5;

  Width := 180;
  Height := 60;

  FShowHeader := True;
  FCaption := 'xpPanel';
  FDefaultHeight := 60;

  FTitle := 'xpPanelTitle';
  FTitleHeight := 30;
  FTitleAlignment := taCenter;
  FTitleShadowOnMouseEnter := true;
  FTitleGradient := true;
  FTitleStartColor := clXPTitleStartColor;
  FTitleEndColor := clXPTitleEndColor;
  FTitleColor := clWhite;
  FTitleFillDirect := fdLeftToRight;

  FTitleImage := TBitmap.Create;
  FTitleCursor := crSystemHand;
  FTitleImageTransparent := true;
  FTitleImageAlign := tiaLeft;

  FTitleFont := TFont.Create;
  FTitleFont.Style := [fsBold];
  FTitleFont.Color := clNavy;
  FTitleFont.OnChange := OnTitleFontChange;
  TitleButtons := [tbMinimize];

  FMouseOnHeader := False;

  FBorderSize := 1;
  FShowBorder := True;
  FBorderColor := clWhite;
  FRoundedCorner := [rcTopLeft, rcTopRight];

  FBGImage := TBitmap.Create;
  FBGImageAlign := iaStretch;
  FBGImageTransparent := true;

  FOnTitleClick := nil;
  FOnTitleDblClick := nil;
  FOnTitleMouseDown := nil;
  FOnTitleMouseUp := nil;
  FOnTitleMouseEnter := nil;
  FOnTitleMouseExit := nil;
  FOnMouseEnter := nil;
  FOnMouseExit := nil;

  FAfterMinimized   := nil;
  FAfterMaximized   := nil;
  FBeforeMoving     := nil;
  FAfterMoving      := nil;
  FAfterClose       := nil;

  BorderStyle := bsNone;

  FMovable := False;
  FSizable := False;
  FMinimized := False;
  FAnimation := True;

  FMinimizing := False;
  //FullRepaint := False;
end;

destructor  TxpPanel.Destroy;
begin
  try FTitleFont.Free; except end;
  try FBGImage.Free; except end;
  try FTitleImage.Free; except end;
  inherited;
end;

procedure TxpPanel.DrawTitle (ACanvas : TCanvas; ATitleRect : TRect);
var
  X, Y : Integer;
  AGrayImage : TBitmap;
  ATextFormat : Integer;
  ATextRect : TRect;
  ABtnOffset : Integer;
begin
  if FTitleGradient then
    GradientFillRect (ACanvas, ATitleRect, FTitleStartColor, FTitleEndColor, FTitleFillDirect, 50)
  else
  begin
    ACanvas.Brush.Style := bsSolid;
    ACanvas.Brush.Color := FTitleColor;
    ACanvas.FillRect (ATitleRect);
  end;

  ATextRect := ATitleRect;

  InflateRect (ATextRect, -2, -2);

  ABtnOffset := ATextRect.Right;

  if tbMinimize in FTitleButtons then ABtnOffset := FMinBtnRect.Left - 4 else
    if tbMaximize in FTitleButtons then ABtnOffset := FMaxBtnRect.Left - 4 else
      if tbClose in FTitleButtons then ABtnOffset := FCloseBtnRect.Left - 4;

  if not FTitleImage.Empty then
  begin
    FTitleImage.TransparentMode := tmAuto;
    FTitleImage.Transparent := False;

    if (FTitleImageAlign in [tiaLeft, tiaRight, tiaCenter]) then
    begin
      case FTitleImageAlign of
        tiaLeft:
        begin
          X := 2;
          Y := (ATitleRect.Bottom + ATitleRect.Top - FTitleImage.Height) div 2;
          ATextRect.Left := ATextRect.Left + FTitleImage.Width + 8;
        end;
        tiaRight:
        begin
          X := ABtnOffset - FTitleImage.Width;
          Y := (ATitleRect.Bottom + ATitleRect.Top - FTitleImage.Height) div 2;
          ABtnOffset := X - 4;
        end;
        tiaCenter:
        begin
          X := (ATitleRect.Right + ATitleRect.Left - FTitleImage.Width) div 2;
          Y := (ATitleRect.Bottom + ATitleRect.Top - FTitleImage.Height) div 2;
        end;
      end;
      //Image Shadow
      if FMouseOnHeader then
      begin
        AGrayImage := TBitmap.Create;
        try
          CopyBitmap (FTitleImage, AGrayImage);
          AGrayImage.TransparentMode := tmAuto;
          AGrayImage.Transparent := true;
          ConvertBitmapToGrayscale (AGrayImage);
          if FTitleImageTransparent then
            DrawBitmapTransparent (ACanvas, X, Y, AGrayImage, AGrayImage.Canvas.Pixels [0,0])
          else
            ACanvas.Draw (X, Y, AGrayImage);
        finally
          AGrayImage.Free;
        end;