advofficetabset.pas

一个非常棒的控件.做商业软件特别适用.里面的控件涉及面非常的广,有兴趣的话可以下来用用就知道了.

    FControlList: TDbgList;
    FTabAppearance: TTabAppearance;
    FRoundEdges: Boolean;
    FAutoThemeAdapt: boolean;
    FGlowButtonAppearance: TGlowButtonAppearance;
    FBlendFactor: Integer;
    FButtonBorderColor: TColor;
    procedure OnTabAppearanceChanged(Sender: TObject);
    procedure OnGlowButtonAppearanceChanged(Sender: TObject);
    procedure SetRoundEdges(const Value: boolean);
    procedure SetTabAppearance(const Value: TTabAppearance);
    procedure SetGlowButtonAppearance(const Value: TGlowButtonAppearance);
    procedure SetButtonBorderColor(const Value: TColor);
  protected
    procedure AddControl(AControl: TCustomControl);
    procedure RemoveControl(AControl: TCustomControl);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Change(PropID: integer);
    property BlendFactor: Integer read FBlendFactor write FBlendFactor;

    property AutoThemeAdapt: boolean read FAutoThemeAdapt write FAutoThemeAdapt default False;
    property TabAppearance: TTabAppearance read FTabAppearance write SetTabAppearance;  // 1
    property RoundEdges: boolean read FRoundEdges write SetRoundEdges default True;   // 3
    property ButtonBorderColor: TColor read FButtonBorderColor write SetButtonBorderColor;
    property GlowButtonAppearance: TGlowButtonAppearance read FGlowButtonAppearance write SetGlowButtonAppearance; // 4
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure Assign(Source: TPersistent); override;
  end;

  TDummyHintControl = class(TControl)
  private
    FOfficeHint: TAdvHintInfo;
    procedure SetOfficeHint(const Value: TAdvHintInfo);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OfficeHint: TAdvHintInfo read FOfficeHint write SetOfficeHint;
  end;

  TOfficeTabCollectionItem = class(TCollectionItem)
  private
    FCaption: string;
    FVisible: Boolean;
    FTag: integer;
    FImageIndex: Integer;
    FEnabled: boolean;
    FTimer: TTimer;
    FTimeInc: Integer;
    FStepHover: Integer;
    FStepPush: Integer;
    FGlowState: TGlowState;  
    FIPicture: TGDIPPicture;
    FIDisabledPicture: TGDIPPicture;
    FOfficeHint: TAdvHintInfo;
    procedure TimerProc(Sender: TObject);
    procedure PictureChanged(Sender: TObject);
    procedure SetCaption(const Value: string);
    procedure SetVisible(const Value: Boolean);
    procedure SetImageIndex(const Value: Integer);
    procedure SetEnabled(const Value: boolean);
    procedure SetDisabledPicture(const Value: TGDIPPicture);
    procedure SetPicture(const Value: TGDIPPicture);
    procedure SetOfficeHint(const Value: TAdvHintInfo);
  protected
    function GetDisplayName: string; override;
    procedure SetIndex(Value: Integer); override;
    procedure Refresh;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Caption: string read FCaption write SetCaption;
    property Enabled: boolean read FEnabled write SetEnabled default true;
    property Visible: Boolean read FVisible write SetVisible default true;
    property ImageIndex: Integer read FImageIndex write SetImageIndex default -1;
    property DisabledPicture: TGDIPPicture read FIDisabledPicture write SetDisabledPicture;
    property Picture: TGDIPPicture read FIPicture write SetPicture;
    property OfficeHint: TAdvHintInfo read FOfficeHint write SetOfficeHint;
    property Tag: integer read FTag write FTag default 0;
  end;

  TOfficeTabCollection = class(TCollection)
  private
    FOwner: TAdvOfficeTabSet;
    function GetItem(Index: Integer): TOfficeTabCollectionItem;
    procedure SetItem(Index: Integer; const Value: TOfficeTabCollectionItem);
  protected
  public
    constructor Create(AOwner: TAdvOfficeTabSet);
    property Items[Index: Integer]: TOfficeTabCollectionItem read GetItem write SetItem; default;
    property AdvOfficeTabSet: TAdvOfficeTabSet read FOwner;
    function Add: TOfficeTabCollectionItem;
    function Insert(Index: Integer): TOfficeTabCollectionItem;
    function GetOwner: TPersistent; override;
  end;

  TTabChangingEvent = procedure(Sender: TObject; FromTab, ToTab: Integer; var AllowChange: Boolean) of object;
  TOnTabClose = procedure (Sender:TObject; TabIndex: integer; var Allow: boolean) of object;
  TOnTabListClick = procedure (Sender: TObject; X, Y: integer) of object;

  TAdvOfficeTabSet = class(TCustomControl)
  private
    FInternalOfficeTabSetStyler: TCustomAdvOfficeTabSetStyler;
    FOfficeTabSetStyler: TCustomAdvOfficeTabSetStyler;
    FCurrentOfficeTabSetStyler: TCustomAdvOfficeTabSetStyler;
    FOffSetY: integer;
    FOffSetX: integer;
    //FAdvPages: TDbgList;
    FAdvOfficeTabs: TOfficeTabCollection;
    FPropertiesLoaded: Boolean;
    FShowNonSelectedTabs: Boolean;
    FTabSettings: TTabSetTabSettings;
    FTabScroller: TTabSetTabScroller;
    FActiveTabIndex: Integer;
    FHotTabIndex: Integer;
    FDownTabIndex: Integer;
    FOldHotTabIndex: Integer;
    FHintTabIndex: Integer;
    FImages: TCustomImageList;
    FDisabledImages: TCustomImageList;
    //FScrollerHoverLeftBtn: Boolean;
    //FScrollerDownLeftBtn: Boolean;
    //FScrollerHoverRightBtn: Boolean;
    //FScrollerDownRightBtn: Boolean;
    FShowTabHint: Boolean;
    FOnChange: TNotifyEvent;
    FOnChanging: TTabChangingEvent;
    FOldCapRightIndent: Integer;
    FOfficeHint: TAdvHintInfo;
    FTabPosition: TTabPosition;
    FAntiAlias: TAntiAlias;
    FButtonSettings: TTabSetButtonSettings;
    FTabListMenu: TPopupMenu;
    FOnTabClose: TOnTabClose;
    FOnTabListClick: TOnTabListClick;
    FRotateTabLeftRight: Boolean;
    FCloseOnTab: Boolean;
    FCloseButton: TAdvGlowButton;
    FTabListButton: TAdvGlowButton;
    FScrollPrevButton: TAdvGlowButton;
    FScrollNextButton: TAdvGlowButton;
    FTabOffSet: Integer;
    FUseMaxSpace: Boolean;
    FFreeOnClose: Boolean;
    FDummyHintControl: TDummyHintControl;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure CMControlChange(var Message: TCMControlChange); message CM_CONTROLCHANGE;
    procedure CMControlListChange(var Message: TCMControlListChange); message CM_CONTROLLISTCHANGE;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure OnTabSettingsChanged(Sender: TObject);
    procedure OnButtonSettingChanged(Sender: TObject);
    procedure OnCloseButtonClick(Sender: TObject);
    procedure OnTabListButtonClick(Sender: TObject);
    procedure OnTabListMenuClick(Sender: TObject);
    procedure OnScrollPrevButtonClick(Sender: TObject);
    procedure OnScrollNextButtonClick(Sender: TObject);
    procedure OnEnterTab(TabIndex: Integer);
    procedure OnExitTab(TabIndex: Integer);
    //procedure SetPagePosition(AdvPage: TAdvOfficePage);
    //procedure SetAllPagesPosition;
    procedure SetOfficeTabSetStyler(const Value: TCustomAdvOfficeTabSetStyler);
    //function GetAdvOfficePageCount: integer;
    //function GetAdvPages(index: integer): TAdvOfficePage;
    function GetPopupMenuEx: TPopupMenu;
    procedure SetPopupMenuEx(const Value: TPopupMenu);
    procedure SetShowNonSelectedTabs(const Value: Boolean);
    //function GetActivePage: TAdvOfficePage;
    function GetActiveTabIndex: Integer;
    //procedure SetActivePage(const Value: TAdvOfficePage);
    procedure SetActiveTabIndex(const Value: Integer);
    procedure SetTabSettings(const Value: TTabSetTabSettings);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetDisabledImages(const Value: TCustomImageList);
    function GetVersion: string;
    procedure SetVersion(const Value: string);
    procedure SetOfficeHint(const Value: TAdvHintInfo);
    procedure SetTabPosition(const Value: TTabPosition);
    procedure SetAntiAlias(const Value: TAntiAlias);
    procedure SetButtonSettings(const Value: TTabSetButtonSettings);
    procedure SetTabListMenu(const Value: TPopupMenu);
    procedure SetCloseOnTab(const Value: Boolean);
    procedure SetRotateTabLeftRight(const Value: Boolean);
    procedure SetAdvOfficeTabs(Value: TOfficeTabCollection);
  protected
    procedure AlignControls(AControl: TControl; var ARect: TRect); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure DrawTab(TabIndex: Integer);
    procedure DrawAllTabs;
    //procedure DrawTabScrollBtnLeft;
    //procedure DrawTabScrollBtnRight;
    procedure DrawTabScrollButtons;
    procedure Paint; override;

    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
    //procedure SetAdvPageBounds(AdvPage: TAdvOfficePage; var ALeft, ATop, AWidth, AHeight: Integer);

    procedure UpdateMe(PropID: integer);
    procedure ChangeActiveTab(TabIndex: Integer);

    procedure UpdateTabScroller;
    procedure ScrollLeftBtnClick;
    procedure ScrollRightBtnClick;

    procedure InitializeAndUpdateButtons;
    function AnyButtonVisible: Boolean;

    function CanShowTab(TabIndex: Integer): Boolean;
    function GetVisibleTabCount: Integer;

    procedure InvalidateTab(TabIndex: Integer);
    function GetButtonsRect: TRect;
    function GetTabsArea: TRect;
    function GetTabsRect: TRect;
    function GetTabRect(StartIndex, TabIndex: Integer; ConsiderTabScroller: Boolean): TRect;  overload;
    function GetTabRect(TabIndex: Integer): TRect; overload;
    function PTOnTab(X, Y: Integer): Integer;
    function GetCloseButtonRect: TRect;
    function GetTabListRect: TRect;
    function GetTabScrollerRect: TRect;
    function GetTabScrollerLeftRect: TRect;
    function GetTabScrollerRightRect: TRect;
    function PtOnTabScrollLeftBtn(X, Y: integer): Boolean;
    function PtOnTabScrollRightBtn(X, Y: integer): Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    procedure CreateParams(var Params: TCreateParams); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

    function GetVersionNr: integer;

    //procedure MoveAdvOfficeTab(CurIndex, NewIndex: Integer);
    function FindNextTab(TabIndex: Integer; GoForward, CheckTabVisible: Boolean): Integer;
    procedure SelectNextTab(GoForward: Boolean);
    //function IndexOfPage(AdvPage: TAdvOfficePage): Integer;
  published
    property AdvOfficeTabs: TOfficeTabCollection read FAdvOfficeTabs write SetAdvOfficeTabs;
    property AdvOfficeTabSetStyler: TCustomAdvOfficeTabSetStyler read FOfficeTabSetStyler write SetOfficeTabSetStyler;
    property Align;
    property Anchors;
    property ActiveTabIndex: Integer read GetActiveTabIndex write SetActiveTabIndex;
    property AntiAlias: TAntiAlias read FAntiAlias write SetAntiAlias default aaClearType;
    property ButtonSettings: TTabSetButtonSettings read FButtonSettings write SetButtonSettings;
    property Constraints;
    property CloseOnTab: Boolean read FCloseOnTab write SetCloseOnTab default false;
    property DisabledImages: TCustomImageList read FDisabledImages write SetDisabledImages;
    property FreeOnClose: boolean read FFreeOnClose write FFreeOnClose default false;
    property Images: TCustomImageList read FImages write SetImages;
    property OfficeHint: TAdvHintInfo read FOfficeHint write SetOfficeHint;
    property TabListMenu: TPopupMenu read FTabListMenu write SetTabListMenu;
    property PopupMenu: TPopupMenu read GetPopupMenuEx write SetPopupMenuEx;
    property RotateTabLeftRight: Boolean read FRotateTabLeftRight write SetRotateTabLeftRight default true;
    property ShowNonSelectedTabs: Boolean read FShowNonSelectedTabs write SetShowNonSelectedTabs default False;
    property ShowTabHint: Boolean read FShowTabHint write FShowTabHint default false;
    property ShowHint;
    property TabPosition: TTabPosition read FTabPosition write SetTabPosition default tpTop;
    property TabSettings: TTabSetTabSettings read FTabSettings write SetTabSettings;
    property Version: string read GetVersion write SetVersion stored false;
    property Visible;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnChanging: TTabChangingEvent read FOnChanging write FOnChanging;
    property OnTabClose: TOnTabClose read FOnTabClose write FOnTabClose;
    property OnTabListClick: TOnTabListClick read FOnTabListClick write FOnTabListClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;    
  end;


