skintabs.pas

DynamicSkinForm.v9.15.For.Delphi.BCB 很好的皮肤控件

{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       DynamicSkinForm                                             }
{       Version 9.15                                                }
{                                                                   }
{       Copyright (c) 2000-2008 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: [e-mail]                                 }
{                                                                   }
{*******************************************************************}

unit SkinTabs;

{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}

interface

uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, StdCtrls,
     CommCtrl, ComCtrls, ExtCtrls, SkinData, SkinCtrls, SkinBoxCtrls,
     spUtils, ImgList;
type

  TspSkinCustomTabSheet = class(TTabSheet)
  private
    FWallPaper: TBitMap;
  protected
    ButtonRect: TRect;
    ButtonMouseIn, ButtonMouseDown:Boolean;
    procedure CheckControlsBackground;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetWallPaper(Value: TBitmap);
    procedure CMSENCPaint(var Message: TMessage); message CM_SENCPAINT;
  public
    procedure PaintBG(DC: HDC);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property WallPaper: TBitMap read FWallPaper write SetWallPaper;
  end;

  TspSkinTabSheet = class(TspSkinCustomTabSheet)
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  end;


  TspDrawSkinTabEvent = procedure(TabIndex: Integer; const Rct: TRect; Active,
    MouseIn: Boolean; Cnvs: TCanvas) of object;

  TspCloseEvent = procedure(Sender: TObject; var CanClose: Boolean) of object;

  TspSkinPageControl = class(TPageControl)
  private
    //
    FHideTabs: Boolean;
    FOLdTabPosition: TTabPosition;
    FOldMultiLine: Boolean;
    FOldTabHeight: Integer;
    FCloseSize: Integer;
    FOnClose: TspCloseEvent;
    FOnAfterClose: TNotifyEvent;                                              
    FFreeOnClose: Boolean;
    FIsVistaOS: Boolean;
    FShowCloseButtons: Boolean;
    FTabsBGTransparent: Boolean;
    FActiveTab, FOldActiveTab: Integer;
    FActiveTabIndex, FOldActiveTabIndex: Integer;
    FOnDrawSkinTab: TspDrawSkinTabEvent;
    //
    FImages: TCustomImageList;
    FTempImages: TCustomImageList;
    function GetCloseSize: Integer;
    procedure SetImages(value: TCustomImageList);
    procedure DrawCloseButton(Cnvs: TCanvas; R: TRect;  I, W, H: Integer);
    //
    procedure SetShowCloseButtons(Value: Boolean);
    function GetPosition: Integer;
    function  GetInVisibleItemCount: Integer;
    procedure OnUpDownChange(Sender: TObject);
    procedure DrawTabs(Cnvs: TCanvas);
    procedure DrawTab(TI: Integer; const Rct: TRect; Active, MouseIn: Boolean; Cnvs: TCanvas);
    function GetItemRect(index: integer): TRect;
    procedure SetItemSize(AWidth, AHeight: integer);
    procedure CheckScroll;
    procedure ShowSkinUpDown;
    procedure HideSkinUpDown;
    procedure TestActive(X, Y: Integer);
    procedure SetTabsBGTransparent(Value: Boolean);
    procedure DrawEmptyBackGround(DC: HDC);
    function CheckVisibleTabs: Boolean;
    function GetActiveTabRect: TRect;
  protected
    //
    FSD: TspSkinData;
    FSkinDataName: String;
    FIndex: Integer;
    FSkinUpDown: TspSkinUpDown;
    FDefaultFont: TFont;
    FUseSkinFont: Boolean;
    FDefaultItemHeight: Integer;
    CloseButtonRect, ClosebuttonActiveRect, CloseButtonDownRect: TRect;
    ButtonTransparent: Boolean;
    ButtonTransparentColor: TColor;
    procedure SetDefaultItemHeight(Value: Integer);
    procedure SetDefaultFont(Value: TFont);
    procedure Change; override;
    procedure Change2;
    procedure GetSkinData;
    //
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure SetSkinData(Value: TspSkinData);
    procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure WMHSCROLL(var Msg: TWMEraseBkGnd); message WM_HSCROLL;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure PaintDefaultWindow(Cnvs: TCanvas);
    procedure PaintSkinWindow(Cnvs: TCanvas);
    procedure PaintWindow(DC: HDC); override;
    procedure WndProc(var Message:TMessage); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
                        X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
                        X, Y: Integer); override;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure WMCHECKPARENTBG(var Msg: TWMEraseBkgnd); message WM_CHECKPARENTBG;
    procedure DoClose;
    procedure CMSENCPaint(var Message: TMessage); message CM_SENCPAINT;
  public
    //
    Picture: TBitMap;
    SkinRect, ClRect, TabRect,
    ActiveTabRect, FocusTabRect, MouseInTabRect: TRect;
    TabsBGRect: TRect;
    LTPoint, RTPoint, LBPoint, RBPoint: TPoint;
    TabLeftOffset, TabRightOffset: Integer;
    FontName: String;
    FontStyle: TFontStyles;
    FontHeight: Integer;
    FontColor, ActiveFontColor, FocusFontColor, MouseInFontColor: TColor;
    UpDown: String;
    BGPictureIndex: Integer;
    TabStretchEffect: Boolean;
    ShowFocus: Boolean;
    FocusOffsetX, FocusOffsetY: Integer;
    StretchEffect, LeftStretch, TopStretch, RightStretch, BottomStretch: Boolean;
    StretchType: TspStretchType;
    //
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ChangeSkinData;
    procedure Loaded; override;
    procedure UpDateTabs;
    procedure HideTabs;
    procedure ShowTabs;
  published
    property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
    property ShowCloseButtons: Boolean read FShowCloseButtons write SetShowCloseButtons;
    property Images: TCustomImageList read FImages write SetImages;
    property TabsBGTransparent: Boolean read FTabsBGTransparent write SetTabsBGTransparent;
    property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
    property DefaultItemHeight: Integer read FDefaultItemHeight write SetDefaultItemHeight;
    property SkinData: TspSkinData read FSD write SetSkinData;
    property SkinDataName: String read FSkinDataName write FSkinDataName;
    property Color;
    property ActivePage;
    property Align;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property HotTrack;
    // property Images;
    property OwnerDraw;
    property ParentBiDiMode;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property RaggedRight;
    property ScrollOpposite;
    property ShowHint;
    property TabHeight;
    property TabOrder;
    property TabPosition;
    property TabStop;
    property TabWidth;
    property Visible;
    property OnClose: TspCloseEvent read FOnClose write FOnClose;
    property OnAfterClose: TNotifyEvent read FOnAfterClose write FOnAfterClose; 
    property OnChange;
    property OnDrawSkinTab: TspDrawSkinTabEvent
      read FOnDrawSkinTab write FOnDrawSkinTab; 
    property OnChanging;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawTab;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetImageIndex;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

  TspRectArray = array of TRect;
  TspBolArray = array of Boolean;
  TspCloseEvent2 = procedure(Index: Integer; var CanClose: Boolean) of object;

  TspSkinTabControl = class(TTabControl)
  private
    FOnClose: TspCloseEvent2;
    FOnAfterClose: TNotifyEvent;
    TabButtonMouseDown: TspBolArray;
    TabButtonMouseIn: TspBolArray;
    TabButtonR: TspRectArray;
    FCloseSize: Integer;
    FShowCloseButtons: Boolean;
    FTabsBGTransparent: Boolean;
    FOnDrawSkinTab: TspDrawSkinTabEvent;
    FromWMPaint: Boolean;
    FOldTop, FOldBottom: Integer;
    FActiveTab, FOldActiveTab: Integer;
    //
    FImages: TCustomImageList;
    FTempImages: TCustomImageList;
    //
    procedure DrawCloseButton(Cnvs: TCanvas; R: TRect;  I, W, H: Integer);
    procedure SetShowCloseButtons(Value: Boolean);
    function GetPosition: Integer;
    function  GetInVisibleItemCount: Integer;
    procedure OnUpDownChange(Sender: TObject);
    procedure DrawTabs(Cnvs: TCanvas);
    procedure DrawTab(TI: Integer; const Rct: TRect; Active, MouseIn: Boolean; Cnvs: TCanvas);
    function GetItemRect(index: integer): TRect;
    procedure SetItemSize(AWidth, AHeight: integer);
    procedure CheckScroll;
    procedure ShowSkinUpDown;
    procedure HideSkinUpDown;
    procedure TestActive(X, Y: Integer);
    procedure SetTabsBGTransparent(Value: Boolean);
    procedure SetImages(value: TCustomImageList);
  protected
    //
    FSD: TspSkinData;
    FSkinDataName: String;
    FIndex: Integer;
    FSkinUpDown: TspSkinUpDown;
    FDefaultFont: TFont;
    FUseSkinFont: Boolean;
    FDefaultItemHeight: Integer;

    function GetCloseSize: Integer;
    procedure SetDefaultItemHeight(Value: Integer);
    procedure SetDefaultFont(Value: TFont);
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure GetSkinData;
    //
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure SetSkinData(Value: TspSkinData);
    procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure WMHSCROLL(var Msg: TWMEraseBkGnd); message WM_HSCROLL;
    procedure PaintDefaultWindow(Cnvs: TCanvas);
    procedure PaintSkinWindow(Cnvs: TCanvas);
    procedure PaintWindow(DC: HDC); override;
    procedure WndProc(var Message:TMessage); override;
    procedure Change; override;
    procedure Change2;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
                        X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMCHECKPARENTBG(var Msg: TWMEraseBkgnd); message WM_CHECKPARENTBG;
    procedure CheckControlsBackground;
    function GetActiveTabRect: TRect;
    procedure DoClose;
  public

    Picture: TBitMap;
    SkinRect, ClRect, TabRect,
    ActiveTabRect, FocusTabRect, MouseInTabRect: TRect;
    TabsBGRect: TRect;
    LTPoint, RTPoint, LBPoint, RBPoint: TPoint;
    TabLeftOffset, TabRightOffset: Integer;
    FontName: String;
    FontStyle: TFontStyles;
    FontHeight: Integer;
    FontColor, ActiveFontColor, FocusFontColor, MouseInFontColor: TColor;
    UpDown: String;
    BGPictureIndex: Integer;
    TabStretchEffect: Boolean;
    StretchEffect, LeftStretch, TopStretch, RightStretch, BottomStretch: Boolean;
    ShowFocus: Boolean;
    FocusOffsetX, FocusOffsetY: Integer;
    StretchType: TspStretchType;
    CloseButtonRect, ClosebuttonActiveRect, CloseButtonDownRect: TRect;
    ButtonTransparent: Boolean;
    ButtonTransparentColor: TColor;
    //
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ChangeSkinData;
    procedure Loaded; override;
    procedure UpDateTabs;
    //
    procedure PaintBG(DC: HDC);
    //
  published
    property Images: TCustomImageList read FImages write SetImages;
    property ShowCloseButtons: Boolean read FShowCloseButtons write SetShowCloseButtons;
    property TabsBGTransparent: Boolean read FTabsBGTransparent write SetTabsBGTransparent;
    property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
    property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
    property DefaultItemHeight: Integer read FDefaultItemHeight write SetDefaultItemHeight;
    property SkinData: TspSkinData read FSD write SetSkinData;
    property SkinDataName: String read FSkinDataName write FSkinDataName;
    property Color;
    property Align;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property HotTrack;
    property OwnerDraw;
    property ParentBiDiMode;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property RaggedRight;
    property ScrollOpposite;
    property ShowHint;
    property TabHeight;
    property TabOrder;
    property TabPosition;
    property TabStop;
    property TabWidth;
    property Visible;
    property OnClose: TspCloseEvent2 read FOnClose write FOnClose;
    property OnAfterClose: TNotifyEvent read FOnAfterClose write FOnAfterClose;
    property OnDrawSkinTab: TspDrawSkinTabEvent
      read FOnDrawSkinTab write FOnDrawSkinTab;
    property OnChange;
    property OnChanging;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawTab;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetImageIndex;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;


