xpwindow.pas

非常好的xp界面控件

unit xpWindow;

interface

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

const
  cRoundedCorderRadius : Integer = 14;

  clxpBorderColor : TColor = $00D42504;
  clxpBorderInActiveColor : TColor = $00DEB3A1;

  clxpActiveTitleStartColor : TColor = $00E44C00;
  clxpActiveTitleEndColor : TColor = $00FE7105;

  clxpInActiveTitleStartColor : TColor = $00EAB496;
  clxpInActiveTitleEndColor : TColor = $00E7A480;


  csbMinButton   = 1;
  csbMaxButton   = 2;
  csbCloseButton = 3;

type
  TWindowSizeInfo = class (TPersistent)
    private
      FActive : Boolean;

      FMaxSizeWidth: Integer;
      FMaxSizeHeight: Integer;
      FMaxPositionX: Integer;
      FMaxPositionY: Integer;
      FMinTrackWidth: Integer;
      FMinTrackHeight: Integer;
      FMaxTrackWidth: Integer;
      FMaxTrackHeight: Integer;

      FUseSystemSettings : Boolean;

      procedure SetSystemSettings (AValue : Boolean);

      procedure SetMaxSizeWidth (AValue : Integer);
      procedure SetMaxSizeHeight (AValue : Integer);
      procedure SetMaxPositionX (AValue : Integer);
      procedure SetMaxPositionY (AValue : Integer);
      procedure SetMinTrackWidth (AValue : Integer);
      procedure SetMinTrackHeight (AValue : Integer);
      procedure SetMaxTrackWidth (AValue : Integer);
      procedure SetMaxTrackHeight (AValue : Integer);
    public
      constructor Create;
      destructor  Destroy; override;

    published
      property Active : Boolean read FActive write FActive default False;
      property MaxSizeWidth: Integer read FMaxSizeWidth write SetMaxSizeWidth;
      property MaxSizeHeight: Integer read FMaxSizeHeight write SetMaxSizeHeight;
      property MaxPositionX: Integer read FMaxPositionX write SetMaxPositionX;
      property MaxPositionY: Integer read FMaxPositionY write SetMaxPositionY;
      property MinTrackWidth: Integer read FMinTrackWidth write SetMinTrackWidth;
      property MinTrackHeight: Integer read FMinTrackHeight write SetMinTrackHeight;
      property MaxTrackWidth: Integer read FMaxTrackWidth write SetMaxTrackWidth;
      property MaxTrackHeight: Integer read FMaxTrackHeight write SetMaxTrackHeight;

      property UseSystemSettings : Boolean read FUseSystemSettings write SetSystemSettings default True;
  end;

{******************************************************************************}
{*************************** T S T I C K W I N D O W **************************}
{******************************************************************************}

  TDockBorder = (dbLeft, dbRight, dbTop, dbBottom);
  TDockBorders = Set of TDockBorder;

  TStickWindow = class (TPersistent)
    private
      FActive : Boolean;
      FStickAt : Integer;
      FDockBorders : TDockBorders;

      procedure SetActive (AActive : Boolean);
      procedure SetStickAt (AStickAt : Integer);

      procedure DoStick (var AMessage : TMessage);
    public
      constructor Create;
      destructor  Destroy; override;
    published
      property Active : Boolean read FActive write SetActive default False;
      property StickAt : Integer read FStickAt write SetStickAt default 20;
      property DockBorders : TDockBorders read FDockBorders write FDockBorders default [dbLeft, dbRight, dbTop, dbBottom];
  end;