implementation


//------------------------------------------------------------------------------

function ColorToARGB(Color: TColor): ARGB;
var
  c: TColor;
begin
  c := ColorToRGB(Color);
  Result := ARGB( $FF000000 or ((DWORD(c) and $FF) shl 16) or ((DWORD(c) and $FF00) or ((DWORD(c) and $ff0000) shr 16)));
end;

//------------------------------------------------------------------------------

procedure DrawGradient(Canvas: TCanvas; FromColor, ToColor: TColor; Steps: Integer; R: TRect; Direction: Boolean);
var
  diffr, startr, endr: Integer;
  diffg, startg, endg: Integer;
  diffb, startb, endb: Integer;
  rstepr, rstepg, rstepb, rstepw: Real;
  i, stepw: Word;

begin
  if Direction then
    R.Right := R.Right - 1
  else
    R.Bottom := R.Bottom - 1;

  if Steps = 0 then
    Steps := 1;

  FromColor := ColorToRGB(FromColor);
  ToColor := ColorToRGB(ToColor);

  startr := (FromColor and $0000FF);
  startg := (FromColor and $00FF00) shr 8;
  startb := (FromColor and $FF0000) shr 16;
  endr := (ToColor and $0000FF);
  endg := (ToColor and $00FF00) shr 8;
  endb := (ToColor and $FF0000) shr 16;

  diffr := endr - startr;
  diffg := endg - startg;
  diffb := endb - startb;

  rstepr := diffr / steps;
  rstepg := diffg / steps;
  rstepb := diffb / steps;

  if Direction then
    rstepw := (R.Right - R.Left) / Steps
  else
    rstepw := (R.Bottom - R.Top) / Steps;

  with Canvas do
  begin
    for i := 0 to steps - 1 do
    begin
      endr := startr + Round(rstepr * i);
      endg := startg + Round(rstepg * i);