implementation

uses Consts, ComStrs, DynamicSkinForm, spEffBmp;

const
  CLOSE_SIZE = 14;

procedure DrawRotate90_1(Cnvs: TCanvas; B: TBitMap; X, Y: Integer);
var
  B1, B2: TspEffectBmp;
begin
  B1 := TspEffectBmp.CreateFromhWnd(B.Handle);
  B2 := TspEffectBmp.Create(B1.Height, B1.Width);
  B1.Rotate90_1(B2);
  B2.Draw(Cnvs.Handle, X, Y);
  B1.Free;
  B2.Free;
end;

procedure DrawFlipVert(B: TBitMap);
var
  B1, B2: TspEffectBmp;
begin
  B1 := TspEffectBmp.CreateFromhWnd(B.Handle);
  B2 := TspEffectBmp.Create(B1.Width, B1.Height);
  B1.FlipVert(B2);
  B2.Draw(B.Canvas.Handle, 0, 0);
  B1.Free;
  B2.Free;
end;

procedure DrawRotate90_2(Cnvs: TCanvas; B: TBitMap; X, Y: Integer);
var
  B1, B2: TspEffectBmp;
begin
  B1 := TspEffectBmp.CreateFromhWnd(B.Handle);
  B2 := TspEffectBmp.Create(B1.Height, B1.Width);
  B1.Rotate90_2(B2);