Archivado/Componentes.Terceros.SpTBXLib
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
f130fe4cb1
Componentes.Terceros.SpTBXLib/internal/2.4.4/1/Source/SpTBXTabs.pas
david 03dfd8c7c1 Importación inicial 
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.SpTBXLib@4 aa3591e4-a9f2-482a-ba07-9d38a056ee4e
2010-01-19 16:32:53 +00:00

3494 lines
113 KiB
ObjectPascal
Raw Blame History

unit SpTBXTabs;
{==============================================================================
Version 2.4.4
The contents of this file are subject to the SpTBXLib License; you may
not use or distribute this file except in compliance with the
SpTBXLib License.
A copy of the SpTBXLib License may be found in SpTBXLib-LICENSE.txt or at:
http://www.silverpointdevelopment.com/sptbxlib/SpTBXLib-LICENSE.htm
Alternatively, the contents of this file may be used under the terms of the
Mozilla Public License Version 1.1 (the "MPL v1.1"), in which case the provisions
of the MPL v1.1 are applicable instead of those in the SpTBXLib License.
A copy of the MPL v1.1 may be found in MPL-LICENSE.txt or at:
http://www.mozilla.org/MPL/
If you wish to allow use of your version of this file only under the terms of
the MPL v1.1 and not to allow others to use your version of this file under the
SpTBXLib License, indicate your decision by deleting the provisions
above and replace them with the notice and other provisions required by the
MPL v1.1. If you do not delete the provisions above, a recipient may use your
version of this file under either the SpTBXLib License or the MPL v1.1.
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The initial developer of this code is Robert Lee.
Requirements:
For Delphi/C++Builder 2009 or newer:
- Jordan Russell's Toolbar 2000
http://www.jrsoftware.org
For Delphi/C++Builder 7-2007:
- Jordan Russell's Toolbar 2000
http://www.jrsoftware.org
- Troy Wolbrink's TNT Unicode Controls
http://www.tntware.com/delphicontrols/unicode/
Development Notes:
- All the theme changes and adjustments are marked with '[Theme-Change]'.
- When an item is hidden the ItemViewer.BoundsRect property is invalid.
- tbicDeleting item notification is fired after the ItemViewer of the
Item is destroyed by TTBView, but the Items array still has the Item.
TODO:
- Tabbed docking
History:
2 December 2009 - version 2.4.4
- Fixed TabControl flicker when changing the caption of a tab
item, thanks to Simon H. for reporting this.
13 September 2009 - version 2.4.3
- Fixed TabControl flicker when closing/selecting/scrolling
tab items.
- Fixed incorrect TabControl painting when transparent
child controls get invalidated, thanks for Alfred Vink
for reporting this.
- Fixed incorrect TabControl scrolling, thanks to Henner
Drewes for reporting this.
8 May 2009 - version 2.4.2
- Fixed incorrect TabControl behavior, when deleting
the tabs the ActiveTabIndex is incorrectly set if
there are regular Items on the control, thanks to
Jonah for reporting this.
15 March 2009 - version 2.4.1
- No changes.
17 January 2009 - version 2.4
- No changes.
26 September 2008 - version 2.3
- No changes.
29 July 2008 - version 2.2
- No changes.
26 June 2008 - version 2.1
- No changes.
3 May 2008 - version 2.0
- Fixed incorrect close button painting on tab items,
thanks to Miha for reporting this.
2 April 2008 - version 1.9.5
- Fixed incorrect TabControl behavior, when deleting the
only visible Tab all the auto-hidden tabs will not
be showed on resize, thanks to Jim for reporting this.
3 February 2008 - version 1.9.4
- Fixed AV on TabControl when scrolling tabs, thanks
to Beta Xiong and Yucel Yavuz for reporting this.
- Fixed incorrect TabControl.ScrollState behavior
thanks to Michele for reporting this.
19 January 2008 - version 1.9.3
- Fixed recursion on TSpTBXTabToolbar.RightAlignItems,
thanks to Jim for reporting this.
26 December 2007 - version 1.9.2
- Minor bug fixes.
1 December 2007 - version 1.9.1
- Added OnTabClosing event to TSpTBXTabItem.
- Fixed incorrect tab items painting when TabPosition was
ttpBottom, thanks to Marko Savolainen for reporting this.
20 November 2007 - version 1.9
- Added TabBackgroundBorders property to TSpTBXTabSet and
TSpTBXTabControl, when set to true the tabs area is
painted with borders.
- Added TabCloseButton and TabCloseButtonImageIndex properties
to SpTBXTabSet and TSpTBXTabControl to control the close
button visibility on the tab items.
- Added TabMaxSize property to SpTBXTabSet and TSpTBXTabControl
to control the maximum size of the tab items.
- Improved tab scrolling, thanks to Kevin Lu for
reporting this.
8 February 2007 - version 1.8.3
- Added accel char handling to TSpTBXTabSet and TSpTBXTabControl
17 December 2006 - version 1.8.2
- No changes.
24 November 2006 - version 1.8.1
- Fixed incorrect Tab painting when the Default theme was used
and the ThemeType was tttFlat.
27 August 2006 - version 1.8
- Fixed incorrect OnActiveTabChanging handling when
ActiveTabIndex is changed on this event, thanks to
Serg Chechenin for reporting this.
15 June 2006 - version 1.7
- Fixed incorrect Tab painting when the default theme was used,
the captions were painted in a pushed state, thanks to
Mikalai Arapau for reporting this.
- Fixed incorrect Tab aligning when Autofit was used and the
tab control was parented by a Frame, thanks to
Henk van Kampen for reporting this.
12 April 2006 - version 1.5
- Fixed incorrect Tab painting when TabAutofit was true.
27 February 2006 - version 1.4
- Fixed flicker when reordering TSpTBXTabSet and TSpTBXTabControl
tabs, thanks to Alexey Naumov for reporting this.
- Fixed incorrect context menu handling in TSpTBXTabSet and
TSpTBXTabControl, thanks to Boris Yankov for reporting this.
- Added OnActiveTabReorder event to TSpTBXTabSet and TSpTBXTabControl.
10 February 2006 - version 1.3
- Added TabDragReorder property to TSpTBXTabSet and TSpTBXTabControl,
when this property is true it allows tabs reordering with
drag and drop.
- Added TabAutofit and TabAutofitMaxSize properties to TSpTBXTabSet
and TSpTBXTabControl. When TabAutofit is true the tabs are resized
to fit the tabset.
28 December 2005 - version 1.2
- Fixed incorrect TSpTBXTabControl background painting on some themes.
- Fixed incorrect OnActiveTabChange call when the component is being
loaded, thanks to Leroy Casterline for reporting this.
- Fixed incorrect tab scrolling when an item is deleted, thanks to
Daniel Rikowski for reporting this.
18 October 2005 - version 1.1
- Fixed incorrect TSpTBXTabItem painting on some themes.
- Added Margins property to TSpTBXPageControl.
18 August 2005 - version 1.0
- Added TabVisible property to TSpTBXTabSet and TSpTBXPageControl.
- Added OnActiveTabChanging event to TSpTBXTabSet and TSpTBXPageControl.
10 June 2005 - version 0.9
- SpTBXLib may now alternatively, at your option, be used and/or
distributed under the terms of the SpTBXLib License.
Please see the updated LICENSE.TXT file for more information.
- Fixed AV in TSpTBXTabSet and TSpTBXPageControl when used in a Frame
with TabPosition setted to dpBottom, thanks to Cyril Velter for the fix.
20 May 2005 - version 0.8
- Fixed tab scrolling of TSpTBXTabSet and TSpTBXPageControl, the tabs
were not allowed to scroll when one single tab was visible, thanks
to Anders Olsson for the fix.
- Added MakeVisible method to the TSpTBXTabSet and TSpTBXPageControl,
it scrolls the tabset, if necessary, to ensure a Tab is in view.
16 February 2005 - version 0.7
- No changes.
23 December 2004 - version 0.6
- Fixed TSpTBXTabControl reordering bug.
- Changed the order of the TSpTBXTabThemeType enumerated type.
- Added ActivePage property to the TSpTBXTabControl.
- Added Caption, ImageIndex, TabVisible and PopupMenu properties
to TSpTBXTabControl.
30 August 2004 - version 0.5
- No changes.
21 July 2004 - version 0.4
- Fixed TSpTBXTabControl design time bug, it was allowing to drop
components when ActiveTabIndex = -1
- Fixed TSpTBXTabSet and TSpTBXTabControl design time bug, the
hidden items were not streamed to the DFM.
- Changed TSpTBXTabControl.OnTabClick event for OnActiveTabChange.
- Added GetPage method to TSpTBXTabControl to get the TSpTBXTabSheet
linked to a TSpTBXTabItem.
12 July 2004 - version 0.3.1
- Fixed nasty AV when setting TBXSwitcher.EnableXPStyles to false,
thanks to Alfred for reporting this.
Note: TBXThemeManager unloads the theme library and the theme
parts when some conditions are met, we must handle extra theme
parts outside TBXThemeManager space.
- Fixed incorrect TSpTBXTabSet.ActiveTabIndex property update at
design time.
- Fixed incorrect TSpTBXTabSet painting on some TBX themes, thanks
to Tim for reporting this.
9 July 2004 - version 0.3
- Fixed design time AVs when moving or deleting TabSheets.
- Published ThemeType and TabPosition properties for TSpTBXTabItem.
- New component added, TSpTBXTabSet, a fully customizable TabSet
with unicode and toolbar items support.
28 June 2004 - version 0.2
- No changes.
22 June 2004 - version 0.1
- Initial release.
==============================================================================}
interface
{$BOOLEVAL OFF} // Unit depends on short-circuit boolean evaluation
uses
Windows, Messages, Classes, SysUtils, Controls, Graphics, ImgList, Forms,
Dialogs, ExtCtrls, TB2Item, TB2Dock, TB2Toolbar,
SpTBXSkins, SpTBXItem, SpTBXControls;
const
C_SpTBXTabGroupIndex = 7777;
WM_INVALIDATETABBACKGROUND = WM_USER + 7777;
type
TSpTBXTabEdge = (
tedNone, // No edge needed
tedLeft, // Left edge of the tab
tedRight // Right edge of the tab
);
TSpTBXTabPosition = (
ttpTop, // Top aligned tabset
ttpBottom // Bottom aligned tabset
);
TSpTBXTabCloseButton = (
tcbNone, // No close button on tabs
tcbActive, // Close button only on active tab
tcbAll // Close button on all the tabs
);
TSpTBXTabChangeEvent = procedure(Sender: TObject; TabIndex: Integer) of object;
TSpTBXTabChangingEvent = procedure(Sender: TObject; TabIndex, NewTabIndex: Integer; var Allow: Boolean) of object;
TSpTBXTabClosingEvent = procedure(Sender: TObject; var Allow, CloseAndFree: Boolean) of object;
TSpTBXTabToolbar = class;
TSpTBXCustomTabSet = class;
TSpTBXCustomTabControl = class;
TSpTBXTabSheet = class;
TSpTBXTabItemDragObject = class(TSpTBXCustomDragObject)
public
constructor Create(ASourceControl: TControl; AItem: TTBCustomItem); override;
end;
{ TSpTBXTabItem }
TSpTBXTabItem = class(TSpTBXCustomItem)
private
FSkinType: TSpTBXSkinType;
FOnDrawTabCloseButton: TSpTBXDrawImageEvent;
FOnTabClose: TNotifyEvent;
FOnTabClosing: TSpTBXTabClosingEvent;
function GetTabColor: TColor;
function GetSkinType: TSpTBXSkinType;
procedure SetSkinType(const Value: TSpTBXSkinType);
protected
function DialogChar(CharCode: Word): Boolean; override;
procedure DoDrawTabCloseButton(ACanvas: TCanvas; State: TSpTBXSkinStatesType;
const PaintStage: TSpTBXPaintStage; var AImageList: TCustomImageList;
var AImageIndex: Integer; var ARect: TRect; var PaintDefault: Boolean); virtual;
procedure DoTabClose; virtual;
procedure DoTabClosing(var Allow, CloseAndFree: Boolean); virtual;
function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
function GetTabToolbar(out TabToolbar: TSpTBXTabToolbar): Boolean;
procedure ToggleControl; override;
property Control; // TabSheet
property TabColor: TColor read GetTabColor;
public
constructor Create(AOwner: TComponent); override;
procedure Click; override;
procedure TabClose;
function GetNextTab(GoForward: Boolean; SearchType: TSpTBXSearchItemViewerType): TSpTBXTabItem;
function IsFirstVisible: Boolean;
function IsFirstVisibleTab: Boolean;
function IsLastVisibleTab: Boolean;
published
property Action;
property Checked;
// Hide DisplayMode
// property DisplayMode default nbdmImageAndText;
property Enabled;
// Hide GroupIndex, all the TabItems must have the same GroupIndex
// property GroupIndex;
property HelpContext;
property ImageIndex;
property Images;
property InheritOptions;
property MaskOptions;
property Options;
property ShortCut;
property Visible;
property OnClick;
property OnSelect;
// TSpTBXCustomItem properties
property Alignment;
property CustomWidth;
property CustomHeight;
property Margins default 4;
property MinHeight;
property MinWidth;
property FontSettings;
property Wrapping default twEndEllipsis;
property OnDrawImage;
property OnDrawItem;
property OnDrawHint;
property OnDrawCaption;
// TSpTBXTabItem properties
property SkinType: TSpTBXSkinType read GetSkinType write SetSkinType default sknSkin;
property OnDrawTabCloseButton: TSpTBXDrawImageEvent read FOnDrawTabCloseButton write FOnDrawTabCloseButton;
property OnTabClose: TNotifyEvent read FOnTabClose write FOnTabClose;
property OnTabClosing: TSpTBXTabClosingEvent read FOnTabClosing write FOnTabClosing;
end;
TSpTBXTabItemViewer = class(TSpTBXItemViewer)
private
FTabCloseButtonState: TSpTBXSkinStatesType;
function CorrectTabRect(ARect: TRect): TRect;
function GetItem: TSpTBXTabItem;
procedure GetTabCloseButtonImgList(var AImageList: TCustomImageList; var AImageIndex: Integer);
function IsTabCloseButtonVisible: Boolean;
function GetTabPosition: TSpTBXTabPosition;
protected
procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override;
procedure DoDrawButton(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); override;
procedure DoDrawCaption(ACanvas: TCanvas; ClientAreaRect: TRect; State: TSpTBXSkinStatesType;
var ACaption: WideString; var CaptionRect: TRect; var CaptionFormat: Cardinal;
IsTextRotated: Boolean; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); override;
procedure DoDrawImage(ACanvas: TCanvas; State: TSpTBXSkinStatesType;
const PaintStage: TSpTBXPaintStage; var AImageList: TCustomImageList;
var AImageIndex: Integer; var ARect: TRect;
var PaintDefault: Boolean); override;
procedure DoDrawTabCloseButton(ACanvas: TCanvas; State: TSpTBXSkinStatesType;
const PaintStage: TSpTBXPaintStage; var AImageList: TCustomImageList;
var AImageIndex: Integer; var ARect: TRect; var PaintDefault: Boolean); virtual;
procedure DrawBottomBorder(ACanvas: TCanvas; ARect: TRect);
procedure DrawTab(ACanvas: TCanvas; ARect: TRect;
AEnabled, AChecked, AHoverItem: Boolean; Position: TSpTBXTabPosition;
ASeparator: Boolean = False; AEdge: TSpTBXTabEdge = tedNone); virtual;
procedure DrawItemRightImage(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo); override;
function GetRightImageSize: TSize; override;
function GetRightImageRect: TRect;
function GetTextColor(State: TSpTBXSkinStatesType): TColor; override;
procedure InternalMouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure Leaving; override;
public
function IsOnTabToolbar: Boolean;
property Item: TSpTBXTabItem read GetItem; // Hides the inherited TB2K Item property
property TabCloseButtonState: TSpTBXSkinStatesType read FTabCloseButtonState;
property TabPosition: TSpTBXTabPosition read GetTabPosition;
end;
{ TSpTBXTabToolbar }
TSpTBXTabToolbarView = class(TSpTBXToolbarView)
public
procedure BeginUpdate; override;
procedure EndUpdate; override;
end;
TSpTBXTabToolbar = class(TSpTBXToolbar)
private
FActiveTabRect: TRect;
FSkinType: TSpTBXSkinType;
FTabAutofit: Boolean;
FTabAutofitMaxSize: Integer;
FTabCloseButtonImageIndex: Integer;
FTabCloseButton: TSpTBXTabCloseButton;
FTabDragReorder: Boolean;
FTabBackgroundBorders: Boolean;
FTabColor: TColor;
FTabMaxSize: Integer;
FTabPosition: TSpTBXTabPosition;
procedure Scroll(ToRight: Boolean);
function GetActiveTab: TSpTBXTabItem;
procedure SetActiveTabIndex(Value: Integer);
procedure SetSkinType(const Value: TSpTBXSkinType);
procedure SetTabCloseButton(const Value: TSpTBXTabCloseButton);
procedure SetTabCloseButtonImageIndex(const Value: Integer);
procedure SetTabAutofit(const Value: Boolean);
procedure SetTabAutofitMaxSize(const Value: Integer);
procedure SetTabBackgroundBorders(const Value: Boolean);
procedure SetTabColor(const Value: TColor);
procedure SetTabMaxSize(const Value: Integer);
procedure SetTabPosition(const Value: TSpTBXTabPosition);
procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
protected
FHiddenTabs: TSpTBXItemCacheCollection;
FActiveTabIndex: Integer;
FOwnerTabControl: TSpTBXCustomTabSet;
procedure Autofit;
function GetItemsTextColor(State: TSpTBXSkinStatesType): TColor; override;
function GetViewClass: TTBToolbarViewClass; override;
procedure InternalDrawBackground(ACanvas: TCanvas; ARect: TRect; PaintOnNCArea: Boolean; PaintBorders: Boolean = True); override;
procedure DoItemNotification(Ancestor: TTBCustomItem; Relayed: Boolean; Action: TTBItemChangedAction; Index: Integer; Item: TTBCustomItem); override;
procedure RightAlignItems; override;
function CanDragCustomize(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean; override;
procedure DoStartDrag(var DragObject: TDragObject); override;
procedure DragOver(Source: TObject; X: Integer; Y: Integer; State: TDragState; var Accept: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetTabsCount(VisibleOnly: Boolean): Integer;
procedure InvalidateActiveTab;
procedure InvalidateNC;
procedure MakeVisible(ATab: TSpTBXTabItem);
procedure ScrollLeft;
procedure ScrollRight;
procedure ScrollState(out CanScrollToLeft, CanScrollToRight: Boolean);
procedure TabClose(ATab: TSpTBXTabItem);
published
property ActiveTab: TSpTBXTabItem read GetActiveTab;
property ActiveTabIndex: Integer read FActiveTabIndex write SetActiveTabIndex;
property TabCloseButton: TSpTBXTabCloseButton read FTabCloseButton write SetTabCloseButton default tcbNone;
property TabCloseButtonImageIndex: Integer read FTabCloseButtonImageIndex write SetTabCloseButtonImageIndex default -1;
property TabBackgroundBorders: Boolean read FTabBackgroundBorders write SetTabBackgroundBorders;
property TabAutofit: Boolean read FTabAutofit write SetTabAutofit default False;
property TabAutofitMaxSize: Integer read FTabAutofitMaxSize write SetTabAutofitMaxSize default 200;
property TabColor: TColor read FTabColor write SetTabColor default clBtnFace;
property TabMaxSize: Integer read FTabMaxSize write SetTabMaxSize default -1;
property TabPosition: TSpTBXTabPosition read FTabPosition write SetTabPosition default ttpTop;
property TabDragReorder: Boolean read FTabDragReorder write FTabDragReorder default False;
property SkinType: TSpTBXSkinType read FSkinType write SetSkinType default sknSkin;
end;
{ TSpTBXTabSheet }
TSpTBXTabSheet = class(TCustomControl)
private
FTabControl: TSpTBXCustomTabControl;
FItem: TSpTBXTabItem;
FItemName: String;
FPrevFocused: TWincontrol;
procedure ReadItemName(Reader: TReader);
procedure WriteItemName(Writer: TWriter);
function GetCaption: WideString;
function GetTabVisible: Boolean;
procedure SetCaption(const Value: WideString);
procedure SetTabVisible(const Value: Boolean);
function GetImageIndex: Integer;
procedure SetImageIndex(const Value: Integer);
procedure CMVisiblechanged(var Message: TMessage); message CM_VISIBLECHANGED;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure AdjustClientRect(var Rect: TRect); override;
procedure DefineProperties(Filer: TFiler); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure ReadState(Reader: TReader); override;
procedure VisibleChanging; override;
property Align default alClient;
property PrevFocused: TWincontrol read FPrevFocused;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Item: TSpTBXTabItem read FItem write FItem;
property TabControl: TSpTBXCustomTabControl read FTabControl write FTabControl;
published
{$IF CompilerVersion > 15} // For Delphi 2005 and up
property Padding;
property OnAlignInsertBefore;
property OnAlignPosition;
{$IFEND}
property PopupMenu;
property Caption: WideString read GetCaption write SetCaption;
property ImageIndex: Integer read GetImageIndex write SetImageIndex;
property TabVisible: Boolean read GetTabVisible write SetTabVisible default True;
end;
{ TSpTBXTabControl }
TSpTBXCustomTabSet = class(TSpTBXCompoundItemsControl)
private
FItemMoveCount: Integer;
FItemMoved: TSpTBXTabItem;
FTabVisible: Boolean;
FLoadingActiveIndex: Integer;
FUpdatingIndex: Boolean;
FResizing: Boolean;
FOnDrawBackground: TSpTBXDrawEvent;
FOnActiveTabChange: TSpTBXTabChangeEvent;
FOnActiveTabChanging: TSpTBXTabChangingEvent;
FOnActiveTabReorder: TSpTBXTabChangeEvent;
FOnActiveTabReordering: TSpTBXTabChangingEvent;
procedure ReadHiddenItems(Reader: TReader);
procedure WriteHiddenItems(Writer: TWriter);
function GetActiveTabIndex: Integer;
procedure SetActiveTabIndex(Value: Integer);
function GetSkinType: TSpTBXSkinType;
procedure SetSkinType(const Value: TSpTBXSkinType);
function GetTabAutofit: Boolean;
procedure SetTabAutofit(const Value: Boolean);
function GetTabAutofitMaxSize: Integer;
procedure SetTabAutofitMaxSize(const Value: Integer);
function GetTabBackgroundBorders: Boolean;
procedure SetTabBackgroundBorders(const Value: Boolean);
function GetTabBackgroundColor: TColor;
procedure SetTabBackgroundColor(const Value: TColor);
function GetTabCloseButton: TSpTBXTabCloseButton;
procedure SetTabCloseButton(const Value: TSpTBXTabCloseButton);
function GetTabCloseButtonImageIndex: Integer;
procedure SetTabCloseButtonImageIndex(const Value: Integer);
function GetTabDragReorder: Boolean;
procedure SetTabDragReorder(const Value: Boolean);
function GetTabMaxSize: Integer;
procedure SetTabMaxSize(const Value: Integer);
function GetTabPosition: TSpTBXTabPosition;
procedure SetTabPosition(const Value: TSpTBXTabPosition);
procedure SetTabVisible(const Value: Boolean);
function GetTabToolbar: TSpTBXTabToolbar;
procedure CMColorchanged(var Message: TMessage); message CM_COLORCHANGED;
procedure CMSpTBXControlsInvalidate(var Message: TMessage); message CM_SPTBXCONTROLSINVALIDATE;
procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
procedure WMInvalidateTabBackground(var Message: TMessage); message WM_INVALIDATETABBACKGROUND;
procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
function GetActiveTab: TSpTBXTabItem;
protected
FBackground: TBitmap;
// Painting
procedure DoDrawBackground(ACanvas: TCanvas; ARect: TRect;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual;
function GetFullRepaint: Boolean; virtual;
// Tabs
function CanActiveTabChange(const TabIndex, NewTabIndex: Integer): Boolean; virtual;
procedure DoActiveTabChange(const TabIndex: Integer); virtual;
function CanActiveTabReorder(const TabIndex, NewTabIndex: Integer): Boolean; virtual;
procedure DoActiveTabReorder(const TabIndex: Integer); virtual;
procedure ItemNotification(Ancestor: TTBCustomItem; Relayed: Boolean;
Action: TTBItemChangedAction; Index: Integer; Item: TTBCustomItem); virtual; // Items change notification
procedure TabInserted(Item: TSpTBXTabItem); virtual;
procedure TabDeleting(Item: TSpTBXTabItem; FreeTabSheet: Boolean = True); virtual;
// Component
procedure DefineProperties(Filer: TFiler); override;
function GetToolbarClass: TSpTBXToolbarClass; override;
procedure Loaded; override;
property Color default clBtnFace;
property ParentColor default False;
property ActiveTabIndex: Integer read GetActiveTabIndex write SetActiveTabIndex;
property TabAutofit: Boolean read GetTabAutofit write SetTabAutofit default False;
property TabAutofitMaxSize: Integer read GetTabAutofitMaxSize write SetTabAutofitMaxSize default 200;
property TabBackgroundColor: TColor read GetTabBackgroundColor write SetTabBackgroundColor default clNone;
property TabBackgroundBorders: Boolean read GetTabBackgroundBorders write SetTabBackgroundBorders default False;
property TabCloseButton: TSpTBXTabCloseButton read GetTabCloseButton write SetTabCloseButton default tcbNone;
property TabCloseButtonImageIndex: Integer read GetTabCloseButtonImageIndex write SetTabCloseButtonImageIndex default -1;
property TabDragReorder: Boolean read GetTabDragReorder write SetTabDragReorder default False;
property TabMaxSize: Integer read GetTabMaxSize write SetTabMaxSize default -1;
property TabPosition: TSpTBXTabPosition read GetTabPosition write SetTabPosition default ttpTop;
property TabVisible: Boolean read FTabVisible write SetTabVisible default True;
property SkinType: TSpTBXSkinType read GetSkinType write SetSkinType default sknSkin;
property OnActiveTabChange: TSpTBXTabChangeEvent read FOnActiveTabChange write FOnActiveTabChange;
property OnActiveTabChanging: TSpTBXTabChangingEvent read FOnActiveTabChanging write FOnActiveTabChanging;
property OnActiveTabReorder: TSpTBXTabChangeEvent read FOnActiveTabReorder write FOnActiveTabReorder;
property OnActiveTabReordering: TSpTBXTabChangingEvent read FOnActiveTabReordering write FOnActiveTabReordering;
property OnDrawBackground: TSpTBXDrawEvent read FOnDrawBackground write FOnDrawBackground;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Add(ACaption: WideString): TSpTBXTabItem;
function Insert(NewIndex: Integer; ACaption: WideString): TSpTBXTabItem;
function DrawBackground(DC: HDC; ARect: TRect): Boolean;
function GetTabSetHeight: Integer;
procedure InvalidateBackground(InvalidateChildren: Boolean = True); override;
procedure MakeVisible(ATab: TSpTBXTabItem);
procedure ScrollLeft;
procedure ScrollRight;
procedure ScrollState(out Left, Right: Boolean);
procedure TabClick(ATab: TSpTBXTabItem); virtual;
property ActiveTab: TSpTBXTabItem read GetActiveTab;
property Canvas;
property Toolbar: TSpTBXTabToolbar read GetTabToolbar;
end;
TSpTBXTabSet = class(TSpTBXCustomTabSet)
published
property Align;
property Anchors;
property BiDiMode;
property Color;
property Constraints;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ParentColor;
property ParentBiDiMode;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
{$IF CompilerVersion > 15} // For Delphi 2005 and up
property OnAlignInsertBefore;
property OnAlignPosition;
{$IFEND}
property OnCanResize;
property OnContextPopup;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
// TSpTBXCustomTabSet properties
property ActiveTabIndex;
property Images;
property TabAutofit;
property TabAutofitMaxSize;
property TabBackgroundColor;
property TabBackgroundBorders;
property TabCloseButton;
property TabCloseButtonImageIndex;
property TabDragReorder;
property TabMaxSize;
property TabPosition;
property TabVisible;
property SkinType;
property OnActiveTabChange;
property OnActiveTabChanging;
property OnActiveTabReorder;
property OnActiveTabReordering;
property OnDrawBackground;
end;
{ TSpTBXTabControl }
TSpTBXCustomTabControl = class(TSpTBXCustomTabSet)
private
FEmptyTabSheet: TSpTBXTabSheet;
procedure RealignTabSheets;
function GetActivePage: TSpTBXTabSheet;
function GetPages(Index: Integer): TSpTBXTabSheet;
function GetPagesCount: Integer;
procedure SetActivePage(const Value: TSpTBXTabSheet);
procedure CMSpTBXControlsInvalidate(var Message: TMessage); message CM_SPTBXCONTROLSINVALIDATE;
procedure WMSpSkinChange(var Message: TMessage); message WM_SPSKINCHANGE;
protected
FPages: TList;
procedure DoActiveTabChange(const ItemIndex: Integer); override;
function GetFullRepaint: Boolean; override;
procedure TabInserted(Item: TSpTBXTabItem); override;
procedure TabDeleting(Item: TSpTBXTabItem; FreeTabSheet: Boolean = True); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetPage(Item: TSpTBXTabItem): TSpTBXTabSheet;
property ActivePage: TSpTBXTabSheet read GetActivePage write SetActivePage;
property Pages[Index: Integer]: TSpTBXTabSheet read GetPages;
property PagesCount: Integer read GetPagesCount;
end;
TSpTBXTabControl = class(TSpTBXCustomTabControl)
published
property Align;
property Anchors;
property BiDiMode;
property Color;
property Constraints;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property ParentColor;
property ParentBiDiMode;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property OnCanResize;
property OnContextPopup;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
// TSpTBXCustomTabControl properties
property ActiveTabIndex;
property Images;
property TabAutofit;
property TabAutofitMaxSize;
property TabBackgroundColor;
property TabBackgroundBorders;
property TabCloseButton;
property TabCloseButtonImageIndex;
property TabDragReorder;
property TabMaxSize;
property TabPosition;
property TabVisible;
property SkinType;
property OnActiveTabChange;
property OnActiveTabChanging;
property OnActiveTabReorder;
property OnActiveTabReordering;
property OnDrawBackground;
end;
function SpGetNextTabItemViewer(View: TTBView; IV: TTBItemViewer; GoForward: Boolean; SearchType: TSpTBXSearchItemViewerType): TTBItemViewer;
procedure SpDrawXPTab(ACanvas: TCanvas; ARect: TRect; Enabled, Checked, HotTrack, Focused: Boolean; Position: TSpTBXTabPosition; SkinType: TSpTBXSkinType; Edge: TSpTBXTabEdge = tedNone);
procedure SpDrawXPTabControlBackground(ACanvas: TCanvas; ARect: TRect; AColor: TColor; BottomTabs: Boolean; SkinType: TSpTBXSkinType);
implementation
uses
Themes, UxTheme, Types;
type
TTBItemViewerAccess = class(TTBItemViewer);
TSpTBXCustomItemAccess = class(TSpTBXCustomItem);
TSpTBXDockAccess = class(TSpTBXDock);
TSpTBXToolbarAccess = class(TSpTBXToolbar);
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ Helpers }
function SpGetNextTabItemViewer(View: TTBView; IV: TTBItemViewer; GoForward: Boolean;
SearchType: TSpTBXSearchItemViewerType): TTBItemViewer;
// Returns the left or right Tab item depending on GoForward
// SearchType can be:
// sivtNormal: Normal search
// sivtInmediate: Search for the inmediate ItemViewer
// sivtInmediateSkipNonVisible: Search for the next inmediate ItemViewer, skipping non visible ones
begin
Result := nil;
while Result = nil do begin
IV := SpGetNextItemSameEdge(View, IV, GoForward, SearchType);
if not Assigned(IV) then
Break // Not found, exit
else
if IV.Item is TSpTBXTabItem then begin
Result := IV; // Found Tab
Break;
end
else begin
case SearchType of
sivtInmediate:
Break; // Inmediate not found, exit
sivtInmediateSkipNonVisible:
if IV.Item.Visible then Break; // Inmediate not found and visible, exit
end;
end;
end;
end;
procedure SpDrawXPTab(ACanvas: TCanvas; ARect: TRect;
Enabled, Checked, HotTrack, Focused: Boolean; Position: TSpTBXTabPosition;
SkinType: TSpTBXSkinType; Edge: TSpTBXTabEdge = tedNone);
var
Part, Flags: Cardinal;
B: TBitmap;
R, FlippedR: TRect;
State: TSpTBXSkinStatesType;
begin
SkinType := SpTBXSkinType(SkinType);
if (SkinType = sknNone) and not Checked then
Exit;
B := TBitmap.Create;
try
B.Width := ARect.Right - ARect.Left;
B.Height := ARect.Bottom - ARect.Top;
R := Rect(0, 0, B.Width, B.Height);
B.Canvas.Brush.Color := clFuchsia;
B.Canvas.FillRect(R);
B.TransparentColor := clFuchsia;
B.Transparent := True;
case SkinType of
sknNone:
if Checked then begin
Position := ttpTop; // Don't need to flip
B.Canvas.Brush.Color := ACanvas.Brush.Color;
B.Canvas.FillRect(R);
ExtCtrls.Frame3D(B.Canvas, R, clWindow, clWindowFrame, 1);
ExtCtrls.Frame3D(B.Canvas, R, B.Canvas.Brush.Color, clBtnShadow, 1);
R := Rect(0, 0, B.Width, B.Height); // Frame3D changed R
end;
sknWindows:
begin
case Edge of
tedLeft: Part := TABP_TABITEMLEFTEDGE;
tedRight: Part := TABP_TABITEMRIGHTEDGE;
else
Part := TABP_TABITEM;
end;
Flags := TIS_NORMAL;
if not Enabled then Flags := TIS_DISABLED
else
if Checked then Flags := TIS_SELECTED
else
if HotTrack then Flags := TIS_HOT;
DrawThemeBackground(ThemeServices.Theme[teTab], B.Canvas.Handle, Part, Flags, R, nil);
end;
sknSkin:
begin
State := CurrentSkin.GetState(Enabled, False, HotTrack, Checked);
CurrentSkin.PaintBackground(B.Canvas, R, skncTab, State, True, True);
end;
end;
// Flip top to bottom
if Position = ttpBottom then begin
// Unclear why extra "-1" is needed here.
FlippedR := R;
FlippedR.Top := R.Bottom - 1;
FlippedR.Bottom := R.Top - 1;
B.Canvas.CopyRect(R, B.Canvas, FlippedR);
end;
// Draw focus
if Checked and Focused then begin
InflateRect(R, -3, -3);
SpDrawFocusRect(B.Canvas, R);
end;
ACanvas.Draw(ARect.Left, ARect.Top, B);
finally
B.Free;
end;
end;
procedure SpDrawXPTabControlBackground(ACanvas: TCanvas; ARect: TRect; AColor: TColor;
BottomTabs: Boolean; SkinType: TSpTBXSkinType);
var
B: TBitmap;
R: TRect;
begin
SkinType := SpTBXSkinType(SkinType);
B := TBitmap.Create;
try
B.Width := ARect.Right - ARect.Left;
B.Height := ARect.Bottom - ARect.Top;
R := Rect(0, 0, B.Width, B.Height);
// Draw the top/bottom border
case SkinType of
sknNone:
begin
BottomTabs := False; // Don't flip
B.Canvas.Brush.Color := AColor;
B.Canvas.FillRect(R);
ExtCtrls.Frame3D(B.Canvas, R, clWindow, clWindowFrame, 1);
ExtCtrls.Frame3D(B.Canvas, R, AColor, clBtnShadow, 1);
R := Rect(0, 0, B.Width, B.Height); // Frame3D changed R
end;
sknWindows:
DrawThemeBackground(ThemeServices.Theme[teTab], B.Canvas.Handle, TABP_PANE, 0, R, nil);
sknSkin:
begin
B.Canvas.Brush.Color := clWhite;
B.Canvas.FillRect(R);
CurrentSkin.PaintBackground(B.Canvas, R, skncTabBackground, sknsNormal, True, True);
end;
end;
// Flip top to bottom
if BottomTabs then begin
// Unclear why extra "-1" is needed here.
R.Top := B.Height - 1;
R.Bottom := -1
end;
ACanvas.CopyRect(ARect, B.Canvas, R);
finally
B.Free;
end;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXTabItemDragObject }
constructor TSpTBXTabItemDragObject.Create(ASourceControl: TControl;
AItem: TTBCustomItem);
begin
inherited Create(ASourceControl, AItem);
DragCursorAccept := crDefault;
DragCursorCancel := crDefault;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXTabItem }
constructor TSpTBXTabItem.Create(AOwner: TComponent);
begin
inherited;
DisplayMode := nbdmImageAndText;
GroupIndex := C_SpTBXTabGroupIndex;
Wrapping := twEndEllipsis;
Margins := 4;
FSkinType := sknSkin;
end;
procedure TSpTBXTabItem.Click;
var
T: TSpTBXTabToolbar;
I: Integer;
begin
// Set the Checked property to True, Autocheck is False
// Checked will call Item.Invalidate, the TabSet.ItemNotification will
// handle the invalidation and set the ActiveTabIndex.
if not Checked and Enabled and Visible then begin
if GetTabToolbar(T) then begin
I := T.Items.IndexOf(Self);
if T.FOwnerTabControl.CanActiveTabChange(T.ActiveTabIndex, I) then
Checked := True;
end;
inherited;
end;
end;
procedure TSpTBXTabItem.TabClose;
var
NextTab: TSpTBXTabItem;
T: TSpTBXTabToolbar;
CloseAndFree, CanTabClose: Boolean;
begin
if Visible then begin
GetTabToolbar(T);
if not Assigned(T) then Exit;
CanTabClose := True;
CloseAndFree := False;
DoTabClosing(CanTabClose, CloseAndFree);
if CanTabClose then begin
// Check the next visible tab
NextTab := nil;
if Checked then begin
NextTab := GetNextTab(True, sivtInmediateSkipNonVisible);
if not Assigned(NextTab) then
NextTab := GetNextTab(False, sivtInmediateSkipNonVisible);
end;
T.BeginUpdate;
try
Visible := False;
DoTabClose;
if CloseAndFree then
Free; // Removes the item from the parent, sends tbicDeleting notification and frees the item
if Assigned(NextTab) then
NextTab.Click; // Sends tbicInvalidate notification, which is handled by TSpTBXCustomTabSet.ItemNotification
finally
T.EndUpdate;
end;
end;
end;
end;
function TSpTBXTabItem.DialogChar(CharCode: Word): Boolean;
begin
Result := inherited DialogChar(CharCode);
if Enabled and Visible and IsAccel(CharCode, Caption) then begin
Click;
Result := True;
end;
end;
procedure TSpTBXTabItem.DoDrawTabCloseButton(ACanvas: TCanvas;
State: TSpTBXSkinStatesType; const PaintStage: TSpTBXPaintStage;
var AImageList: TCustomImageList; var AImageIndex: Integer; var ARect: TRect;
var PaintDefault: Boolean);
begin
if Assigned(FOnDrawTabCloseButton) then FOnDrawTabCloseButton(Self, ACanvas, State, PaintStage,
AImageList, AImageIndex, ARect, PaintDefault);
end;
procedure TSpTBXTabItem.DoTabClose;
begin
if Assigned(FOnTabClose) then FOnTabClose(Self);
end;
procedure TSpTBXTabItem.DoTabClosing(var Allow, CloseAndFree: Boolean);
begin
if Assigned(FOnTabClosing) then FOnTabClosing(Self, Allow, CloseAndFree);
end;
function TSpTBXTabItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
begin
Result := TSpTBXTabItemViewer;
end;
function TSpTBXTabItem.GetNextTab(GoForward: Boolean; SearchType: TSpTBXSearchItemViewerType): TSpTBXTabItem;
// Returns the left or right Tab item depending on GoForward, skipping all the non-visible ones.
// If Inmediate is true it will only search for the next inmediate tab
var
T: TSpTBXTabToolbar;
IV: TTBItemViewer;
begin
Result := nil;
if GetTabToolbar(T) then begin
IV := SpFindItemViewer(T.View, Self);
if Assigned(IV) then begin
IV := SpGetNextTabItemViewer(T.View, IV, GoForward, SearchType);
if Assigned(IV) then
Result := IV.Item as TSpTBXTabItem
end;
end;
end;
function TSpTBXTabItem.GetTabColor: TColor;
var
T: TSpTBXTabToolbar;
begin
Result := clBtnFace;
if GetTabToolbar(T) then
Result := T.TabColor;
end;
function TSpTBXTabItem.GetSkinType: TSpTBXSkinType;
var
T: TSpTBXTabToolbar;
begin
if GetTabToolbar(T) then
FSkinType := T.SkinType;
Result := FSkinType;
end;
procedure TSpTBXTabItem.SetSkinType(const Value: TSpTBXSkinType);
var
T: TSpTBXTabToolbar;
begin
// Don't change the SkinType if the item is inside a TabToolbar
if not GetTabToolbar(T) then begin
FSkinType := Value;
Change(False);
end;
end;
function TSpTBXTabItem.IsFirstVisible: Boolean;
var
T: TSpTBXTabToolbar;
IV: TTBItemViewer;
begin
Result := False;
if GetTabToolbar(T) then begin
IV := SpFindItemViewer(T.View, Self);
if Assigned(IV) then
Result := T.View.NextSelectable(nil, True) = IV;
end;
end;
function TSpTBXTabItem.IsFirstVisibleTab: Boolean;
var
T: TSpTBXTabToolbar;
begin
if GetTabToolbar(T) then
Result := not Assigned(GetNextTab(False, sivtNormal))
else
Result := False;
end;
function TSpTBXTabItem.IsLastVisibleTab: Boolean;
var
T: TSpTBXTabToolbar;
begin
if GetTabToolbar(T) then
Result := not Assigned(GetNextTab(True, sivtNormal))
else
Result := False;
end;
function TSpTBXTabItem.GetTabToolbar(out TabToolbar: TSpTBXTabToolbar): Boolean;
var
C: TComponent;
begin
C := GetParentComponent;
if Assigned(C) and (C is TSpTBXTabToolbar) then
TabToolbar := C as TSpTBXTabToolbar
else
TabToolbar := nil;
Result := Assigned(TabToolbar);
end;
procedure TSpTBXTabItem.ToggleControl;
begin
// Do nothing, the Control property is the Tabsheet, and its visibility
// is setted by TabSet.ActiveTabIndex
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXTabItemViewer }
procedure TSpTBXTabItemViewer.CalcSize(const Canvas: TCanvas; var AWidth,
AHeight: Integer);
var
TabMaxSize: Integer;
begin
inherited CalcSize(Canvas, AWidth, AHeight);
if IsOnTabToolbar and not Item.Anchored then begin
TabMaxSize := TSpTBXTabToolbar(View.Window).TabMaxSize;
if TabMaxSize > 0 then
if IsRotated then begin
if AHeight > TabMaxSize then
AHeight := TabMaxSize;
end
else begin
if AWidth > TabMaxSize then
AWidth := TabMaxSize;
end;
end;
end;
function TSpTBXTabItemViewer.CorrectTabRect(ARect: TRect): TRect;
// Offsets the rect to give a pushed effect on the tabs
begin
Result := ARect;
if not Item.Checked then
case TabPosition of
ttpTop: OffsetRect(Result, 0, 2);
ttpBottom: OffsetRect(Result, 0, -2);
end;
end;
procedure TSpTBXTabItemViewer.DoDrawButton(ACanvas: TCanvas; ARect: TRect;
ItemInfo: TSpTBXMenuItemInfo; const PaintStage: TSpTBXPaintStage;
var PaintDefault: Boolean);
var
LeftT, RightT: TTBItemViewer;
IsHoverItem: Boolean;
R: TRect;
Position: TSpTBXTabPosition;
TT: TSpTBXSkinType;
begin
inherited;
if (PaintStage = pstPrePaint) and PaintDefault then begin
PaintDefault := False;
IsHoverItem := (ItemInfo.State = sknsHotTrack) or (ItemInfo.State = sknsCheckedAndHotTrack);
Position := TabPosition;
// Match the bottom of the Tab with the bottom of the TabSet
case Position of
ttpTop: ARect.Bottom := ARect.Bottom + 1;
ttpBottom: ARect.Top := ARect.Top - 1;
end;
R := ARect;
TT := SpTBXSkinType(Item.SkinType);
case TT of
sknNone, sknSkin:
if Item.Checked or (IsHoverItem and (TT <> sknNone)) or
not CurrentSkin.Options(skncTab, sknsNormal).Body.IsEmpty or
not CurrentSkin.Options(skncTab, sknsNormal).Borders.IsEmpty then
begin
case Position of
ttpTop: Inc(R.Bottom, 5);
ttpBottom: Dec(R.Top, 5);
end;
DrawTab(ACanvas, R, Item.Enabled, Item.Checked, IsHoverItem, Position);
end
else begin
// Draw the separators
RightT := SpGetNextTabItemViewer(View, Self, True, sivtInmediateSkipNonVisible);
if Assigned(RightT) and not RightT.Item.Checked then
DrawTab(ACanvas, R, Item.Enabled, Item.Checked, IsHoverItem, Position, True);
end;
sknWindows:
begin
if IsOnTabToolbar then begin
// Find the inmediate left and right tabs
LeftT := SpGetNextTabItemViewer(View, Self, False, sivtInmediateSkipNonVisible);
RightT := SpGetNextTabItemViewer(View, Self, True, sivtInmediateSkipNonVisible);
end
else begin
LeftT := nil;
RightT := nil;
end;
if Item.Checked then begin
// The left border of the Tab will be painted by the Left tab if
// its the first tab
if Assigned(LeftT) or (Item.IsFirstVisible) then
R.Left := R.Left - 2;
// The right border of the Tab will be painted by the Right tab
if Assigned(RightT) then
R.Right := R.Right + 2;
end
else begin
// Non checked tabs should be smaller
case Position of
ttpTop: Inc(R.Top, 2);
ttpBottom: Dec(R.Bottom, 2);
end;
end;
// Draw the Tab
DrawTab(ACanvas, R, Item.Enabled, Item.Checked, IsHoverItem, Position);
// If the Tab is not checked then it should paint the active tab borders
if not Item.Checked then begin
R := ARect;
// Draw the left border
if Assigned(LeftT) and LeftT.Item.Checked then begin
R.Right := R.Left + 2;
R.Left := R.Right - 10;
DrawTab(ACanvas, R, LeftT.Item.Enabled, True, IsHoverItem, Position);
end
else
// Draw the right border
if Assigned(RightT) and RightT.Item.Checked then begin
R.Left := R.Right - 2;
R.Right := R.Left + 10;
DrawTab(ACanvas, R, RightT.Item.Enabled, True, IsHoverItem, Position);
end;
end;
end;
end;
end;
end;
procedure TSpTBXTabItemViewer.DoDrawCaption(ACanvas: TCanvas; ClientAreaRect: TRect;
State: TSpTBXSkinStatesType; var ACaption: WideString; var CaptionRect: TRect;
var CaptionFormat: Cardinal; IsTextRotated: Boolean;
const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean);
begin
CaptionRect := CorrectTabRect(CaptionRect); // Offset the rect to give a pushed effect on the tabs
// [Theme-Change]
// The Default theme paints the caption of the pushed button in a down
// state, this only happens when the item is in a toolbarstyle
if (State = sknsPushed) and (SkinManager.CurrentSkinName = 'Default') then
OffsetRect(CaptionRect, -1, -1);
inherited DoDrawCaption(ACanvas, ClientAreaRect, State, ACaption, CaptionRect,
CaptionFormat, IsTextRotated, PaintStage, PaintDefault);
end;
procedure TSpTBXTabItemViewer.DoDrawImage(ACanvas: TCanvas;
State: TSpTBXSkinStatesType; const PaintStage: TSpTBXPaintStage;
var AImageList: TCustomImageList; var AImageIndex: Integer; var ARect: TRect;
var PaintDefault: Boolean);
begin
ARect := CorrectTabRect(ARect); // Offset the rect to give a pushed effect on the tabs
inherited DoDrawImage(ACanvas, State, PaintStage, AImageList, AImageIndex, ARect, PaintDefault);
end;
procedure TSpTBXTabItemViewer.DoDrawTabCloseButton(ACanvas: TCanvas;
State: TSpTBXSkinStatesType; const PaintStage: TSpTBXPaintStage;
var AImageList: TCustomImageList; var AImageIndex: Integer; var ARect: TRect;
var PaintDefault: Boolean);
begin
TSpTBXTabItem(Item).DoDrawTabCloseButton(ACanvas, State, PaintStage, AImageList, AImageIndex, ARect, PaintDefault);
end;
procedure TSpTBXTabItemViewer.DrawBottomBorder(ACanvas: TCanvas; ARect: TRect);
var
CR, R: TRect;
Edge: TSpTBXTabEdge;
LeftT, RightT: Boolean;
Position: TSpTBXTabPosition;
B: TBitmap;
TT: TSpTBXSkinType;
begin
if not IsOnTabToolbar then Exit;
TT := SpTBXSkinType(Item.SkinType);
Position := TabPosition;
Edge := tedNone;
CR := ARect;
case Position of
ttpTop:
Inc(CR.Bottom, 2);
ttpBottom:
begin
// When sknNone the bottom border size is 2
if TT = sknNone then
Dec(CR.Top, 2)
else
Dec(CR.Top, 2);
end;
end;
if TT = sknWindows then begin
LeftT := Assigned(SpGetNextTabItemViewer(View, Self, False, sivtInmediateSkipNonVisible));
RightT := Assigned(SpGetNextTabItemViewer(View, Self, True, sivtInmediateSkipNonVisible));
if Item.IsFirstVisible then // Is first IV?
Edge := tedLeft;
if Edge = tedLeft then begin
CR.Left := CR.Left - 2;
if RightT then
CR.Right := CR.Right + 2;
end
else begin
if LeftT then
CR.Left := CR.Left - 2;
if RightT then
CR.Right := CR.Right + 2;
end;
end;
B := TBitmap.Create;
try
B.Width := CR.Right - CR.Left;
B.Height := CR.Bottom - CR.Top + 4; // Larger than CR
R := Rect(0, 0, B.Width, B.Height);
DrawTab(B.Canvas, R, True, True, False, Position, False, Edge);
case Position of
ttpTop:
R := Bounds(0, 0, CR.Right - CR.Left, CR.Bottom - CR.Top); // Copy from Y = 0
ttpBottom:
R := Bounds(0, 2, CR.Right - CR.Left, CR.Bottom - CR.Top + 2); // Copy from Y = 2
end;
ACanvas.CopyRect(CR, B.Canvas, R);
finally
B.Free;
end;
end;
procedure TSpTBXTabItemViewer.DrawItemRightImage(ACanvas: TCanvas; ARect: TRect;
ItemInfo: TSpTBXMenuItemInfo);
var
PaintDefault: Boolean;
ImgList: TCustomImageList;
ImgIndex: Integer;
PatternColor: TColor;
begin
if IsOnTabToolbar then begin
if not IsTabCloseButtonVisible then
Exit;
GetTabCloseButtonImgList(ImgList, ImgIndex);
ARect := CorrectTabRect(ARect); // Offset the rect to give a pushed effect on the tabs
ItemInfo.Pushed := False;
ItemInfo.Checked := False;
if ItemInfo.Enabled then
if FTabCloseButtonState = sknsHotTrack then
ItemInfo.State := sknsHotTrack
else begin
ItemInfo.Enabled := False;
ItemInfo.State := sknsDisabled;
end;
PaintDefault := True;
DoDrawTabCloseButton(ACanvas, ItemInfo.State, pstPrePaint, ImgList, ImgIndex, ARect, PaintDefault);
if PaintDefault and Assigned(ImgList) and (FTabCloseButtonState = sknsHotTrack) then
if (ImgList = MDIButtonsImgList) or ((ImgIndex >= 0) and (ImgIndex < ImgList.Count)) then
SpDrawXPMenuItem(ACanvas, ARect, ItemInfo);
PaintDefault := True;
if ImgList = MDIButtonsImgList then begin
PatternColor := GetTextColor(ItemInfo.State);
SpDrawGlyphPattern(ACanvas, ARect, ImgIndex, PatternColor);
end
else
DoDrawTabCloseButton(ACanvas, ItemInfo.State, pstPostPaint, ImgList, ImgIndex, ARect, PaintDefault);
if PaintDefault and Assigned(ImgList) and (ImgIndex >= 0) and (ImgIndex < ImgList.Count) then begin
SpDrawXPMenuItemImage(ACanvas, ARect, ItemInfo, ImgList, ImgIndex);
end;
end;
end;
procedure TSpTBXTabItemViewer.DrawTab(ACanvas: TCanvas; ARect: TRect; AEnabled,
AChecked, AHoverItem: Boolean; Position: TSpTBXTabPosition;
ASeparator: Boolean; AEdge: TSpTBXTabEdge);
begin
if ASeparator then begin
ARect.Left := ARect.Right - 2;
SpDrawXPMenuSeparator(ACanvas, ARect, False, True)
end
else begin
ACanvas.Brush.Color := Item.TabColor;
SpDrawXPTab(ACanvas, ARect, AEnabled, AChecked, AHoverItem, False, Position, Item.SkinType, AEdge);
end;
end;
function TSpTBXTabItemViewer.GetItem: TSpTBXTabItem;
begin
Result := TSpTBXTabItem(inherited Item);
end;
function TSpTBXTabItemViewer.GetRightImageRect: TRect;
var
RightGlyphSize: TSize;
R: TRect;
begin
RightGlyphSize := GetRightImageSize;
R := BoundsRect;
Result.Left := R.Right - 4 - RightGlyphSize.cx;
Result.Right := Result.Left + RightGlyphSize.cx;
Result.Top := (R.Top + R.Bottom - RightGlyphSize.cy) div 2;
Result.Bottom := Result.Top + RightGlyphSize.cy;
Result := CorrectTabRect(Result); // Offset the rect to give a pushed effect on the tabs
end;
function TSpTBXTabItemViewer.GetRightImageSize: TSize;
var
ImgList: TCustomImageList;
ImgIndex: Integer;
begin
Result.cx := 0;
Result.cy := 0;
GetTabCloseButtonImgList(ImgList, ImgIndex);
if Assigned(ImgList) then
if ImgList = MDIButtonsImgList then begin
Result.cx := 15;
Result.cy := 15;
end
else if (ImgIndex >= 0) and (ImgIndex < ImgList.Count) then begin
Result.cx := ImgList.Width;
Result.cy := ImgList.Height;
end;
end;
procedure TSpTBXTabItemViewer.GetTabCloseButtonImgList(var AImageList: TCustomImageList;
var AImageIndex: Integer);
var
T: TSpTBXTabToolbar;
begin
AImageList := nil;
AimageIndex := -1;
if IsOnTabToolbar then begin
T := TSpTBXTabToolbar(View.Window);
if T.TabCloseButton <> tcbNone then begin
AImageList := GetImageList;
AImageIndex := T.TabCloseButtonImageIndex;
if not Assigned(AImageList) or (AImageIndex < 0) or (AImageIndex >= AImageList.Count) then begin
AImageList := MDIButtonsImgList;
AImageIndex := 0;
end;
end;
end;
end;
function TSpTBXTabItemViewer.GetTabPosition: TSpTBXTabPosition;
begin
if IsOnTabToolbar then
Result := TSpTBXTabToolbar(View.Window).TabPosition
else
Result := ttpTop;
end;
function TSpTBXTabItemViewer.GetTextColor(State: TSpTBXSkinStatesType): TColor;
begin
Result := Item.FontSettings.Color;
if Result = clNone then begin
if View.Window is TSpTBXTabToolbar then
Result := TSpTBXToolbarAccess(View.Window).GetItemsTextColor(State);
if Result = clNone then
Result := CurrentSkin.GetTextColor(skncTab, State)
end;
end;
procedure TSpTBXTabItemViewer.InternalMouseMove(Shift: TShiftState; X,
Y: Integer);
var
P: TPoint;
R: TRect;
NewState: TSpTBXSkinStatesType;
begin
inherited;
if FTabCloseButtonState in [sknsNormal, sknsHotTrack] then begin
if not Item.Enabled then begin
FTabCloseButtonState := sknsDisabled;
Exit;
end;
P := Point(X, Y);
R := GetRightImageRect;
if PtInRect(R, P) then
NewState := sknsHotTrack
else
NewState := sknsNormal;
if NewState <> FTabCloseButtonState then begin
FTabCloseButtonState := NewState;
InvalidateRect(View.Window.Handle, @R, True)
end;
end;
end;
function TSpTBXTabItemViewer.IsOnTabToolbar: Boolean;
begin
Result := Assigned(View.Window) and (View.Window is TSpTBXTabToolbar);
end;
function TSpTBXTabItemViewer.IsTabCloseButtonVisible: Boolean;
var
T: TSpTBXTabToolbar;
begin
Result := False;
if IsOnTabToolbar then begin
T := TSpTBXTabToolbar(View.Window);
case T.TabCloseButton of
tcbNone:
Exit;
tcbActive:
if not Item.Checked then Exit;
end;
Result := True;
end;
end;
procedure TSpTBXTabItemViewer.Leaving;
var
R: TRect;
begin
inherited;
if FTabCloseButtonState = sknsHotTrack then begin
FTabCloseButtonState := sknsNormal;
R := GetRightImageRect;
InvalidateRect(View.Window.Handle, @R, True)
end;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXTabToolbarView }
procedure TSpTBXTabToolbarView.BeginUpdate;
var
T: TSpTBXTabToolbar;
begin
if (FUpdating = 0) and (Owner is TSpTBXTabToolbar) then begin
T := TSpTBXTabToolbar(Owner);
if Assigned(T.FOwnerTabControl) then
SendMessage(T.FOwnerTabControl.Handle, WM_SETREDRAW, 0, 0);
end;
inherited;
end;
procedure TSpTBXTabToolbarView.EndUpdate;
var
T: TSpTBXTabToolbar;
begin
inherited;
if (FUpdating = 0) and (Owner is TSpTBXTabToolbar) then begin
T := TSpTBXTabToolbar(Owner);
if Assigned(T.FOwnerTabControl) then begin
SendMessage(T.FOwnerTabControl.Handle, WM_SETREDRAW, 1, 0);
SpInvalidateSpTBXControl(T.FOwnerTabControl, True, False);
end;
end;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXTabToolbar }
constructor TSpTBXTabToolbar.Create(AOwner: TComponent);
begin
inherited;
FHiddenTabs := TSpTBXItemCacheCollection.Create(TSpTBXItemCache);
if Owner is TSpTBXCustomTabSet then
FOwnerTabControl := Owner as TSpTBXCustomTabSet
else
FOwnerTabControl := nil;
FActiveTabIndex := -1;
FTabBackgroundBorders := False;
FSkinType := sknSkin;
FTabAutofitMaxSize := 200;
FTabCloseButtonImageIndex := -1;
FTabColor := clBtnFace;
FTabMaxSize := -1;
FTabPosition := ttpTop;
end;
destructor TSpTBXTabToolbar.Destroy;
begin
FHiddenTabs.Free;
inherited;
end;
procedure TSpTBXTabToolbar.DoItemNotification(Ancestor: TTBCustomItem;
Relayed: Boolean; Action: TTBItemChangedAction; Index: Integer;
Item: TTBCustomItem);
var
Tab: TSpTBXTabItem;
IV: TTBItemViewer;
begin
inherited;
if Action = tbicInvalidateAndResize then begin
// Invalidate the NC area, draw the bottom border of the active tab
// Instead of invalidating every time, save the Rect that needs to be drawn
// (bottom border of the active tab) and see if it needs to be repainted
if not IsItemMoving then begin
Tab := ActiveTab;
if Assigned(Tab) and Tab.Visible then begin
IV := SpFindItemViewer(View, Tab);
if Assigned(IV) then
if not EqualRect(FActiveTabRect, IV.BoundsRect) then
InvalidateNC;
end;
end;
end;
end;
procedure TSpTBXTabToolbar.InternalDrawBackground(ACanvas: TCanvas; ARect: TRect;
PaintOnNCArea: Boolean; PaintBorders: Boolean = True);
var
B: TBitmap;
R, BitmapR, DestR: TRect;
Tab: TSpTBXTabItem;
IV: TTBItemViewer;
T: TSpTBXSkinType;
PrevDelta, NextDelta: Integer;
begin
T := SpTBXSkinType(SkinType);
if PaintOnNCArea and Assigned(FOwnerTabControl) then begin
B := TBitmap.Create;
B.Canvas.Lock;
try
R := ARect;
B.Width := R.Right - R.Left;
B.Height := R.Bottom - R.Top;
SpDrawXPToolbar(Self, B.Canvas, R, PaintOnNCArea, FTabBackgroundBorders and (T <> sknNone), skncTabToolbar);
// Draw the bottom border of the active tab
Tab := ActiveTab;
if Assigned(Tab) and Tab.Visible then begin
IV := SpFindItemViewer(View, Tab);
if Assigned(IV) then begin
FActiveTabRect := IV.BoundsRect;
DestR := IV.BoundsRect;
OffsetRect(DestR, 2, 2); // Add the toolbar margins
TSpTBXTabItemViewer(IV).DrawBottomBorder(B.Canvas, DestR);
end;
if T = sknWindows then begin
if Tab.IsFirstVisible or Assigned(Tab.GetNextTab(False, sivtInmediateSkipNonVisible)) then
PrevDelta := 1
else
PrevDelta := -1;
if Assigned(Tab.GetNextTab(True, sivtInmediateSkipNonVisible)) then
NextDelta := 1
else
NextDelta := -1;
if FTabPosition = ttpTop then
ExcludeClipRect(B.Canvas.Handle, DestR.Left - PrevDelta, R.Bottom - 2, DestR.Right + NextDelta, R.Bottom + 4)
else
ExcludeClipRect(B.Canvas.Handle, DestR.Left - PrevDelta, R.Top + 2, DestR.Right + NextDelta, R.Top - 4);
end
else
if FTabPosition = ttpTop then
ExcludeClipRect(B.Canvas.Handle, DestR.Left + 1, R.Bottom - 2, DestR.Right - 1, R.Bottom + 4)
else
ExcludeClipRect(B.Canvas.Handle, DestR.Left + 1, R.Top + 2, DestR.Right -1 , R.Top - 4);
end;
// Draw the bottom border of the tabs pane
BitmapR := Rect(0, 0, FOwnerTabControl.FBackground.Width, FOwnerTabControl.FBackground.Height);
case FTabPosition of
ttpTop:
begin
DestR := Rect(R.Left, R.Bottom - 2, R.Right, R.Bottom);
BitmapR.Bottom := BitmapR.Top + 2;
end;
ttpBottom:
begin
DestR := Rect(R.Left, R.Top, R.Right, R.Top + 2);
BitmapR.Top := BitmapR.Bottom - 2;
end;
end;
B.Canvas.CopyRect(DestR, FOwnerTabControl.FBackground.Canvas, BitmapR);
ACanvas.Draw(0, 0, B);
finally
B.Canvas.UnLock;
B.Free;
end;
end
else
SpDrawXPToolbar(Self, ACanvas, ARect, PaintOnNCArea, FTabBackgroundBorders and (T <> sknNone), skncTabToolbar);
end;
procedure TSpTBXTabToolbar.InvalidateActiveTab;
var
Tab: TSpTBXTabItem;
IV: TTBItemViewer;
begin
Tab := ActiveTab;
if Assigned(Tab) then begin
IV := SpFindItemViewer(View, Tab);
if Assigned(IV) then
View.Invalidate(IV);
end;
end;
procedure TSpTBXTabToolbar.InvalidateNC;
begin
if not IsUpdating and not (tstResizing in FState) and HandleAllocated then
RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME);
end;
function TSpTBXTabToolbar.GetActiveTab: TSpTBXTabItem;
var
Item: TTBCustomItem;
begin
Result := nil;
if Assigned(Items) and (FActiveTabIndex > -1) and (Items.Count > 0) and
(FActiveTabIndex < Items.Count) then
begin
Item := Items[FActiveTabIndex];
if not (csDestroying in Item.ComponentState) and (Item is TSpTBXTabItem) and Assigned(Item.Parent) then
Result := Items[FActiveTabIndex] as TSpTBXTabItem;
end;
end;
function TSpTBXTabToolbar.GetItemsTextColor(State: TSpTBXSkinStatesType): TColor;
begin
Result := CurrentSkin.GetTextColor(skncTabToolbar, State, SkinType);
// Don't call inherited GetItemsTextColor, let the TabItem decide the color.
end;
function TSpTBXTabToolbar.GetTabsCount(VisibleOnly: Boolean): Integer;
var
I: Integer;
IV: TTBItemViewer;
begin
Result := 0;
for I := 0 to View.ViewerCount - 1 do begin
IV := View.Viewers[I];
if IV.Item is TSpTBXTabItem then
if VisibleOnly then begin
if IV.Item.Visible then Inc(Result);
end
else
Inc(Result);
end;
end;
function TSpTBXTabToolbar.GetViewClass: TTBToolbarViewClass;
begin
Result := TSpTBXTabToolbarView;
end;
procedure TSpTBXTabToolbar.Autofit;
var
I, TabsCount, TabsWidth, TabsArea, NonTabsArea, RightAlignWidth: Integer;
IV: TTBItemViewer;
R: TRect;
begin
if not FTabAutofit or IsUpdating or (Items.Count = 0) then Exit;
View.ValidatePositions;
View.BeginUpdate;
try
// Make all the clipped items visible
for I := 0 to FHiddenTabs.Count - 1 do
FHiddenTabs.Items[I].Item.Visible := True;
FHiddenTabs.Clear;
TabsCount := 0;
TabsWidth := 0;
NonTabsArea := 0;
RightAlignWidth := 0;
// Get TabsCount and NonTabsArea
for I := 0 to View.ViewerCount - 1 do begin
IV := View.Viewers[I];
if IV.Item.Visible then begin
if IV.Item is TSpTBXTabItem then
Inc(TabsCount)
else
if IV.Item is TSpTBXRightAlignSpacerItem then
Inc(RightAlignWidth, 20)
else begin
R := SpGetBoundsRect(IV, Items);
Inc(NonTabsArea, R.Right - R.Left);
end;
end;
end;
// Get TabsArea
if TabsCount > 0 then begin
TabsArea := CurrentDock.ClientWidth - 4 - NonTabsArea - RightAlignWidth;
TabsWidth := TabsArea div TabsCount;
if TabsWidth > FTabAutofitMaxSize then
TabsWidth := FTabAutofitMaxSize;
end;
// Get RightAlignWidth
Inc(RightAlignWidth, CurrentDock.Width - ((TabsWidth * TabsCount) + NonTabsArea + RightAlignWidth));
// Set TabsWidth and RightAlignWidth to the Items
for I := 0 to View.ViewerCount - 1 do begin
IV := View.Viewers[I];
if IV.Item.Visible then begin
if IV.Item is TSpTBXTabItem then
TSpTBXTabItem(IV.Item).CustomWidth := TabsWidth
else
if IV.Item is TSpTBXRightAlignSpacerItem then
TSpTBXRightAlignSpacerItem(IV.Item).CustomWidth := RightAlignWidth - GetRightAlignMargin;
end;
end;
finally
View.EndUpdate;
end;
end;
procedure TSpTBXTabToolbar.RightAlignItems;
// Hide the items on resizing
var
I, J, W, H, VisibleTabsCount, iStart, iEnd: Integer;
VisibleWidth, RightAlignedWidth, SpacerW, RightAlignedBorder: Integer;
IV: TTBItemViewer;
Spacer: TSpTBXItemViewer;
RightAlignedList: TList;
IsRotated, IsFirstPartiallyVisible: Boolean;
begin
if (csDestroying in ComponentState) or (tstRightAligning in FState) or
not Assigned(CurrentDock) or (Items.Count <= 0) or
not Stretch or (ShrinkMode <> tbsmNone) or
(CurrentDock.Width <= 0) or (CurrentDock.Height <= 0) or IsUpdating then
Exit;
if FTabAutofit then begin
Autofit;
Exit;
end;
FState := FState + [tstRightAligning];
View.ValidatePositions;
View.BeginUpdate;
RightAlignedList := TList.Create;
try
IsRotated := CurrentDock.Position in [dpLeft, dpRight];
// Find the spacer and the right aligned items
Spacer := SpGetRightAlignedItems(View, RightAlignedList, IsRotated, VisibleWidth, RightAlignedWidth);
if Assigned(Spacer) then begin
SpacerW := Spacer.BoundsRect.Right - Spacer.BoundsRect.Left;
RightAlignedBorder := CurrentDock.Width - 2 - RightAlignedWidth + SpacerW;
VisibleWidth := VisibleWidth - SpacerW;
SpacerW := CurrentDock.Width - VisibleWidth - 4;
end
else begin
SpacerW := 0;
RightAlignedBorder := CurrentDock.Width - 2;
end;
// Show items
VisibleTabsCount := GetTabsCount(True);
IsFirstPartiallyVisible := False;
if VisibleTabsCount = 1 then begin
if VisibleWidth > CurrentDock.Width - 2 then
IsFirstPartiallyVisible := True;
end;
if not IsFirstPartiallyVisible then begin
IV := View.NextSelectable(nil, True);
if Assigned(IV) then begin
iStart := IV.Index;
iEnd := IV.Index;
end
else begin
iStart := 0;
iEnd := 0;
end;
// Show items from left side of the first visible tab
for I := iStart downto 0 do begin
IV := View.Viewers[I];
if not IV.Item.Visible and (RightAlignedList.IndexOf(IV) = -1) then begin
// If the item was hidden and can be showed remove it from the HiddenList
J := FHiddenTabs.IndexOf(IV.Item);
if J > -1 then begin
W := 0;
H := 0;
TTBItemViewerAccess(IV).CalcSize(Canvas, W, H);
VisibleWidth := VisibleWidth + W;
if (VisibleTabsCount = 0) or (VisibleWidth < CurrentDock.Width - 2) then begin
SpacerW := SpacerW - W;
FHiddenTabs.Delete(J);
IV.Item.Visible := True;
Inc(VisibleTabsCount);
end
else
Break;
end;
end;
end;
// Show items from right side of the first visible tab
for I := iEnd to View.ViewerCount - 1 do begin
IV := View.Viewers[I];
if not IV.Item.Visible and (RightAlignedList.IndexOf(IV) = -1) then begin
// If the item was hidden and can be showed remove it from the HiddenList
J := FHiddenTabs.IndexOf(IV.Item);
if J > -1 then begin
W := 0;
H := 0;
TTBItemViewerAccess(IV).CalcSize(Canvas, W, H);
VisibleWidth := VisibleWidth + W;
if (VisibleTabsCount = 0) or (VisibleWidth < CurrentDock.Width - 2) then begin
SpacerW := SpacerW - W;
FHiddenTabs.Delete(J);
IV.Item.Visible := True;
Inc(VisibleTabsCount);
end
else
Break;
end;
end;
end;
// Hide items
if VisibleTabsCount > 1 then
for I := View.ViewerCount - 1 downto 0 do begin
IV := View.Viewers[I];
if (VisibleTabsCount > 1) and (IV is TSpTBXTabItemViewer) and IV.Item.Visible and (IV.BoundsRect.Right > RightAlignedBorder) then
if RightAlignedList.IndexOf(IV) = -1 then begin
// If the item can't be showed add it to the HiddenList
SpacerW := SpacerW + (IV.BoundsRect.Right - IV.BoundsRect.Left);
FHiddenTabs.Add(IV.Item);
IV.Item.Visible := False;
Dec(VisibleTabsCount);
end;
end;
end;
// Resize the spacer
if Assigned(Spacer) then
TSpTBXCustomItemAccess(Spacer.Item).CustomWidth := SpacerW;
View.UpdatePositions;
finally
RightAlignedList.Free;
View.EndUpdate;
FState := FState - [tstRightAligning];
end;
end;
procedure TSpTBXTabToolbar.TabClose(ATab: TSpTBXTabItem);
begin
ATab.TabClose;
end;
procedure TSpTBXTabToolbar.MakeVisible(ATab: TSpTBXTabItem);
var
TabIV, FirstIV, LastIV: TTBItemViewer;
I: Integer;
Spacer: TSpTBXItemViewer;
begin
if (Items.Count > 1) and Assigned(ATab) and (ATab.Visible = False) then begin
TabIV := View.Find(ATab);
FirstIV := View.NextSelectable(nil, True);
// LastIV minus the right aligned items
Spacer := SpGetFirstRightAlignSpacer(View);
if Assigned(Spacer) then
LastIV := View.NextSelectable(Spacer, False)
else
LastIV := View.NextSelectable(nil, False);
if Assigned(FirstIV) and Assigned(LastIV) then begin
for I := 0 to View.ViewerCount - 1 do begin
if TabIV.Index >= FirstIV.Index then
ScrollRight
else
ScrollLeft;
if TabIV.Item.Visible then
Break;
end;
end;
end;
end;
procedure TSpTBXTabToolbar.Scroll(ToRight: Boolean);
var
FirstIV, LastIV: TTBItemViewer;
I, VisibleWidth: Integer;
Spacer: TSpTBXItemViewer;
function ProcessScroll(IV: TTBItemViewer): Boolean;
var
IVIndex, ClippedIndex, VisibleTabsCount, W, H: Integer;
begin
Result := False;
ClippedIndex := FHiddenTabs.IndexOf(IV.Item);
if Assigned(IV) and (ClippedIndex > -1) then begin
Result := True; // a clipped tab was found
BeginUpdate;
try
VisibleTabsCount := GetTabsCount(True);
// Try to hide all the necessary tabs
W := 0;
H := 0;
TTBItemViewerAccess(IV).CalcSize(Canvas, W, H);
if ToRight then begin
while Assigned(FirstIV) and (VisibleWidth + W >= CurrentDock.ClientWidth - 2) do begin
VisibleWidth := VisibleWidth - (FirstIV.BoundsRect.Right - FirstIV.BoundsRect.Left);
FHiddenTabs.Add(FirstIV.Item);
FirstIV.Item.Visible := False;
FirstIV := SpGetNextTabItemViewer(View, FirstIV, True, sivtNormal);
Dec(VisibleTabsCount);
end;
end
else begin
while Assigned(LastIV) and (VisibleWidth + W >= CurrentDock.ClientWidth - 2) do begin
VisibleWidth := VisibleWidth - (LastIV.BoundsRect.Right - LastIV.BoundsRect.Left);
FHiddenTabs.Add(LastIV.Item);
LastIV.Item.Visible := False;
LastIV := SpGetNextTabItemViewer(View, LastIV, False, sivtNormal);
Dec(VisibleTabsCount);
end;
end;
// Try to show all the necessary clipped tabs
IVIndex := IV.Index;
while Assigned(IV) and (ClippedIndex > -1) and ((VisibleTabsCount = 0) or (VisibleWidth + W <= CurrentDock.ClientWidth - 2)) do begin
VisibleWidth := VisibleWidth + W;
IV.Item.Visible := True;
FHiddenTabs.Delete(ClippedIndex);
Inc(VisibleTabsCount);
if ToRight then
Inc(IVIndex)
else
Dec(IVIndex);
if (IVIndex > -1) and (IVIndex < View.ViewerCount) then begin
IV := View.Viewers[IVIndex];
ClippedIndex := FHiddenTabs.IndexOf(IV.Item);
W := 0;
H := 0;
TTBItemViewerAccess(IV).CalcSize(Canvas, W, H);
end
else
Break;
end;
finally
EndUpdate;
end;
end;
end;
begin
if (Items.Count > 1) and not FTabAutofit then begin
// Find the first Tab
FirstIV := SpGetNextTabItemViewer(View, nil, True, sivtNormal);
// Get the VisibleWidth
LastIV := View.NextSelectable(nil, False);
if not Assigned(LastIV) then Exit;
VisibleWidth := LastIV.BoundsRect.Right;
// LastIV minus the right aligned items
Spacer := SpGetFirstRightAlignSpacer(View);
if Assigned(Spacer) then begin
VisibleWidth := VisibleWidth - (Spacer.BoundsRect.Right - Spacer.BoundsRect.Left);
LastIV := View.NextSelectable(Spacer, False);
end;
if Assigned(LastIV) and not (LastIV.Item is TSpTBXTabItem) then
LastIV := SpGetNextTabItemViewer(View, LastIV, False, sivtNormal);
if Assigned(FirstIV) and Assigned(LastIV) then begin
if ToRight then begin
// Find the first clipped tab from the right side of the tabset
for I := LastIV.Index + 1 to View.ViewerCount - 1 do
if ProcessScroll(View.Viewers[I]) then
Break;
end
else begin
// Find the first clipped tab from the left side of the tabset
for I := FirstIV.Index - 1 downto 0 do
if ProcessScroll(View.Viewers[I]) then
Break;
end;
end;
end;
end;
procedure TSpTBXTabToolbar.ScrollLeft;
begin
Scroll(False);
end;
procedure TSpTBXTabToolbar.ScrollRight;
begin
Scroll(True);
end;
procedure TSpTBXTabToolbar.ScrollState(out CanScrollToLeft, CanScrollToRight: Boolean);
var
FirstIV, LastIV: TTBItemViewer;
I, ClippedIndex: Integer;
Spacer: TSpTBXItemViewer;
begin
CanScrollToLeft := False;
CanScrollToRight := False;
if (FHiddenTabs.Count > 0) and not FTabAutofit then begin
// Find the first Tab
FirstIV := SpGetNextTabItemViewer(View, nil, True, sivtNormal);
if Assigned(FirstIV) then begin
// Find the first clipped tab from the left side of the tabset
for I := FirstIV.Index - 1 downto 0 do begin
ClippedIndex := FHiddenTabs.IndexOf(View.Viewers[I].Item);
if ClippedIndex > -1 then begin
CanScrollToLeft := True;
Break;
end;
end;
end;
// LastIV minus the right aligned items
Spacer := SpGetFirstRightAlignSpacer(View);
if Assigned(Spacer) then
LastIV := View.NextSelectable(Spacer, False)
else
LastIV := View.NextSelectable(nil, False);
// Find the first clipped tab from the right side of the tabset
if Assigned(LastIV) then begin
for I := LastIV.Index + 1 to View.ViewerCount - 1 do begin
ClippedIndex := FHiddenTabs.IndexOf(View.Viewers[I].Item);
if ClippedIndex > -1 then begin
CanScrollToRight := True;
Break;
end;
end;
end;
end;
end;
procedure TSpTBXTabToolbar.SetActiveTabIndex(Value: Integer);
var
ATab, APrevTab: TSpTBXTabItem;
I: Integer;
begin
if not Assigned(FOwnerTabControl) then Exit;
if (Value > -1) and (Value < Items.Count) and not (csDestroying in Items[Value].ComponentState) then begin
if not (Items[Value] is TSpTBXTabItem) then
Value := FActiveTabIndex;
end
else
Value := -1;
if (Value <> FActiveTabIndex) and FOwnerTabControl.CanActiveTabChange(FActiveTabIndex, Value) then
begin
I := FActiveTabIndex;
FActiveTabIndex := Value;
// Hide the previous TabSheet
if (I > -1) and (I < Items.Count) and not (csDestroying in Items[I].ComponentState) and
(Items[I] is TSpTBXTabItem) then
begin
APrevTab := Items[I] as TSpTBXTabItem;
APrevTab.Checked := False;
if Assigned(APrevTab.Control) then
APrevTab.Control.Visible := False;
end;
// Check the item and invalidate NC
if FActiveTabIndex > -1 then begin
// Show the TabSheet
ATab := Items[FActiveTabIndex] as TSpTBXTabItem;
ATab.Checked := True;
if Assigned(ATab.Control) then begin
ATab.Control.Visible := True;
ATab.Control.BringToFront;
end;
MakeVisible(ATab);
end;
FOwnerTabControl.DoActiveTabChange(FActiveTabIndex);
// To avoid flicker don't call InvalidateNC, use the following instead
if not IsUpdating then begin
View.InvalidatePositions;
SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOSIZE or
SWP_NOMOVE or SWP_DRAWFRAME or SWP_SHOWWINDOW);
end;
end;
end;
procedure TSpTBXTabToolbar.SetTabCloseButton(const Value: TSpTBXTabCloseButton);
begin
if FTabCloseButton <> Value then begin
FTabCloseButton := Value;
View.InvalidatePositions;
RightAlignItems;
InvalidateNC;
end;
end;
procedure TSpTBXTabToolbar.SetTabCloseButtonImageIndex(const Value: Integer);
begin
if FTabCloseButtonImageIndex <> Value then begin
FTabCloseButtonImageIndex := Value;
Invalidate;
end;
end;
procedure TSpTBXTabToolbar.SetTabAutofit(const Value: Boolean);
begin
if FTabAutofit <> Value then begin
FTabAutofit := Value;
if FTabAutofit then begin
Autofit;
InvalidateNC;
end;
end;
end;
procedure TSpTBXTabToolbar.SetTabAutofitMaxSize(const Value: Integer);
begin
if FTabAutofitMaxSize <> Value then begin
FTabAutofitMaxSize := Value;
if FTabAutofit then Autofit;
end;
end;
procedure TSpTBXTabToolbar.SetTabBackgroundBorders(const Value: Boolean);
begin
if FTabBackgroundBorders <> Value then begin
FTabBackgroundBorders := Value;
InvalidateNC;
end;
end;
procedure TSpTBXTabToolbar.SetTabColor(const Value: TColor);
begin
if (FTabColor <> Value) then begin
FTabColor := Value;
if FSkinType <> sknSkin then begin
Invalidate;
InvalidateNC;
end;
end;
end;
procedure TSpTBXTabToolbar.SetTabMaxSize(const Value: Integer);
begin
if FTabMaxSize <> Value then begin
FTabMaxSize := Value;
View.InvalidatePositions;
RightAlignItems;
InvalidateNC;
end;
end;
procedure TSpTBXTabToolbar.SetTabPosition(const Value: TSpTBXTabPosition);
begin
if FTabPosition <> Value then
FTabPosition := Value;
end;
procedure TSpTBXTabToolbar.SetSkinType(const Value: TSpTBXSkinType);
begin
if FSkinType <> Value then begin
FSkinType := Value;
Invalidate;
InvalidateNC;
end;
end;
procedure TSpTBXTabToolbar.CMDesignHitTest(var Message: TCMDesignHitTest);
var
P: TPoint;
IV: TTBItemViewer;
Shift: TShiftState;
begin
// Allow left-clicks on TabItems at design time
Shift := KeysToShiftState(Message.Keys);
if (csDesigning in ComponentState) and (ssLeft in Shift) and Assigned(View) then begin
P := SmallPointToPoint(Message.Pos);
IV := View.ViewerFromPoint(P);
if Assigned(IV) and Assigned(IV.Item) and (IV.Item is TSpTBXTabItem) then
IV.Item.Click;
end;
inherited;
end;
function TSpTBXTabToolbar.CanDragCustomize(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer): Boolean;
var
IV: TTBItemViewer;
TabIV: TSpTBXTabItemViewer;
begin
Result := False;
FBeginDragIV := nil;
if not (csDesigning in ComponentState) and (Button = mbLeft) then begin
IV := SpGetItemViewerFromPoint(Items, View, Point(X, Y));
if Assigned(IV) and (IV is TSpTBXTabItemViewer) and Assigned(IV.Item) and IV.Item.Enabled and IV.Item.Visible then begin
// Close the tab if the close button is pressed
TabIV := TSpTBXTabItemViewer(IV);
if (TabIV.TabCloseButtonState = sknsHotTrack) and TabIV.IsTabCloseButtonVisible then begin
Result := True; // Bypass the inherited mouse down
TabIV.Item.TabClose;
end
else begin
// Click the item on mouse down
if not IV.Item.Checked then begin
Result := True; // Bypass the inherited mouse down
IV.Item.Click;
if Assigned(OnMouseDown) then OnMouseDown(Self, Button, Shift, X, Y);
end;
// Drag reorder
if FTabDragReorder and not IsCustomizing and IV.Item.Checked then begin
Result := True; // Bypass the inherited mouse down
FBeginDragIV := IV;
BeginDrag(False, 2);
end;
end;
end
else
Result := inherited CanDragCustomize(Button, Shift, X, Y);
end;
end;
procedure TSpTBXTabToolbar.DoStartDrag(var DragObject: TDragObject);
begin
if FTabDragReorder and Assigned(FBeginDragIV) and Assigned(FBeginDragIV.Item) and (FBeginDragIV is TSpTBXTabItemViewer) then begin
DragObject := TSpTBXTabItemDragObject.Create(Self, FBeginDragIV.Item);
inherited DoStartDrag(DragObject);
end
else
inherited DoStartDrag(DragObject);
end;
procedure TSpTBXTabToolbar.DragOver(Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
D: TSpTBXTabItemDragObject;
DestIV, RightAlignIV: TTBItemViewer;
OrigItem: TTBCustomItem;
OrigPos, DestPos, RightAlignPos: Integer;
begin
inherited DragOver(Source, X, Y, State, Accept);
if FTabDragReorder and Assigned(Source) and (Source is TSpTBXTabItemDragObject) then begin
D := Source as TSpTBXTabItemDragObject;
OrigItem := D.SouceItem;
OrigPos := OrigItem.Parent.IndexOf(OrigItem);
// Move the dragging item in the toolbar
if OrigItem.Parent = Items then begin
Accept := True;
SpGetDropPosItemViewer(Items, View, Point(X, Y), OrigPos, DestIV, DestPos);
RightAlignIV := SpGetFirstRightAlignSpacer(View);
if Assigned(RightAlignIV) then
RightAlignPos := Items.IndexOf(RightAlignIV.Item)
else
RightAlignPos := -1;
if (OrigPos <> DestPos) and (DestPos > -1) and (DestPos < Items.Count) and (OrigItem <> DestIV.Item) and
not ((RightAlignPos > -1) and (DestPos >= RightAlignPos)) then
begin
if FOwnerTabControl.CanActiveTabReorder(OrigPos, DestPos) then begin
BeginItemMove;
View.BeginUpdate;
try
// The item is the active tab, we need to update the ActiveTabIndex
// Just set the internal value because the page didn't change
FActiveTabIndex := DestPos;
Items.Move(OrigPos, DestPos);
FOwnerTabControl.DoActiveTabReorder(DestPos);
finally
View.EndUpdate;
EndItemMove;
InvalidateNC;
end;
end;
end;
end;
end;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXTabSheet }
procedure TSpTBXTabSheet.AdjustClientRect(var Rect: TRect);
var
Margin, XPMargin: Integer;
begin
inherited AdjustClientRect(Rect);
if Assigned(FTabControl) then begin
Margin := 2;
XPMargin := 2;
// [Theme-Change]
// WinXP theme needs to have 4 pixel margin
if SpTBXSkinType(FTabControl.SkinType) = sknWindows then
XPMargin := Margin + 2;
Inc(Rect.Left, Margin);
Dec(Rect.Right, XPMargin);
case FTabControl.TabPosition of
ttpTop: dec(Rect.Bottom, XPMargin);
ttpBottom: inc(Rect.Top, XPMargin);
end;
end;
end;
constructor TSpTBXTabSheet.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle + [csAcceptsControls, csSetCaption];
Align := alClient;
Visible := False;
end;
procedure TSpTBXTabSheet.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if not (csDesigning in ComponentState) then begin
with Params do
Style := Style or WS_CLIPCHILDREN;
with Params.WindowClass do
Style := Style and not (CS_HREDRAW or CS_VREDRAW);
end;
end;
procedure TSpTBXTabSheet.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('TabItem', ReadItemName, WriteItemName, True);
end;
destructor TSpTBXTabSheet.Destroy;
begin
// If the Item <> nil it means the tabsheet was removed from the form at
// designtime or freed at runtime.
// If that happens TabDeleting was not called, we should call it before
// the tabsheet is destroyed to free the Item and delete it from the
// FPages list.
if Assigned(FItem) then
if Assigned(FTabControl) and not (csDestroying in FTabControl.ComponentState) then
FTabControl.TabDeleting(FItem, False);
FTabControl := nil;
FItem := nil;
inherited;
end;
procedure TSpTBXTabSheet.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if Operation = opRemove then
if AComponent = FPrevFocused then FPrevFocused := nil;
end;
procedure TSpTBXTabSheet.VisibleChanging;
begin
if not (csDesigning in ComponentState) then
if Visible then begin
// TabSheet will be hidden, save the focused control
if Assigned(FPrevFocused) then FPrevFocused.RemoveFreeNotification(Self);
SpIsFocused(Self, FPrevFocused);
if Assigned(FPrevFocused) then FPrevFocused.FreeNotification(Self);
end;
inherited;
end;
procedure TSpTBXTabSheet.CMVisiblechanged(var Message: TMessage);
begin
if not (csDesigning in ComponentState) then
if Visible then begin
// TabSheet was showed.
// Focus the previous focused control, or focus the first child
if Assigned(FPrevFocused) then begin
if SpCanFocus(FPrevFocused) then
FPrevFocused.SetFocus;
FPrevFocused.RemoveFreeNotification(Self);
FPrevFocused := nil;
end
else
SpFocusFirstChild(Self);
end;
inherited;
end;
function TSpTBXTabSheet.GetCaption: WideString;
begin
if Assigned(FItem) then Result := FItem.Caption
else Result := '';
end;
function TSpTBXTabSheet.GetImageIndex: Integer;
begin
if Assigned(FItem) then Result := FItem.ImageIndex
else Result := -1;
end;
function TSpTBXTabSheet.GetTabVisible: Boolean;
begin
if Assigned(FItem) then Result := FItem.Visible
else Result := False;
end;
procedure TSpTBXTabSheet.SetCaption(const Value: WideString);
begin
if Assigned(FItem) then FItem.Caption := Value;
end;
procedure TSpTBXTabSheet.SetImageIndex(const Value: Integer);
begin
if Assigned(FItem) then FItem.ImageIndex := Value;
end;
procedure TSpTBXTabSheet.SetTabVisible(const Value: Boolean);
begin
if Assigned(FItem) then FItem.Visible := Value;
end;
procedure TSpTBXTabSheet.ReadItemName(Reader: TReader);
begin
case Reader.NextValue of
vaLString, vaString:
FItemName := Reader.ReadString;
else
FItemName := Reader.ReadWideString;
end;
end;
procedure TSpTBXTabSheet.WriteItemName(Writer: TWriter);
begin
if Assigned(Item) then
FItemName := Item.Name;
Writer.WriteWideString(FItemName);
end;
procedure TSpTBXTabSheet.ReadState(Reader: TReader);
var
C: TComponent;
TC: TSpTBXCustomTabControl;
begin
// The TabSheet is being created from the DFM stream
// We must set the initial values of TabControl, Item and add itself to
// the Pages list of the parent TabControl.
inherited ReadState(Reader);
if Reader.Parent is TSpTBXCustomTabControl then begin
// Set TabControl
TC := TSpTBXCustomTabControl(Reader.Parent);
TabControl := TC;
// Set Item and add Self to TabControl.Pages
if not Assigned(FItem) and (FItemName <> '') then begin
C := Owner.FindComponent(FItemName);
if Assigned(C) and (C is TSpTBXTabItem) then begin
FItem := C as TSpTBXTabItem;
FItem.Control := Self;
if TC.FPages.IndexOf(Self) = -1 then
TC.FPages.Add(Self);
end;
end;
end;
end;
procedure TSpTBXTabSheet.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
R: TRect;
begin
Message.Result := 1;
if Assigned(FTabControl) and Visible then begin
if not DoubleBuffered or (TMessage(Message).wParam = TMessage(Message).lParam) then begin
R := ClientRect;
if FTabControl.TabVisible then begin
case FTabControl.TabPosition of
ttpTop: dec(R.Top, 4);
ttpBottom: inc(R.Bottom, 4);
end;
end;
FTabControl.DrawBackground(Message.DC, R);
end;
end;
end;
procedure TSpTBXTabSheet.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
inherited;
SpInvalidateSpTBXControl(Self, True, True);
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXCustomTabSet }
constructor TSpTBXCustomTabSet.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle + [csAcceptsControls, csOpaque];
FTabVisible := True;
FBackground := TBitmap.Create;
Width := 289;
Height := FDock.Height + 2;
ParentColor := False;
Color := clBtnFace;
FToolbar.Items.RegisterNotification(ItemNotification);
end;
destructor TSpTBXCustomTabSet.Destroy;
begin
FToolbar.Items.UnRegisterNotification(ItemNotification);
FreeAndNil(FBackground);
inherited;
end;
procedure TSpTBXCustomTabSet.DefineProperties(Filer: TFiler);
begin
inherited;
Filer.DefineProperty('HiddenItems', ReadHiddenItems, WriteHiddenItems, True);
end;
procedure TSpTBXCustomTabSet.ReadHiddenItems(Reader: TReader);
begin
if Reader.ReadValue = vaCollection then
Reader.ReadCollection(Toolbar.FHiddenTabs);
end;
procedure TSpTBXCustomTabSet.WriteHiddenItems(Writer: TWriter);
begin
Writer.WriteCollection(Toolbar.FHiddenTabs);
end;
procedure TSpTBXCustomTabSet.Loaded;
var
I: Integer;
CacheCollection: TSpTBXItemCacheCollection;
Cache: TSpTBXItemCache;
C: TComponent;
begin
ActiveTabIndex := FLoadingActiveIndex;
inherited;
// Read the HiddenTabs collection, and fill the Item property of the
// collection items reading the Name from the DFM
CacheCollection := Toolbar.FHiddenTabs;
if Assigned(CacheCollection) then
for I := CacheCollection.Count - 1 downto 0 do begin
Cache := CacheCollection[I];
if not Assigned(Cache.Item) then begin
if Cache.Name = '' then
CacheCollection.Delete(I)
else begin
C := Owner.FindComponent(Cache.Name);
if Assigned(C) and (C is TTBCustomItem) then begin
Cache.Item := C as TTBCustomItem;
// If the Item is visible then the entry is not valid, delete it
if Cache.Item.Visible then
CacheCollection.Delete(I);
end;
end;
end;
end;
if TabAutofit then
Toolbar.Autofit;
end;
function TSpTBXCustomTabSet.GetToolbarClass: TSpTBXToolbarClass;
begin
Result := TSpTBXTabToolbar;
end;
function TSpTBXCustomTabSet.GetFullRepaint: Boolean;
begin
Result := True;
end;
function TSpTBXCustomTabSet.Add(ACaption: WideString): TSpTBXTabItem;
var
I: Integer;
SpacerIV: TSpTBXItemViewer;
begin
Result := TSpTBXTabItem.Create(Self);
try
Result.Caption := ACaption;
SpacerIV := SpGetFirstRightAlignSpacer(View);
if Assigned(SpacerIV) then begin
I := Items.IndexOf(SpacerIV.Item);
if I > -1 then
Items.Insert(I, Result);
end
else
Items.Add(Result);
except
Result.Free;
Result := nil;
end;
end;
function TSpTBXCustomTabSet.Insert(NewIndex: Integer; ACaption: WideString): TSpTBXTabItem;
begin
Result := TSpTBXTabItem.Create(Self);
try
Result.Caption := ACaption;
Items.Insert(NewIndex, Result);
except
Result.Free;
Result := nil;
end;
end;
procedure TSpTBXCustomTabSet.TabClick(ATab: TSpTBXTabItem);
begin
ATab.Click; // calls TabToolbar.DoTabClick and Self.DoTabClick
end;
function TSpTBXCustomTabSet.CanActiveTabChange(const TabIndex, NewTabIndex: Integer): Boolean;
begin
Result := True;
if not (csLoading in ComponentState) then
if (NewTabIndex > -1) and not Items[NewTabIndex].Checked then
if Assigned(FOnActiveTabChanging) then FOnActiveTabChanging(Self, TabIndex, NewTabIndex, Result);
end;
procedure TSpTBXCustomTabSet.DoActiveTabChange(const TabIndex: Integer);
begin
if not (csLoading in ComponentState) then
if Assigned(FOnActiveTabChange) then FOnActiveTabChange(Self, TabIndex);
end;
function TSpTBXCustomTabSet.CanActiveTabReorder(const TabIndex, NewTabIndex: Integer): Boolean;
begin
Result := True;
if Assigned(FOnActiveTabReordering) then FOnActiveTabReordering(Self, TabIndex, NewTabIndex, Result);
end;
procedure TSpTBXCustomTabSet.DoActiveTabReorder(const TabIndex: Integer);
begin
if Assigned(FOnActiveTabReorder) then FOnActiveTabReorder(Self, TabIndex);
end;
procedure TSpTBXCustomTabSet.MakeVisible(ATab: TSpTBXTabItem);
begin
if Assigned(FToolbar) then Toolbar.MakeVisible(ATab);
end;
procedure TSpTBXCustomTabSet.ScrollLeft;
begin
if Assigned(FToolbar) then Toolbar.ScrollLeft;
end;
procedure TSpTBXCustomTabSet.ScrollRight;
begin
if Assigned(FToolbar) then Toolbar.ScrollRight;
end;
procedure TSpTBXCustomTabSet.ScrollState(out Left, Right: Boolean);
begin
if Assigned(FToolbar) then Toolbar.ScrollState(Left, Right);
end;
function TSpTBXCustomTabSet.GetActiveTab: TSpTBXTabItem;
begin
if Assigned(FToolbar) then
Result := Toolbar.ActiveTab
else
Result := nil;
end;
function TSpTBXCustomTabSet.GetActiveTabIndex: Integer;
begin
if Assigned(FToolbar) then
Result := Toolbar.ActiveTabIndex
else
Result := -1;
end;
procedure TSpTBXCustomTabSet.SetActiveTabIndex(Value: Integer);
begin
// When the component is reading from the DFM the Items are not created.
// We must save the value setted at design time and use it when the
// form is finally loaded.
if csReading in ComponentState then
FLoadingActiveIndex := Value
else
if Assigned(FToolbar) then
Toolbar.ActiveTabIndex := Value;
end;
function TSpTBXCustomTabSet.GetTabCloseButton: TSpTBXTabCloseButton;
begin
if Assigned(FToolbar) then
Result := Toolbar.TabCloseButton
else
Result := tcbNone;
end;
procedure TSpTBXCustomTabSet.SetTabCloseButton(const Value: TSpTBXTabCloseButton);
begin
if Assigned(FToolbar) then
Toolbar.TabCloseButton := Value;
end;
function TSpTBXCustomTabSet.GetTabCloseButtonImageIndex: Integer;
begin
if Assigned(FToolbar) then
Result := Toolbar.TabCloseButtonImageIndex
else
Result := -1;
end;
procedure TSpTBXCustomTabSet.SetTabCloseButtonImageIndex(const Value: Integer);
begin
if Assigned(FToolbar) then
Toolbar.TabCloseButtonImageIndex := Value;
end;
function TSpTBXCustomTabSet.GetTabAutofit: Boolean;
begin
if Assigned(FToolbar) then
Result := Toolbar.TabAutofit
else
Result := False;
end;
procedure TSpTBXCustomTabSet.SetTabAutofit(const Value: Boolean);
begin
if Assigned(FToolbar) then
Toolbar.TabAutofit := Value;
end;
function TSpTBXCustomTabSet.GetTabAutofitMaxSize: Integer;
begin
if Assigned(FToolbar) then
Result := Toolbar.TabAutofitMaxSize
else
Result := -1;
end;
procedure TSpTBXCustomTabSet.SetTabAutofitMaxSize(const Value: Integer);
begin
if Assigned(FToolbar) then
Toolbar.TabAutofitMaxSize := Value;
end;
function TSpTBXCustomTabSet.GetTabBackgroundBorders: Boolean;
begin
if Assigned(FToolbar) then
Result := Toolbar.TabBackgroundBorders
else
Result := True;
end;
procedure TSpTBXCustomTabSet.SetTabBackgroundBorders(const Value: Boolean);
begin
if Assigned(FToolbar) then Toolbar.TabBackgroundBorders := Value
end;
function TSpTBXCustomTabSet.GetTabBackgroundColor: TColor;
begin
if Assigned(FToolbar) then
Result := FToolbar.Color
else
Result := clNone;
end;
procedure TSpTBXCustomTabSet.SetTabBackgroundColor(const Value: TColor);
begin
if Assigned(FToolbar) then FToolbar.Color := Value
end;
function TSpTBXCustomTabSet.GetTabDragReorder: Boolean;
begin
Result := False;
if Assigned(FToolbar) then
Result := Toolbar.TabDragReorder;
end;
procedure TSpTBXCustomTabSet.SetTabDragReorder(const Value: Boolean);
begin
if Assigned(FToolbar) then
Toolbar.TabDragReorder := Value;
end;
function TSpTBXCustomTabSet.GetTabMaxSize: Integer;
begin
Result := -1;
if Assigned(FToolbar) then
Result := Toolbar.TabMaxSize;
end;
procedure TSpTBXCustomTabSet.SetTabMaxSize(const Value: Integer);
begin
if Assigned(FToolbar) then
Toolbar.TabMaxSize := Value;
end;
function TSpTBXCustomTabSet.GetTabToolbar: TSpTBXTabToolbar;
begin
Result := FToolbar as TSpTBXTabToolbar;
end;
function TSpTBXCustomTabSet.GetSkinType: TSpTBXSkinType;
begin
if Assigned(FToolbar) then
Result := Toolbar.SkinType
else
Result := sknNone;
end;
procedure TSpTBXCustomTabSet.SetSkinType(const Value: TSpTBXSkinType);
begin
if Assigned(FToolbar) then begin
Toolbar.SkinType := Value;
InvalidateBackground;
end;
end;
function TSpTBXCustomTabSet.GetTabPosition: TSpTBXTabPosition;
begin
if Assigned(FToolbar) then
Result := Toolbar.TabPosition
else
Result := ttpTop;
end;
procedure TSpTBXCustomTabSet.SetTabPosition(const Value: TSpTBXTabPosition);
var
T: TSpTBXTabToolbar;
begin
if Assigned(FToolbar) and Assigned(FDock) then begin
T := Toolbar;
if T.TabPosition <> Value then begin
T.Visible := False;
T.Parent := nil;
T.TabPosition := Value;
case Value of
ttpTop: FDock.Position := dpTop;
ttpBottom: FDock.Position := dpBottom;
end;
T.CurrentDock := FDock;
T.Visible := True;
InvalidateBackground;
end;
end;
end;
procedure TSpTBXCustomTabSet.SetTabVisible(const Value: Boolean);
begin
if FTabVisible <> Value then begin
FTabVisible := Value;
if Assigned(FDock) then
FDock.Visible := Value;
end;
end;
function TSpTBXCustomTabSet.GetTabSetHeight: Integer;
begin
if Assigned(FDock) then
Result := FDock.Height
else
Result := 0;
end;
procedure TSpTBXCustomTabSet.DoDrawBackground(ACanvas: TCanvas;
ARect: TRect; const PaintStage: TSpTBXPaintStage;
var PaintDefault: Boolean);
begin
if Assigned(FOnDrawBackground) then FOnDrawBackground(Self, ACanvas, ARect, PaintStage, PaintDefault);
end;
function TSpTBXCustomTabSet.DrawBackground(DC: HDC; ARect: TRect): Boolean;
var
ACanvas: TCanvas;
PaintDefault: Boolean;
R: TRect;
begin
Result := False;
if (csDestroying in ComponentState) or not Assigned(FDock) or
not Assigned(FBackground) or IsRectEmpty(ARect) then Exit;
ACanvas := TCanvas.Create;
try
ACanvas.Handle := DC;
R := Rect(0, 0, ARect.Right - ARect.Left, ARect.Bottom - ARect.Top);
if (FBackground.Width = R.Right) and (FBackground.Height = R.Bottom) and not Assigned(FOnDrawBackground) then
ACanvas.Draw(ARect.Left, ARect.Top, FBackground)
else begin
FBackground.Width := R.Right;
FBackground.Height := R.Bottom;
FBackground.Canvas.Brush.Color := clWhite;
FBackground.Canvas.FillRect(R);
PaintDefault := True;
DoDrawBackground(FBackground.Canvas, R, pstPrePaint, PaintDefault);
if PaintDefault then
SpDrawXPTabControlBackground(FBackground.Canvas, R, Color, TabPosition = ttpBottom, SkinType);
PaintDefault := True;
DoDrawBackground(FBackground.Canvas, R, pstPostPaint, PaintDefault);
ACanvas.Draw(ARect.Left, ARect.Top, FBackground);
end;
Result := True;
finally
ACanvas.Handle := 0;
ACanvas.Free;
end;
end;
procedure TSpTBXCustomTabSet.InvalidateBackground(InvalidateChildren: Boolean);
begin
// Force background repaint
if not (csDestroying in ComponentState) and Assigned(FToolbar) then begin
if Assigned(FBackground) then
FBackground.Width := 1;
SpInvalidateSpTBXControl(Self, InvalidateChildren, FResizing);
end;
end;
procedure TSpTBXCustomTabSet.ItemNotification(Ancestor: TTBCustomItem;
Relayed: Boolean; Action: TTBItemChangedAction; Index: Integer;
Item: TTBCustomItem);
var
I: Integer;
Tab: TSpTBXTabItem;
begin
inherited;
if Assigned(FToolbar) and not Relayed and not FToolbar.IsItemMoving then
case Action of
tbicSubitemsBeginUpdate:
begin
// When a Tab item is moved (TTBCustomItem.Move)
// tbicDeleting and tbicInserted change actions are fired
// but we don't want the associated TabSheet to be recreated
// because the children will be destroyed.
// When a TTBCustomItem is moved it is not recreated, it simply
// deletes and reinserts its reference in the items array.
// We need to find out if the item is being moved and stop the
// TabSheet recreation.
// The action sequence for a move operation is the following:
// tbicSubitemsBeginUpdate (FItemMoveCount = 1)
// tbicDeleting (FItemMoveCount = 2)
// tbicSubitemsBeginUpdate (FItemMoveCount = 1)
// tbicInserted (FItemMoveCount = 0)
// tbicSubitemsEndUpdate (FItemMoveCount = 0)
// tbicSubitemsEndUpdate (FItemMoveCount = 0)
FItemMoveCount := 1;
FItemMoved := nil;
end;
tbicSubitemsEndUpdate:
begin
// Destroy the TabSheet if the sequence was:
// tbicSubitemsBeginUpdate - tbicDeleting - tbicSubitemsEndUpdate
if FItemMoveCount = 2 then
TabDeleting(FItemMoved);
FItemMoveCount := 0;
FItemMoved := nil;
end;
tbicInserted:
if Assigned(Item) then begin
// Update the index if a new item is inserted before the ActiveTabIndex
I := Items.IndexOf(Item);
if (I > -1) and (I <= ActiveTabIndex) then begin
FUpdatingIndex := True;
try
// Don't change the ActiveTabIndex, just set the internal value
// because the page didn't change
Toolbar.FActiveTabIndex := Toolbar.FActiveTabIndex + 1;
finally
FUpdatingIndex := False;
end;
end;
if (Item is TSpTBXTabItem) then
TabInserted(Item as TSpTBXTabItem);
InvalidateBackground;
FItemMoveCount := 0;
FItemMoved := nil;
end;
tbicDeleting:
// The ItemViewer of the Item is not valid, it was destroyed by TTBView
// The Items array still has the Item.
if not (csDestroying in ComponentState) and Assigned(Item) then begin
FUpdatingIndex := True;
try
Tab := nil;
I := Items.IndexOf(Item);
if I > -1 then begin
if I < ActiveTabIndex then
// Don't change the ActiveTabIndex, just set the internal value
// because the page didn't change
Toolbar.FActiveTabIndex := Toolbar.FActiveTabIndex - 1
else
if I = ActiveTabIndex then
if I = 0 then begin
if (Items.Count > 1) and (Items[1] is TSpTBXTabItem) then begin
// The first tab was deleted, change the internal value of
// Update the checked tab on WM_INVALIDATETABBACKGROUND
Tab := Items[1] as TSpTBXTabItem;
Tab.Click;
end
else
Toolbar.FActiveTabIndex := -1;
end
else begin
Dec(I); // Prev tab
if (I > -1) and (I < Items.Count) and (Items[I] is TSpTBXTabItem) then
SetActiveTabIndex(I)
else
Toolbar.FActiveTabIndex := -1;
end;
end;
if (Item is TSpTBXTabItem) then
if FItemMoveCount = 1 then begin
FItemMoveCount := 2;
FItemMoved := Item as TSpTBXTabItem;
end
else begin
FItemMoveCount := 0;
TabDeleting(Item as TSpTBXTabItem);
end;
if (csDesigning in ComponentState) or Assigned(Tab) then
PostMessage(Handle, WM_INVALIDATETABBACKGROUND, 0, 0)
else
InvalidateBackground;
finally
FUpdatingIndex := False;
end;
end;
tbicInvalidate:
// When the Item.Checked property changes we must reset the ActiveTabIndex
if not FUpdatingIndex and Assigned(Item) and (Item is TSpTBXTabItem) and
Item.Checked and Item.Enabled then
begin
I := Items.IndexOf(Item);
if I <> ActiveTabIndex then begin
FUpdatingIndex := True;
try
SetActiveTabIndex(I);
finally
FUpdatingIndex := False;
end;
end;
end;
end;
end;
procedure TSpTBXCustomTabSet.TabDeleting(Item: TSpTBXTabItem;
FreeTabSheet: Boolean);
begin
if not (csDestroying in ComponentState) then
ScrollLeft;
end;
procedure TSpTBXCustomTabSet.TabInserted(Item: TSpTBXTabItem);
var
I: Integer;
IV: TTBItemViewer;
begin
if not (csLoading in ComponentState) and Assigned(Item) and (Item is TSpTBXTabItem) then
if Items.Count = 1 then
Item.Click // Select the first Tab
else begin
// If the item is inserted after a hidden tab, we should also hide it
I := Items.IndexOf(Item) - 1;
if I > -1 then
if Toolbar.FHiddenTabs.IndexOf(Items[I]) > -1 then begin
IV := View.Find(Item);
if Assigned(IV) then begin
Toolbar.BeginUpdate;
try
Toolbar.FHiddenTabs.Add(Item);
Item.Visible := False;
finally
Toolbar.EndUpdate;
end;
end;
end;
end;
end;
procedure TSpTBXCustomTabSet.CMColorchanged(var Message: TMessage);
begin
inherited;
if Assigned(FToolbar) then begin
Toolbar.TabColor := Color;
InvalidateBackground;
end;
end;
procedure TSpTBXCustomTabSet.CMSpTBXControlsInvalidate(var Message: TMessage);
begin
InvalidateBackground;
Message.Result := 1;
end;
procedure TSpTBXCustomTabSet.WMEraseBkgnd(var Message: TMessage);
var
R: TRect;
begin
if not DoubleBuffered or (Message.wParam = Message.lParam) then begin
if not (csDestroying in ComponentState) and GetFullRepaint then begin
R := ClientRect;
if FTabVisible then begin
case TabPosition of
ttpTop: Inc(R.Top, GetTabSetHeight - 2);
ttpBottom: Dec(R.Bottom, GetTabSetHeight - 2);
end;
end;
DrawBackground(TWMEraseBkgnd(Message).DC, R);
end;
end;
Message.Result := 1;
end;
procedure TSpTBXCustomTabSet.WMInvalidateTabBackground(var Message: TMessage);
var
Tab: TSpTBXTabItem;
I: Integer;
begin
if Assigned(FToolbar) then begin
Tab := Toolbar.ActiveTab;
if Assigned(Tab) then begin
I := Items.IndexOf(Tab);
FUpdatingIndex := True;
try
Toolbar.FActiveTabIndex := -1;
SetActiveTabIndex(I);
finally
FUpdatingIndex := False;
end;
end;
if HandleAllocated then
RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN);
end;
end;
procedure TSpTBXCustomTabSet.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
FResizing := True;
inherited;
if GetFullRepaint then
InvalidateBackground;
FResizing := False;
end;
//WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM
{ TSpTBXCustomTabControl }
constructor TSpTBXCustomTabControl.Create(AOwner: TComponent);
begin
inherited;
// ControlStyle := ControlStyle - [csAcceptsControls];
FPages := TList.Create;
// FEmptyTabSheet is used to hide the rest of the TabSheets
// when ActiveTabIndex = -1 at design time.
FEmptyTabSheet := TSpTBXTabSheet.Create(Self);
FEmptyTabSheet.Parent := Self;
FEmptyTabSheet.TabControl := Self;
FEmptyTabSheet.Item := nil;
FEmptyTabSheet.Visible := True;
FEmptyTabSheet.BringToFront;
FEmptyTabSheet.ControlStyle := FEmptyTabSheet.ControlStyle - [csAcceptsControls];
Width := 289;
Height := 193;
end;
destructor TSpTBXCustomTabControl.Destroy;
begin
FPages.Free;
inherited;
end;
procedure TSpTBXCustomTabControl.DoActiveTabChange(const ItemIndex: Integer);
begin
if ItemIndex = -1 then begin
FEmptyTabSheet.Visible := True;
FEmptyTabSheet.BringToFront;
end
else
FEmptyTabSheet.Visible := False;
inherited;
end;
procedure TSpTBXCustomTabControl.RealignTabSheets;
var
I, C: Integer;
begin
if HandleAllocated then begin
C := PagesCount;
for I := 0 to C - 1 do
Pages[I].Realign;
end;
end;
function TSpTBXCustomTabControl.GetFullRepaint: Boolean;
begin
if not (csDestroying in ComponentState) then
Result := not Assigned(FPages) or (FPages.Count = 0) or not Assigned(FToolbar) or
not Assigned(Toolbar.ActiveTab) or not Toolbar.ActiveTab.Checked
else
Result := False;
end;
function TSpTBXCustomTabControl.GetPage(Item: TSpTBXTabItem): TSpTBXTabSheet;
var
I: Integer;
begin
Result := nil;
I := Items.IndexOf(Item);
if (I > - 1) and Assigned(Item.Control) and (Item.Control is TSpTBXTabSheet) then
Result := Item.Control as TSpTBXTabSheet;
end;
function TSpTBXCustomTabControl.GetActivePage: TSpTBXTabSheet;
begin
if ActiveTabIndex > -1 then
Result := GetPage(Items[ActiveTabIndex] as TSpTBXTabItem)
else
Result := nil;
end;
procedure TSpTBXCustomTabControl.SetActivePage(const Value: TSpTBXTabSheet);
var
I: Integer;
begin
if Assigned(Value) and (FPages.IndexOf(Value) > -1) and Assigned(FToolbar) then begin
I := FToolbar.Items.IndexOf(Value.Item);
if I > -1 then ActiveTabIndex := I;
end;
end;
function TSpTBXCustomTabControl.GetPages(Index: Integer): TSpTBXTabSheet;
begin
Result := TSpTBXTabSheet(FPages[Index]);
end;
function TSpTBXCustomTabControl.GetPagesCount: Integer;
begin
Result := FPages.Count;
end;
procedure TSpTBXCustomTabControl.TabInserted(Item: TSpTBXTabItem);
var
T: TSpTBXTabSheet;
I: Integer;
begin
// Create a TabSheet and Link it to the TabItem, only if the Item is created
// at DesignTime.
// If the Item is created from the DFM stream then the TabSheet will be
// automatically created, because it will also be streamed, but it won't be
// linked to the Item, this is done in TabSheet.ReadState
if (csLoading in ComponentState) or not Assigned(Item) then Exit;
for I := 0 to FPages.Count - 1 do begin
T := TSpTBXTabSheet(FPages[I]);
if T.Item = Item then begin
Exit;
raise Exception.Create('TabSheet Already Exists');
end;
end;
// Find unique name
I := 1;
while Owner.FindComponent('SpTBXTabSheet' + IntToStr(I)) <> nil do
inc(I);
// The Form will be the owner, it will stream the tabsheet to the DFM
T := TSpTBXTabSheet.Create(Owner);
T.Name := 'SpTBXTabSheet' + IntToStr(I);
T.Parent := Self;
T.TabControl := Self;
T.Item := Item;
Item.Control := T;
T.SendToBack;
FPages.Add(T);
inherited;
end;
procedure TSpTBXCustomTabControl.TabDeleting(Item: TSpTBXTabItem;
FreeTabSheet: Boolean);
var
I: Integer;
T: TSpTBXTabSheet;
begin
inherited;
// The Toolbar will free the Items, and the Form will free the TabSheets
if (csDestroying in ComponentState) or not Assigned(Item) then Exit;
for I := 0 to FPages.Count - 1 do begin
T := TSpTBXTabSheet(FPages[I]);
if Assigned(T) and Assigned(T.Item) and (T.Item = Item) then begin
FPages[I] := nil;
FPages.Delete(I);
if FreeTabSheet then begin
T.Item := nil;
T.Free;
end
else begin
// TabSheet deleted at design time, free the linked Item
T.Item.Free;
T.Item := nil;
end;
Break;
end;
end;
end;
procedure TSpTBXCustomTabControl.CMSpTBXControlsInvalidate(var Message: TMessage);
var
I, C: Integer;
begin
// Force TabControl and TabSheets background repaint
inherited;
if not (csDestroying in ComponentState) and Assigned(FToolbar) then begin
C := PagesCount;
for I := 0 to C - 1 do
SpInvalidateSpTBXControl(Pages[I], True, True);
end;
Message.Result := 1;
end;
procedure TSpTBXCustomTabControl.WMSpSkinChange(var Message: TMessage);
begin
inherited;
RealignTabSheets;
end;
end.
Reference in New Issue View Git Blame Copy Permalink