{******************************************************************************}
{*************************** T X P C A  P T I O N ****************************}
{******************************************************************************}

  TgbImageAlign = (iaLeft, iaRight, iaCenter, iaStretch, iaTile);
  TTitleButtonState = (tbsNormal, tbsActive, tbsDowned, tbsDisabled);

  TOnCustomButtonDraw = procedure (Sender: TObject; ACanvas : TCanvas; AButtonRect : TRect; AButtonIndex : Integer; AState : TTitleButtonState) of object;
  TOnCustomButtonClick = procedure (Sender: TObject; AButtonIndex : Integer) of object;
  TOnCustomDrawTitle = procedure (Sender: TObject; ACanvas : TCanvas; ATitleRect : TRect; AActive : Boolean; var AContinue : Boolean) of object;
  TOnCustomDrawBorder = procedure (Sender: TObject; ACanvas : TCanvas; ARect : TRect; AActive : Boolean; var AContinue : Boolean) of object;

  TxpWindow = class;

  TxpCaption = class (TPersistent)
    private
      FActive : Boolean;
      FActiveWindow : Boolean;
      FxpWindow : TxpWindow;
      FHeight : Integer;
      FVisible : Boolean;
      FShowBorder : Boolean;
      FBorderSize : Integer;
      FBorderColor : TColor;
      FBorderInActiveColor : TColor;
      FBtnBorderColor : TColor;

      FButtonSize : Integer;
      FCustomButtonCount : Integer;
      FDownedButton : Integer;
      FLastActiveButton : Integer;

      FFont : TFont;

      FbgImage : TBitmap;
      FImageAlign : TgbImageAlign;
      FImageTransparent : Boolean;

      FGradientFill : Boolean;
      FFillDirection : TFillDirection;

      FActiveStartColor : TColor;
      FActiveEndColor : TColor;
      FInActiveStartColor : TColor;
      FInActiveEndColor : TColor;

      FDisplayAppIcon : Boolean;
      FIconMarginLeft : Integer;
      FIconMarginTop  : Integer;

      FRoundedCorners : TRoundedCorners;
      FRoundedCornerRadius : Integer;

      FOrignDLGFRAME : Boolean;

      FInternalDrawBorder : TOnCustomDrawBorder;
      FInternalDrawTitle  : TOnCustomDrawTitle;
      FInternalSysBtnDraw : TOnCustomButtonDraw;

      procedure SetActive (AActive : Boolean);
      procedure Draw (var AMessage : TMessage);
      procedure ProcessClientArea (var AMessage : TMessage);
      procedure ProcessHitTest (var AMessage : TMessage);

      procedure SetHeight (AHeight : Integer);
      procedure SetVisible (AVisible : Boolean);
      procedure SetFont (AValue : TFont);

      procedure SetBGImage (AImage : TBitmap);
      procedure SetImageAlign (AImageAlign : TgbImageAlign);
      procedure SetImageTransparent (AValue : Boolean);

      procedure SetGradientFill (AValue : Boolean);
      procedure SetGradFillDirection (ADirection : TFillDirection);

      procedure SetActiveStartColor (AColor : TColor);
      procedure SetActiveEndColor (AColor : TColor);
      procedure SetInActiveStartColor (AColor : TColor);
      procedure SetInActiveEndColor (AColor : TColor);

      procedure SetShowBorder (AValue : Boolean);
      procedure SetBorderSize (AValue : Integer);
      procedure SetBorderColor (AValue : TColor);
      procedure SetBorderInActiveColor (AValue : TColor);

      procedure SetButtonSize (AValue : Integer);
      procedure SetCustomButtonCount (AValue : Integer);
      procedure SetBtnBorderColor (AValue : TColor);

      procedure SetRoundedCorners (AValue : TRoundedCorners);
      procedure SetRoundedCornerRadius (AValue : Integer);

      procedure SetDisplayAppIcon (AValue : Boolean);
      procedure SetIconMarginLeft (AValue : Integer);
      procedure SetIconMarginTop (AValue : Integer);

      //////////////////////////////////////////////////////////////////////////
      procedure DrawBorder (ACanvas : TCanvas; ABorderRect : TRect);
      procedure DrawTitle (ACanvas : TCanvas; ATitleRect : TRect);
      procedure DrawButtons (ACanvas : TCanvas; ATitleRect : TRect);
      function  PtInButton (APoint : TPoint; ATitleRect : TRect) : Integer;
      procedure ChangeButtonState (AIndex : Integer; AState : TTitleButtonState; ATitleRect : TRect);
      function  GetSysButtonCount : Integer;

      procedure WMNCCreate (var Message : TMessage);
      function ProcessLButtonDown (var Message : TMessage) : Boolean;
      function ProcessLButtonUp (var Message : TMessage) : Boolean;

      procedure DrawCloseButtonImage (ACanvas : TCanvas; ARect : TRect; AState : TTitleButtonState);
      procedure DrawMaxButtonImage (ACanvas : TCanvas; ARect : TRect; AState : TTitleButtonState);
      procedure DrawMinButtonImage (ACanvas : TCanvas; ARect : TRect; AState : TTitleButtonState);
      //////////////////////////////////////////////////////////////////////////
      procedure FOnFontChange (Sender : TObject);

      //////////////////////////////////////////////////////////////////////////
      /////      Custom drawing procedures for different window styles       ///
      //////////////////////////////////////////////////////////////////////////
      procedure DrawBorderICQ (Sender: TObject; ACanvas : TCanvas; ARect : TRect; AActive : Boolean; var AContinue : Boolean);
      procedure DrawSysBtnICQ (Sender: TObject; ACanvas : TCanvas; AButtonRect : TRect; AButtonIndex : Integer; AState : TTitleButtonState);
    public
      constructor Create (AOwner : TxpWindow);
      destructor  Destroy; override;

      procedure ForceRedraw;
      procedure DrawButtonRect (ACanvas : TCanvas; AButtonRect : TRect; AState : TTitleButtonState; CloseBtn : Boolean);

      procedure ApplyStyle (AStyle : TxpWindowStyle);
    published
      property Active : Boolean read FActive write SetActive default False;
      property Height : Integer read FHeight write SetHeight default 30;
      property Visible : Boolean read FVisible write SetVisible default True;
      property Image : TBitmap read FbgImage write SetBGImage;
      property ImageAlign : TgbImageAlign read FImageAlign write SetImageAlign;
      property ImageTransparent : Boolean read FImageTransparent write SetImageTransparent default True;
      property Font : TFont read FFont write SetFont;

      property ShowBorder : Boolean read FShowBorder write SetShowBorder default true;
      property BorderSize : Integer read FBorderSize write SetBorderSize default 3;
      property BorderColor : TColor read FBorderColor write SetBorderColor;
      property BorderInActiveColor : TColor read FBorderInActiveColor write SetBorderInActiveColor;
      property ButtonSize : Integer read FButtonSize write SetButtonSize default 20;
      property CustomButtonCount : Integer read FCustomButtonCount write SetCustomButtonCount default 0;
      property BtnBorderColor : TColor read FBtnBorderColor write SetBtnBorderColor;
      property RoundedCorners : TRoundedCorners read FRoundedCorners write SetRoundedCorners;
      property RoundedCornerRadius : Integer read FRoundedCornerRadius write SetRoundedCornerRadius;

      property DisplayAppIcon : Boolean read FDisplayAppIcon write SetDisplayAppIcon default true;
      property IconMarginLeft : Integer read FIconMarginLeft write SetIconMarginLeft default 3;
      property IconMarginTop : Integer read FIconMarginTop write SetIconMarginTop default 2;

      property GradientFill : Boolean read FGradientFill write SetGradientFill;
      property FillDirection : TFillDirection  read FFillDirection write SetGradFillDirection;

      property ActiveStartColor : TColor read FActiveStartColor write SetActiveStartColor;
      property ActiveEndColor : TColor read FActiveEndColor write SetActiveEndColor;
      property InActiveStartColor : TColor read FInActiveStartColor write SetInActiveStartColor;
      property InActiveEndColor : TColor read FInActiveEndColor write SetInActiveEndColor;

  end;

{******************************************************************************}
{****************** T X P W I N D O W B A C K G R O U N D *********************}
{******************************************************************************}

  TwgbStyle = (wbgNone, wbgGradient, wbgTiled, wbgStretched);

  TxpWindowBackground = class (TPersistent)
    private
      FActive : Boolean;
      FxpWindow : TxpWindow;
      FCanvas : TControlCanvas;

      FbgImage : TBitmap;
      FBGStyle : TwgbStyle;

      FFillDirection : TFillDirection;

      FStartColor : TColor;
      FEndColor : TColor;

    protected
      procedure SetActive (AValue : Boolean);
      procedure SetImage (AValue : TBitmap);
      procedure SetStyle (AValue : TwgbStyle);
      procedure SetGradFillDir (AValue : TFillDirection);
      procedure SetStartColor (AValue : TColor);
      procedure SetEndColor (AValue : TColor);

      procedure DrawBackground (var Message : TMessage);
    public
      constructor Create (AOwner : TxpWindow);
      destructor  Destroy; override;
    published
      property Active : Boolean read FActive write SetActive default False;
      property Style : TwgbStyle read FBGStyle write SetStyle;
      property GradientFillDir : TFillDirection read FFillDirection write SetGradFillDir;
      property StartColor : TColor read FStartColor write SetStartColor;
      property EndColor : TColor read FEndColor write SetEndColor;
      property Image : TBitmap read FbgImage write SetImage;
  end;

{******************************************************************************}
{*****************************   T X P W I N D O W  ***************************}
{******************************************************************************}

  TxpWindow = class(TComponent)
  private
    FActive : Boolean;
    FForm   : TForm;
    FOriginalRgn : HRgn;
    FSizeInfo : TWindowSizeInfo;

    FWindowProc : Pointer;
    FOldWindowProc : Pointer;

    FClientOldWindowProc : TFarProc;

    FStickWindow : TStickWindow;
    FxpCaption : TxpCaption;
    FxpWindowBG : TxpWindowBackground;

    FOriginalCaptionVisibility : Boolean;

    FxpStyle : TxpWindowStyle;

    FVScrollVisible : Boolean;
    FHScrollVisible : Boolean;

    FOnCustomButtonDraw : TOnCustomButtonDraw;
    FOnCustomButtonClick : TOnCustomButtonClick;
    FOnCustomSysBtnDraw : TOnCustomButtonDraw;
    FOnCustomDrawTitle : TOnCustomDrawTitle;
    FOnCustomBorderDraw : TOnCustomDrawBorder;

    procedure HookedWindowProc (var Msg: TMessage);
    procedure ClientHookedWindowProc (var Msg: TMessage);
    procedure HookWindow;
    procedure UnHookWindow;

    procedure SetMinMaxInfo (var AMessage : TMessage);

    procedure SetFormShape (ARoundedCorner : TRoundedCorners);
    procedure RestoreFormShape;

    procedure SetActive (AActive : Boolean);
    function  GetActive : Boolean;

    procedure SetSizeInfo (AInfo : TWindowSizeInfo);
    function  GetSizeInfo : TWindowSizeInfo;

    procedure SetStickWindow (AStick : TStickWindow);
    procedure SetXPCaption (ACaption : TxpCaption);
    procedure SetXPWindowBG  (AValue : TxpWindowBackground);

    procedure SaveOrignCaptionVisibility;
    procedure SetXPStyle (AValue : TxpWindowStyle);

    function IsVScrollVisible : Boolean;
    function IsHScrollVisible : Boolean;

  protected
    function  GetWindowShape (ARoundedCorner : TRoundedCorners) : hRgn; virtual;

    function  CheckScrollVisibleChanging : Boolean;

    procedure Loaded; override;
    procedure CaptionVisible (AVisible : Boolean);
  public
    procedure ForceReDraw;
    procedure ApplyStyleColors (AStyle : TxpWindowStyle);
    
    constructor Create (AOwner : TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property Active : Boolean read GetActive write SetActive default False;
    property SizeInfo : TWindowSizeInfo read FSizeInfo write SetSizeInfo;
    property StickWindow : TStickWindow read FStickWindow write SetStickWindow;
    property xpCaption : TxpCaption read FxpCaption write SetXPCaption;
    property WinBackground : TxpWindowBackground read FxpWindowBG write SetXPWindowBG;
    property Style : TxpWindowStyle read FxpStyle write SetXPStyle;

    ////////////////////////////////////////////////////////////////////////////
    property OnCustomButtonDraw : TOnCustomButtonDraw read FOnCustomButtonDraw write FOnCustomButtonDraw;
    property OnCustomButtonClick : TOnCustomButtonClick read FOnCustomButtonClick write FOnCustomButtonClick;
    property OnCustomDrawTitle : TOnCustomDrawTitle read FOnCustomDrawTitle write FOnCustomDrawTitle;
    property OnCustomSysBtnDraw : TOnCustomButtonDraw read FOnCustomSysBtnDraw write FOnCustomSysBtnDraw;
    property OnCustomBorderDraw : TOnCustomDrawBorder read FOnCustomBorderDraw write FOnCustomBorderDraw;

  end;

procedure Register;

implementation

{$R *.res}

{******************************************************************************/
/******************* TWindowSizeInfo methods implementation  ******************/
/******************************************************************************}


constructor TWindowSizeInfo.Create;
begin
  inherited;
  FActive := False;