Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {-----------------------------------------------------------------------------
- The contents of this file are subject to the Mozilla Public License
- Version 1.1 (the "License"); you may not use this file except in compliance
- with the License. You may obtain a copy of the License at
- http://www.mozilla.org/MPL/MPL-1.1.html
- 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 Original Code is: JvTabBar.pas, released on 2004-12-23.
- The Initial Developer of the Original Code is Andreas Hausladen <Andreas dott Hausladen att gmx dott de>
- Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
- All Rights Reserved.
- Contributor(s):
- You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
- located at http://jvcl.delphi-jedi.org
- Known Issues:
- -----------------------------------------------------------------------------}
- // $Id: JvTabBar.pas 13415 2012-09-10 09:51:54Z obones $
- {
- ***************** MOD v1.0b *****************
- 1. Перенесён close_button в право
- 2. Исправлен баг с перекрытием кусочка кнопки скролла
- 3. Из protected -> public
- function GetTabWidth(Tab: TJvTabBarItem): Integer;
- function GetTabHeight(Tab: TJvTabBarItem): Integer;
- 4. Сдвинул иконку правее на 2px
- 5. Уменьшил размер Tab`а в случае пустого Caption
- 6. Изменил пропорции и размеры кнопок скролла
- 7. Изменил отступы от кнопки закрытия и текста
- 8. Добавил в uses Vcl.Imaging.pngimage
- 9. Добавил возможность сделать свой стиль из картинок (параметр StyleImages)
- 10. Много мелких фиксов и поправок
- 11. Изменил размеры кнопок при отсутствии текста в вкладке
- 12. Добавил параметр CloseButtonRight, который переносит кнопку в право
- }
- unit JvTabBar;
- {$I jvcl.inc}
- interface
- uses
- {$IFDEF UNITVERSIONING}
- JclUnitVersioning,
- {$ENDIF UNITVERSIONING}
- Windows, Messages, Graphics, Controls, Forms, ImgList, Menus, Buttons,
- ExtCtrls,
- SysUtils, Classes, Contnrs,
- {$IFDEF HAS_UNIT_SYSTEM_UITYPES}
- System.UITypes,
- {$ENDIF HAS_UNIT_SYSTEM_UITYPES}
- JvThemes,
- { _mxn_ }
- Vcl.Dialogs, Vcl.Imaging.pngimage;
- type
- TJvCustomTabBar = class;
- TJvTabBarItem = class;
- TJvTabBarOrientation = (toTop, toBottom);
- TJvTabBarScrollButtonKind = (sbScrollLeft, sbScrollRight);
- TJvTabBarScrollButtonState = (sbsHidden, sbsNormal, sbsHot, sbsPressed, sbsDisabled);
- TJvGetModifiedEvent = procedure(Sender: TJvTabBarItem; var Modified: Boolean) of object;
- TJvGetEnabledEvent = procedure(Sender: TJvTabBarItem; var Enabled: Boolean) of object;
- IPageList = interface
- ['{6BB90183-CFB1-4431-9CFD-E9A032E0C94C}']
- function CanChange(AIndex: Integer): Boolean;
- procedure SetActivePageIndex(AIndex: Integer);
- function GetPageCount: Integer;
- function GetPageCaption(AIndex: Integer): string;
- procedure AddPage(const ACaption: string);
- procedure DeletePage(Index: Integer);
- procedure MovePage(CurIndex, NewIndex: Integer);
- procedure PageCaptionChanged(Index: Integer; const NewCaption: string);
- end;
- TJvTabBarItem = class(TCollectionItem)
- private
- FLeft: Integer; // used for calculating DisplayRect
- FImageIndex: TImageIndex;
- FEnabled: Boolean;
- FVisible: Boolean;
- FTag: Integer;
- FData: TObject;
- FHint: TCaption;
- FName: string;
- FCaption: TCaption;
- FImages: TCustomImageList;
- FModified: Boolean;
- FPopupMenu: TPopupMenu;
- FOnGetEnabled: TJvGetEnabledEvent;
- FOnGetModified: TJvGetModifiedEvent;
- FShowHint: Boolean;
- FAutoDeleteDatas: TObjectList;
- function GetEnabled: Boolean;
- function GetModified: Boolean;
- procedure SetPopupMenu(const Value: TPopupMenu);
- function GetClosing: Boolean;
- procedure SetModified(const Value: Boolean);
- procedure SetCaption(const Value: TCaption);
- procedure SetSelected(const Value: Boolean);
- procedure SetEnabled(const Value: Boolean);
- procedure SetImageIndex(const Value: TImageIndex);
- procedure SetName(const Value: string);
- procedure SetVisible(const Value: Boolean);
- function GetTabBar: TJvCustomTabBar;
- function GetSelected: Boolean;
- function GetDisplayRect: TRect;
- function GetHot: Boolean;
- protected
- procedure Changed; virtual;
- procedure SetIndex(Value: Integer); override;
- procedure Notification(Component: TComponent; Operation: TOperation); virtual;
- property Name: string read FName write SetName;
- public
- constructor Create(Collection: Classes.TCollection); override;
- destructor Destroy; override;
- procedure Assign(Source: TPersistent); override;
- function GetImages: TCustomImageList;
- function CanSelect: Boolean;
- function GetNextVisible: TJvTabBarItem;
- function GetPreviousVisible: TJvTabBarItem;
- procedure MakeVisible;
- function AutoDeleteData: TObjectList;
- property Data: TObject read FData write FData;
- property TabBar: TJvCustomTabBar read GetTabBar;
- property DisplayRect: TRect read GetDisplayRect;
- property Hot: Boolean read GetHot;
- property Closing: Boolean read GetClosing;
- published
- property Caption: TCaption read FCaption write SetCaption;
- property Selected: Boolean read GetSelected write SetSelected default False;
- property Enabled: Boolean read GetEnabled write SetEnabled default True;
- property Modified: Boolean read GetModified write SetModified default False;
- property Hint: TCaption read FHint write FHint;
- property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
- property Tag: Integer read FTag write FTag default 0;
- property Visible: Boolean read FVisible write SetVisible default True;
- property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
- property ShowHint: Boolean read FShowHint write FShowHint default True;
- property OnGetModified: TJvGetModifiedEvent read FOnGetModified write FOnGetModified;
- property OnGetEnabled: TJvGetEnabledEvent read FOnGetEnabled write FOnGetEnabled;
- end;
- TJvTabBarItems = class(TOwnedCollection)
- private
- function GetTabBar: TJvCustomTabBar;
- function GetItem(Index: Integer): TJvTabBarItem;
- procedure SetItem(Index: Integer; const Value: TJvTabBarItem);
- protected
- function Find(const AName: string): TJvTabBarItem;
- procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
- public
- function IndexOf(Item: TJvTabBarItem): Integer;
- procedure EndUpdate; override;
- property Items[Index: Integer]: TJvTabBarItem read GetItem write SetItem; default;
- property TabBar: TJvCustomTabBar read GetTabBar;
- end;
- TJvTabBarPainterOptionType = (poPaintsHotTab, poBottomScrollButtons);
- TJvTabBarPainterOptions = set of TJvTabBarPainterOptionType;
- { _mxn_ }
- TStyleImages = class
- TOP_background:TPngImage;
- TOP_active_left_side:TPngImage;
- TOP_active_right_side:TPngImage;
- TOP_active_center:TPngImage;
- BOTTOM_background:TPngImage;
- BOTTOM_active_left_side:TPngImage;
- BOTTOM_active_right_side:TPngImage;
- BOTTOM_active_center:TPngImage;
- CLOSEBUTTON_normal:TPngImage;
- CLOSEBUTTON_selected:TPngImage;
- CLOSEBUTTON_disabled:TPngImage;
- CLOSEBUTTON_closing:TPngImage;
- CLOSEBUTTON_modified:TPngImage;
- CLOSEBUTTON_closing_modified:TPngImage;
- end;
- TJvTabBarPainter = class(TComponent)
- private
- FOnChangeList: TList;
- protected
- procedure Changed; virtual;
- procedure DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect); virtual; abstract;
- procedure DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect); virtual; abstract;
- procedure DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); virtual; abstract;
- procedure DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean); virtual; abstract;
- function GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; virtual; abstract;
- function GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; virtual; abstract;
- function GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect; virtual; abstract;
- function Options: TJvTabBarPainterOptions; virtual; abstract;
- procedure DrawScrollButton(Canvas: TCanvas; TabBar: TJvCustomTabBar; Button: TJvTabBarScrollButtonKind;
- State: TJvTabBarScrollButtonState; R: TRect); virtual;
- procedure GetScrollButtons(TabBar: TJvCustomTabBar; var LeftButton, RightButton: TRect); {virtual; reserved for future use }
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- end;
- {$IFDEF RTL230_UP}
- [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
- {$ENDIF RTL230_UP}
- TJvModernTabBarPainter = class(TJvTabBarPainter)
- private
- FFont: TFont;
- FDisabledFont: TFont;
- FSelectedFont: TFont;
- FColor: TColor;
- FTabColor: TColor;
- FControlDivideColor: TColor;
- FBorderColor: TColor;
- FModifiedCrossColor: TColor;
- FCloseRectColor: TColor;
- FCloseRectColorDisabled: TColor;
- FCloseCrossColorDisabled: TColor;
- FCloseCrossColorSelected: TColor;
- FCloseCrossColor: TColor;
- FCloseColor: TColor;
- FCloseColorSelected: TColor;
- FDividerColor: TColor;
- FMoveDividerColor: TColor;
- FTabWidth: Integer;
- procedure SetCloseRectColorDisabled(const Value: TColor);
- procedure SetCloseColor(const Value: TColor);
- procedure SetCloseColorSelected(const Value: TColor);
- procedure SetCloseCrossColor(const Value: TColor);
- procedure SetCloseCrossColorDisabled(const Value: TColor);
- procedure SetCloseRectColor(const Value: TColor);
- procedure SetFont(const Value: TFont);
- procedure SetDisabledFont(const Value: TFont);
- procedure SetSelectedFont(const Value: TFont);
- procedure SetModifiedCrossColor(const Value: TColor);
- procedure SetBorderColor(const Value: TColor);
- procedure SetControlDivideColor(const Value: TColor);
- procedure SetTabColor(const Value: TColor);
- procedure SetColor(const Value: TColor);
- procedure FontChanged(Sender: TObject);
- procedure SetDividerColor(const Value: TColor);
- procedure SetCloseCrossColorSelected(const Value: TColor);
- procedure SetTabWidth(Value: Integer);
- protected
- procedure DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect); override;
- procedure DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect); override;
- procedure DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); override;
- procedure DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean); override;
- function GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; override;
- function GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; override;
- function GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect; override;
- function Options: TJvTabBarPainterOptions; override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- published
- property TabColor: TColor read FTabColor write SetTabColor default clBtnFace;
- property Color: TColor read FColor write SetColor default clWindow;
- property BorderColor: TColor read FBorderColor write SetBorderColor default clSilver;
- property ControlDivideColor: TColor read FControlDivideColor write SetControlDivideColor default clBlack;
- property ModifiedCrossColor: TColor read FModifiedCrossColor write SetModifiedCrossColor default clRed;
- property CloseColorSelected: TColor read FCloseColorSelected write SetCloseColorSelected default $F4F4F4;
- property CloseColor: TColor read FCloseColor write SetCloseColor default clWhite;
- property CloseCrossColorSelected: TColor read FCloseCrossColorSelected write SetCloseCrossColorSelected default clBlack;
- property CloseCrossColor: TColor read FCloseCrossColor write SetCloseCrossColor default $5D5D5D;
- property CloseCrossColorDisabled: TColor read FCloseCrossColorDisabled write SetCloseCrossColorDisabled default $ADADAD;
- property CloseRectColor: TColor read FCloseRectColor write SetCloseRectColor default $868686;
- property CloseRectColorDisabled: TColor read FCloseRectColorDisabled write SetCloseRectColorDisabled default $D6D6D6;
- property DividerColor: TColor read FDividerColor write SetDividerColor default $99A8AC;
- property MoveDividerColor: TColor read FMoveDividerColor write FMoveDividerColor default clBlack;
- property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
- property Font: TFont read FFont write SetFont;
- property DisabledFont: TFont read FDisabledFont write SetDisabledFont;
- property SelectedFont: TFont read FSelectedFont write SetSelectedFont;
- end;
- TJvTabBarModernPainter = TJvModernTabBarPainter; // TJvModernTabBarPainter should have been named TJvTabBarModernPainter
- TJvTabBarItemEvent = procedure(Sender: TObject; Item: TJvTabBarItem) of object;
- TJvTabBarSelectingEvent = procedure(Sender: TObject; Item: TJvTabBarItem; var AllowSelect: Boolean) of object;
- TJvTabBarClosingEvent = procedure(Sender: TObject; Item: TJvTabBarItem; var AllowClose: Boolean) of object;
- TJvTabBarCloseQueryEvent = procedure(Sender: TObject; Item: TJvTabBarItem; var CanClose: Boolean) of object;
- TJvTabBarScrollButtonClickEvent = procedure(Sender: TObject; Button: TJvTabBarScrollButtonKind) of object;
- TJvTabBarScrollButtonInfo = record
- State: TJvTabBarScrollButtonState;
- Rect: TRect;
- ExState: Boolean;
- end;
- TJvCustomTabBar = class(TCustomControl)
- private
- FTabs: TJvTabBarItems;
- FPainter: TJvTabBarPainter;
- FDefaultPainter: TJvTabBarPainter;
- FChangeLink: TChangeLink;
- FCloseButton: Boolean;
- { _mxn_ }
- FCloseButtonRight: Boolean;
- { _mxn_ }
- FStyleImages: TStyleImages;
- StyleImagesArray: TStrings;
- FRightClickSelect: Boolean;
- FImages: TCustomImageList;
- FHotTracking: Boolean;
- FHotTab: TJvTabBarItem;
- FSelectedTab: TJvTabBarItem;
- FClosingTab: TJvTabBarItem;
- FLastInsertTab: TJvTabBarItem;
- FMouseDownClosingTab: TJvTabBarItem;
- FMargin: Integer;
- FAutoFreeClosed: Boolean;
- FAllowUnselected: Boolean;
- FSelectBeforeClose: Boolean;
- FPageList: TCustomControl;
- FOnTabClosing: TJvTabBarClosingEvent;
- FOnTabSelected: TJvTabBarItemEvent;
- FOnTabSelecting: TJvTabBarSelectingEvent;
- FOnTabCloseQuery: TJvTabBarCloseQueryEvent;
- FOnTabClosed: TJvTabBarItemEvent;
- FOnTabMoved: TJvTabBarItemEvent;
- FOnChange: TNotifyEvent;
- // scrolling
- FLeftIndex: Integer;
- FLastTabRight: Integer;
- FRequiredWidth: Integer;
- FBarWidth: Integer;
- FBtnLeftScroll: TJvTabBarScrollButtonInfo;
- FBtnRightScroll: TJvTabBarScrollButtonInfo;
- FScrollButtonBackground: TBitmap;
- FHint: TCaption;
- FFlatScrollButtons: Boolean;
- FAllowTabMoving: Boolean;
- FOrientation: TJvTabBarOrientation;
- FOnScrollButtonClick: TJvTabBarScrollButtonClickEvent;
- FPageListTabLink: Boolean;
- FRepeatTimer: TTimer;
- FScrollRepeatedClicked: Boolean;
- FOnLeftTabChange: TNotifyEvent;
- { _mxn_ }
- procedure WriteStyleImages(const Value: TStrings);
- function GetLeftTab: TJvTabBarItem;
- procedure SetLeftTab(Value: TJvTabBarItem);
- procedure SetSelectedTab(Value: TJvTabBarItem);
- procedure SetTabs(Value: TJvTabBarItems);
- procedure SetPainter(Value: TJvTabBarPainter);
- procedure SetImages(Value: TCustomImageList);
- procedure SetCloseButton(Value: Boolean);
- procedure SetMargin(Value: Integer);
- procedure SetHotTab(Tab: TJvTabBarItem);
- procedure SetClosingTab(Tab: TJvTabBarItem);
- procedure UpdateScrollButtons;
- function FindSelectableTab(Tab: TJvTabBarItem): TJvTabBarItem;
- procedure SetHint(const Value: TCaption);
- procedure SetFlatScrollButtons(const Value: Boolean);
- procedure SetPageList(const Value: TCustomControl);
- procedure SetOrientation(const Value: TJvTabBarOrientation);
- procedure TimerExpired(Sender: TObject);
- protected
- procedure DrawScrollBarGlyph(Canvas: TCanvas; X, Y: Integer; Left, Disabled: Boolean);
- procedure Resize; override;
- procedure CalcTabsRects;
- procedure Paint; override;
- procedure PaintTab(Canvas: TCanvas; Tab: TJvTabBarItem); virtual;
- procedure PaintScrollButtons;
- function CurrentPainter: TJvTabBarPainter;
- procedure Notification(Component: TComponent; Operation: TOperation); override;
- function TabClosing(Tab: TJvTabBarItem): Boolean; virtual;
- function TabCloseQuery(Tab: TJvTabBarItem): Boolean; virtual;
- procedure TabClosed(Tab: TJvTabBarItem); virtual;
- function TabSelecting(Tab: TJvTabBarItem): Boolean; virtual;
- procedure TabSelected(Tab: TJvTabBarItem); virtual;
- procedure TabMoved(Tab: TJvTabBarItem); virtual;
- procedure Changed; virtual;
- procedure ImagesChanged(Sender: TObject); virtual;
- procedure ScrollButtonClick(Button: TJvTabBarScrollButtonKind); virtual;
- procedure LeftTabChanged; virtual;
- procedure DragOver(Source: TObject; X: Integer; Y: Integer;
- State: TDragState; var Accept: Boolean); override;
- procedure DragCanceled; override;
- function ScrollButtonsMouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer): Boolean; virtual;
- function ScrollButtonsMouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer): Boolean; virtual;
- function ScrollButtonsMouseMove(Shift: TShiftState; X: Integer; Y: Integer): Boolean; virtual;
- function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
- procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
- procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
- procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
- procedure Loaded; override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function AddTab(const Caption: string): TJvTabBarItem;
- function FindTab(const Caption: string): TJvTabBarItem; // returns the first tab with the given Caption
- function TabAt(X, Y: Integer): TJvTabBarItem;
- { _mxn_ }
- function GetTabWidth(Tab: TJvTabBarItem): Integer;
- function GetTabHeight(Tab: TJvTabBarItem): Integer;
- function MakeVisible(Tab: TJvTabBarItem): Boolean;
- function FindData(Data: TObject): TJvTabBarItem;
- function CloseTab(ATab: TJvTabBarItem): Boolean;
- procedure DragDrop(Source: TObject; X: Integer; Y: Integer); override;
- property PageListTabLink: Boolean read FPageListTabLink write FPageListTabLink default False; // if true the PageList's Pages[] are kept in sync with the Tabs
- property PageList: TCustomControl read FPageList write SetPageList;
- property Painter: TJvTabBarPainter read FPainter write SetPainter;
- property Images: TCustomImageList read FImages write SetImages;
- property Tabs: TJvTabBarItems read FTabs write SetTabs;
- // Status
- property SelectedTab: TJvTabBarItem read FSelectedTab write SetSelectedTab;
- property LeftTab: TJvTabBarItem read GetLeftTab write SetLeftTab;
- property HotTab: TJvTabBarItem read FHotTab;
- property ClosingTab: TJvTabBarItem read FClosingTab;
- // Options
- property Orientation: TJvTabBarOrientation read FOrientation write SetOrientation default toTop;
- property CloseButton: Boolean read FCloseButton write SetCloseButton default True;
- { _mxn_ }
- property CloseButtonRight: Boolean read FCloseButtonRight write FCloseButtonRight default True;
- property StyleImages: TStrings read StyleImagesArray write WriteStyleImages;
- property RightClickSelect: Boolean read FRightClickSelect write FRightClickSelect default True;
- property HotTracking: Boolean read FHotTracking write FHotTracking default False;
- property AutoFreeClosed: Boolean read FAutoFreeClosed write FAutoFreeClosed default True;
- property AllowUnselected: Boolean read FAllowUnselected write FAllowUnselected default False;
- property SelectBeforeClose: Boolean read FSelectBeforeClose write FSelectBeforeClose default False;
- property Margin: Integer read FMargin write SetMargin default 6;
- property FlatScrollButtons: Boolean read FFlatScrollButtons write SetFlatScrollButtons default True;
- property Hint: TCaption read FHint write SetHint;
- property AllowTabMoving: Boolean read FAllowTabMoving write FAllowTabMoving default False;
- // Events
- { With OnTabClosing you can prevent the close button [X] in the tab from shrinking.
- If you want to ask the user you should use OnTabCloseQuery }
- property OnTabClosing: TJvTabBarClosingEvent read FOnTabClosing write FOnTabClosing;
- property OnTabCloseQuery: TJvTabBarCloseQueryEvent read FOnTabCloseQuery write FOnTabCloseQuery;
- property OnTabClosed: TJvTabBarItemEvent read FOnTabClosed write FOnTabClosed;
- property OnTabSelecting: TJvTabBarSelectingEvent read FOnTabSelecting write FOnTabSelecting;
- property OnTabSelected: TJvTabBarItemEvent read FOnTabSelected write FOnTabSelected;
- property OnTabMoved: TJvTabBarItemEvent read FOnTabMoved write FOnTabMoved;
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
- property OnScrollButtonClick: TJvTabBarScrollButtonClickEvent read FOnScrollButtonClick write FOnScrollButtonClick;
- property OnLeftTabChange: TNotifyEvent read FOnLeftTabChange write FOnLeftTabChange;
- end;
- {$IFDEF RTL230_UP}
- [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
- {$ENDIF RTL230_UP}
- TJvTabBar = class(TJvCustomTabBar)
- published
- property Align default alTop;
- property Cursor;
- property PopupMenu;
- property ShowHint default False;
- property Height default 23;
- property Hint;
- property Visible;
- property Enabled;
- property Orientation;
- property CloseButton;
- { _mxn_ }
- property CloseButtonRight;
- property RightClickSelect;
- property HotTracking;
- property AutoFreeClosed;
- property AllowUnselected;
- property SelectBeforeClose;
- property Margin;
- property FlatScrollButtons;
- property AllowTabMoving;
- property PageListTabLink;
- property PageList;
- property Painter;
- property Images;
- property Tabs;
- property OnTabClosing;
- property OnTabCloseQuery;
- property OnTabClosed;
- property OnTabSelecting;
- property OnTabSelected;
- property OnTabMoved;
- property OnChange;
- property OnLeftTabChange;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnContextPopup;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnStartDrag;
- property OnEndDrag;
- property OnStartDock;
- property OnEndDock;
- end;
- {$IFDEF UNITVERSIONING}
- const
- UnitVersioning: TUnitVersionInfo = (
- RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_47_PREPARATION/run/JvTabBar.pas $';
- Revision: '$Revision: 13415 $';
- Date: '$Date: 2012-09-10 11:51:54 +0200 (lun. 10 sept. 2012) $';
- LogPath: 'JVCL\run'
- );
- {$ENDIF UNITVERSIONING}
- implementation
- uses
- Types,
- JvJVCLUtils;
- //=== { TJvCustomTabBar } ====================================================
- constructor TJvCustomTabBar.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- ControlStyle := ControlStyle - [csAcceptsControls, csOpaque] {+ [csDesignInteractive]};
- FTabs := TJvTabBarItems.Create(Self, TJvTabBarItem);
- FChangeLink := TChangeLink.Create;
- FChangeLink.OnChange := ImagesChanged;
- FOrientation := toTop;
- FRightClickSelect := True;
- FCloseButton := True;
- { _mxn_ }
- FCloseButtonRight := True;
- FAutoFreeClosed := True;
- FFlatScrollButtons := True;
- FMargin := 6;
- Align := alTop;
- Height := 23;
- end;
- destructor TJvCustomTabBar.Destroy;
- begin
- { _mxn_ }
- WriteStyleImages(nil);
- // these events are too dangerous during object destruction
- FOnTabSelected := nil;
- FOnTabSelecting := nil;
- FOnChange := nil;
- Painter := nil;
- Images := nil;
- FChangeLink.Free;
- FTabs.Free;
- FTabs := nil;
- FScrollButtonBackground.Free;
- FScrollButtonBackground := nil;
- inherited Destroy;
- end;
- procedure TJvCustomTabBar.LeftTabChanged;
- begin
- if Assigned(FOnLeftTabChange) then
- FOnLeftTabChange(Self);
- end;
- procedure TJvCustomTabBar.Loaded;
- begin
- inherited Loaded;
- SelectedTab := FindSelectableTab(nil);
- UpdateScrollButtons;
- end;
- procedure TJvCustomTabBar.Notification(Component: TComponent; Operation: TOperation);
- var
- I: Integer;
- begin
- inherited Notification(Component, Operation);
- if Operation = opRemove then
- begin
- if Component = FPainter then
- Painter := nil
- else
- if Component = FImages then
- Images := nil
- else
- if Component = FPageList then
- PageList := nil;
- end;
- if FTabs <> nil then
- for I := Tabs.Count - 1 downto 0 do
- Tabs[I].Notification(Component, Operation);
- end;
- procedure TJvCustomTabBar.DrawScrollBarGlyph(Canvas: TCanvas; X, Y: Integer; Left, Disabled: Boolean);
- procedure OffsetPt(var Pt: TPoint; X, Y: Integer);
- begin
- Pt := Point(Pt.X + X, Pt.Y + Y);
- end;
- const
- W = 4;
- H = 7;
- var
- Pts: array [0..2] of TPoint;
- Brush: TBrush;
- Pen: TPen;
- begin
- Brush := TBrush.Create;
- Pen := TPen.Create;
- try
- Brush.Assign(Canvas.Brush);
- Pen.Assign(Canvas.Pen);
- if Left then
- begin
- Pts[0] := Point(X + W - 1, Y + 0);
- Pts[1] := Point(X + W - 1, Y + H - 1);
- Pts[2] := Point(X + 0, Y + (H - 1) div 2);
- end
- else
- begin
- Pts[0] := Point(X + 0, Y + 0);
- Pts[1] := Point(X + 0, Y + H - 1);
- Pts[2] := Point(X + W - 1, Y + (H - 1) div 2);
- end;
- Canvas.Brush.Style := bsSolid;
- if Disabled then
- begin
- Canvas.Brush.Color := clWhite;
- OffsetPt(Pts[0], 1, 1);
- OffsetPt(Pts[1], 1, 1);
- OffsetPt(Pts[2], 1, 1);
- end
- else
- Canvas.Brush.Color := clBlack;
- Canvas.Pen.Color := Canvas.Brush.Color;
- Canvas.Polygon(Pts);
- if Disabled then
- begin
- Canvas.Brush.Color := clGray;
- OffsetPt(Pts[0], -1, -1);
- OffsetPt(Pts[1], -1, -1);
- OffsetPt(Pts[2], -1, -1);
- Canvas.Pen.Color := Canvas.Brush.Color;
- Canvas.Polygon(Pts);
- end;
- finally
- Canvas.Pen.Assign(Pen);
- Canvas.Brush.Assign(Brush);
- Pen.Free;
- Brush.Free;
- end;
- end;
- procedure TJvCustomTabBar.SetTabs(Value: TJvTabBarItems);
- begin
- if Value <> FTabs then
- FTabs.Assign(Value);
- end;
- procedure TJvCustomTabBar.SetPainter(Value: TJvTabBarPainter);
- begin
- if Value <> FPainter then
- begin
- if FPainter <> nil then
- FPainter.FOnChangeList.Extract(Self);
- ReplaceComponentReference(Self, Value, tComponent(FPainter));
- if FPainter <> nil then
- begin
- FreeAndNil(FDefaultPainter);
- FPainter.FOnChangeList.Add(Self);
- if Parent <> nil then
- UpdateScrollButtons;
- end;
- if not (csDestroying in ComponentState) then
- Invalidate;
- end;
- end;
- procedure TJvCustomTabBar.SetImages(Value: TCustomImageList);
- begin
- if ReplaceImageListReference(Self, Value, FImages, FChangeLink) then
- if not (csDestroying in ComponentState) then
- Invalidate;
- end;
- procedure TJvCustomTabBar.SetCloseButton(Value: Boolean);
- begin
- if Value <> FCloseButton then
- begin
- FCloseButton := Value;
- Invalidate;
- end;
- end;
- procedure TJvCustomTabBar.SetMargin(Value: Integer);
- begin
- if Value <> FMargin then
- begin
- FMargin := Value;
- Invalidate;
- end;
- end;
- procedure TJvCustomTabBar.SetSelectedTab(Value: TJvTabBarItem);
- begin
- if Value <> FSelectedTab then
- begin
- if (Value <> nil) and not Value.CanSelect then
- Exit;
- if TabSelecting(Value) then
- begin
- FSelectedTab := Value;
- if not (csDestroying in ComponentState) then
- Invalidate;
- MakeVisible(FSelectedTab);
- TabSelected(FSelectedTab);
- end;
- end;
- end;
- function TJvCustomTabBar.CurrentPainter: TJvTabBarPainter;
- begin
- Result := FPainter;
- if Result = nil then
- begin
- if FDefaultPainter = nil then
- FDefaultPainter := TJvModernTabBarPainter.Create(Self);
- Result := FDefaultPainter;
- end;
- end;
- function TJvCustomTabBar.TabClosing(Tab: TJvTabBarItem): Boolean;
- begin
- Result := True;
- if Assigned(FOnTabClosing) then
- FOnTabClosing(Self, Tab, Result);
- end;
- function TJvCustomTabBar.TabCloseQuery(Tab: TJvTabBarItem): Boolean;
- begin
- Result := True;
- if Assigned(FOnTabCloseQuery) then
- FOnTabCloseQuery(Self, Tab, Result);
- end;
- procedure TJvCustomTabBar.TabClosed(Tab: TJvTabBarItem);
- begin
- if AutoFreeClosed and not (csDesigning in ComponentState) then
- Tab.Visible := False;
- try
- if Assigned(FOnTabClosed) then
- FOnTabClosed(Self, Tab);
- finally
- // Do not double release if somebody "accidentally" released the Tab in TabClosed even if AutoFreeClosed is true
- if AutoFreeClosed and not (csDesigning in ComponentState) and (FTabs.IndexOf(Tab) <> -1) then
- Tab.Free;
- end;
- end;
- function TJvCustomTabBar.TabSelecting(Tab: TJvTabBarItem): Boolean;
- begin
- Result := True;
- if Assigned(FOnTabSelecting) then
- FOnTabSelecting(Self, Tab, Result);
- end;
- procedure TJvCustomTabBar.TabSelected(Tab: TJvTabBarItem);
- var
- PageListIntf: IPageList;
- begin
- if (PageList <> nil) and Supports(PageList, IPageList, PageListIntf) then
- begin
- if Tab <> nil then
- PageListIntf.SetActivePageIndex(Tab.Index)
- else
- PageListIntf.SetActivePageIndex(-1);
- PageListIntf := nil; // who knows what OnTabSelected does with the PageList
- end;
- if Assigned(FOnTabSelected) then
- FOnTabSelected(Self, Tab);
- end;
- function TJvCustomTabBar.FindSelectableTab(Tab: TJvTabBarItem): TJvTabBarItem;
- var
- Index: Integer;
- begin
- Result := Tab;
- if (Result <> nil) and not Result.CanSelect then
- begin
- if AllowUnselected then
- Result := nil
- else
- begin
- Index := Result.Index + 1;
- while Index < Tabs.Count do
- begin
- if Tabs[Index].CanSelect then
- Break;
- Inc(Index);
- end;
- if Index >= Tabs.Count then
- begin
- Index := Result.Index - 1;
- while Index >= 0 do
- begin
- if Tabs[Index].CanSelect then
- Break;
- Dec(Index);
- end;
- end;
- if Index >= 0 then
- Result := Tabs[Index]
- else
- Result := nil;
- end;
- end;
- if not AllowUnselected and not (Result <> nil) then
- begin
- // try to find a selectable tab
- for Index := 0 to Tabs.Count - 1 do
- if Tabs[Index].CanSelect then
- begin
- Result := Tabs[Index];
- Break;
- end;
- end;
- end;
- procedure TJvCustomTabBar.Changed;
- begin
- if not (csDestroying in ComponentState) then
- begin
- // The TabSelected tab is now no more selectable
- SelectedTab := FindSelectableTab(SelectedTab);
- if Tabs.UpdateCount = 0 then
- begin
- Invalidate;
- if Assigned(FOnChange) then
- FOnChange(Self);
- UpdateScrollButtons;
- end;
- end;
- end;
- procedure TJvCustomTabBar.ImagesChanged(Sender: TObject);
- begin
- if not (csDestroying in ComponentState) then
- Invalidate;
- end;
- procedure TJvCustomTabBar.TabMoved(Tab: TJvTabBarItem);
- begin
- if Assigned(FOnTabMoved) then
- FOnTabMoved(Self, Tab);
- end;
- procedure TJvCustomTabBar.DragOver(Source: TObject; X: Integer; Y: Integer;
- State: TDragState; var Accept: Boolean);
- var
- InsertTab: TJvTabBarItem;
- begin
- if AllowTabMoving then
- begin
- InsertTab := TabAt(X, Y);
- if InsertTab = nil then
- if (LeftTab <> nil) and (X < LeftTab.FLeft) then
- InsertTab := LeftTab
- else
- if Tabs.Count > 0 then
- InsertTab := Tabs[Tabs.Count - 1];
- Accept := (Source = Self) and (SelectedTab <> nil) and (InsertTab <> SelectedTab) and (InsertTab <> nil);
- if Accept then
- begin
- if InsertTab <> FLastInsertTab then
- begin
- if FLastInsertTab <> nil then
- Repaint;
- { Paint MoveDivider }
- FLastInsertTab := InsertTab;
- CurrentPainter.DrawMoveDivider(Canvas, InsertTab, InsertTab.Index < SelectedTab.Index);
- end;
- { inherited DrawOver sets Accept to False if no event handler is assigned. }
- if Assigned(OnDragOver) then
- OnDragOver(Self, Source, X, Y, State, Accept);
- Exit;
- end
- else
- if FLastInsertTab <> nil then
- begin
- Repaint;
- FLastInsertTab := nil;
- end;
- end;
- inherited DragOver(Source, X, Y, State, Accept);
- end;
- procedure TJvCustomTabBar.DragCanceled;
- begin
- if FLastInsertTab <> nil then
- Repaint;
- FLastInsertTab := nil;
- inherited DragCanceled;
- end;
- procedure TJvCustomTabBar.DragDrop(Source: TObject; X: Integer; Y: Integer);
- var
- InsertTab: TJvTabBarItem;
- begin
- if AllowTabMoving and (Source = Self) and (SelectedTab <> nil) then
- begin
- InsertTab := TabAt(X, Y);
- if InsertTab = nil then
- if (LeftTab <> nil) and (X < LeftTab.FLeft) then
- InsertTab := LeftTab
- else
- InsertTab := Tabs[Tabs.Count - 1];
- if InsertTab <> nil then
- begin
- SelectedTab.Index := InsertTab.Index;
- TabMoved(SelectedTab);
- SelectedTab.MakeVisible;
- UpdateScrollButtons;
- end;
- end
- else
- if FLastInsertTab <> nil then
- Repaint;
- FLastInsertTab := nil;
- inherited DragDrop(Source, X, Y);
- end;
- procedure TJvCustomTabBar.CMMouseLeave(var Msg: TMessage);
- begin
- SetHotTab(nil);
- inherited;
- end;
- procedure TJvCustomTabBar.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
- begin
- Msg.Result := 1;
- end;
- function TJvCustomTabBar.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
- begin
- Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
- if not Result then
- begin
- Result := True;
- if SelectedTab = nil then
- SelectedTab := LeftTab;
- if SelectedTab = nil then
- Exit; // nothing to do
- WheelDelta := WheelDelta div WHEEL_DELTA;
- while WheelDelta <> 0 do
- begin
- if WheelDelta < 0 then
- begin
- if SelectedTab.GetNextVisible <> nil then
- SelectedTab := SelectedTab.GetNextVisible
- else
- Break;
- end
- else
- begin
- if SelectedTab.GetPreviousVisible <> nil then
- SelectedTab := SelectedTab.GetPreviousVisible
- else
- Break;
- end;
- if WheelDelta < 0 then
- Inc(WheelDelta)
- else
- Dec(WheelDelta);
- end;
- end;
- end;
- procedure TJvCustomTabBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
- Y: Integer);
- var
- Tab: TJvTabBarItem;
- LastSelected: TJvTabBarItem;
- begin
- if ScrollButtonsMouseDown(Button, Shift, X, Y) then
- Exit;
- if Button = mbLeft then
- begin
- FMouseDownClosingTab := nil;
- SetClosingTab(nil); // no tab should be closed
- LastSelected := SelectedTab;
- Tab := TabAt(X, Y);
- if Tab <> nil then
- SelectedTab := Tab;
- if (Tab <> nil) and (Tab = SelectedTab) then
- if CloseButton and (not SelectBeforeClose or (SelectedTab = LastSelected)) then
- begin
- if PtInRect(CurrentPainter.GetCloseRect(Canvas, Tab, Tab.DisplayRect), Point(X, Y)) then
- begin
- if TabClosing(Tab) then
- begin
- if FTabs.IndexOf(Tab) = -1 then
- Tab := nil; // We should not keep a reference if somebody "accidentally" released the Tab in TabClosing
- FMouseDownClosingTab := Tab;
- SetClosingTab(Tab);
- end;
- inherited MouseDown(Button, Shift, X, Y);
- Exit;
- end;
- end;
- if (FClosingTab = nil) and AllowTabMoving and
- ([ssLeft, ssMiddle, ssRight] * Shift = [ssLeft]) then
- BeginDrag(False);
- end;
- inherited MouseDown(Button, Shift, X, Y);
- end;
- procedure TJvCustomTabBar.MouseUp(Button: TMouseButton; Shift: TShiftState;
- X, Y: Integer);
- var
- Pt: TPoint;
- Tab: TJvTabBarItem;
- begin
- if ScrollButtonsMouseUp(Button, Shift, X, Y) then
- Exit;
- try
- if RightClickSelect and not (PopupMenu <> nil) and (Button = mbRight) then
- begin
- Tab := TabAt(X, Y);
- if Tab <> nil then
- SelectedTab := Tab;
- if (Tab <> nil) and (Tab.PopupMenu <> nil) then
- begin
- Pt := ClientToScreen(Point(X, Y));
- Tab.PopupMenu.Popup(Pt.X, Pt.Y);
- end;
- end
- else
- if Button = mbLeft then
- begin
- if (FClosingTab <> nil) and CloseButton then
- begin
- CalcTabsRects;
- if PtInRect(CurrentPainter.GetCloseRect(Canvas, FClosingTab, FClosingTab.DisplayRect), Point(X, Y)) then
- begin
- if TabCloseQuery(FClosingTab) then
- TabClosed(FClosingTab)
- end;
- end;
- end;
- finally
- FMouseDownClosingTab := nil;
- SetClosingTab(nil);
- end;
- inherited MouseUp(Button, Shift, X, Y);
- end;
- procedure TJvCustomTabBar.MouseMove(Shift: TShiftState; X, Y: Integer);
- var
- Tab: TJvTabBarItem;
- NewHint: TCaption;
- begin
- CalcTabsRects; // maybe inefficent
- if ScrollButtonsMouseMove(Shift, X, Y) then
- Exit;
- Tab := TabAt(X, Y);
- if HotTracking and ([ssLeft, ssMiddle, ssRight] * Shift = []) then
- SetHotTab(Tab);
- if CloseButton and (FMouseDownClosingTab <> nil) and (ssLeft in Shift) then
- begin
- if PtInRect(CurrentPainter.GetCloseRect(Canvas, FMouseDownClosingTab,
- FMouseDownClosingTab.DisplayRect), Point(X, Y)) then
- SetClosingTab(FMouseDownClosingTab)
- else
- SetClosingTab(nil)
- end;
- if (Tab <> nil) and Tab.ShowHint then
- NewHint := Tab.Hint
- else
- NewHint := FHint;
- if NewHint <> inherited Hint then
- begin
- Application.CancelHint;
- ShowHint := False;
- ShowHint := True;
- inherited Hint := NewHint;
- end;
- inherited MouseMove(Shift, X, Y);
- end;
- function TJvCustomTabBar.ScrollButtonsMouseDown(Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer): Boolean;
- function HandleButton(Kind: TJvTabBarScrollButtonKind; var State: TJvTabBarScrollButtonState;
- X, Y: Integer; const R: TRect): Boolean;
- begin
- Result := PtInRect(R, Point(X, Y));
- case State of
- sbsNormal, sbsHot:
- begin
- if Result then
- begin
- State := sbsPressed;
- PaintScrollButtons;
- if FRepeatTimer = nil then
- FRepeatTimer := TTimer.Create(Self);
- FRepeatTimer.OnTimer := TimerExpired;
- FRepeatTimer.Interval := 400;
- FRepeatTimer.Enabled := True;
- FRepeatTimer.Tag := Integer(Kind);
- FScrollRepeatedClicked := False;
- end;
- end;
- end;
- end;
- begin
- Result := False;
- if (FBtnLeftScroll.State <> sbsHidden) then
- Result := HandleButton(sbScrollLeft, FBtnLeftScroll.State, X, Y, FBtnLeftScroll.Rect);
- if not Result and (FBtnRightScroll.State <> sbsHidden) then
- Result := HandleButton(sbScrollRight, FBtnRightScroll.State, X, Y, FBtnRightScroll.Rect);
- end;
- function TJvCustomTabBar.ScrollButtonsMouseMove(Shift: TShiftState; X, Y: Integer): Boolean;
- function HandleButton(var ExState: Boolean; var State: TJvTabBarScrollButtonState;
- X, Y: Integer; const R: TRect): Boolean;
- begin
- Result := PtInRect(R, Point(X, Y));
- case State of
- sbsNormal:
- begin
- if Result then
- begin
- State := sbsHot;
- PaintScrollButtons;
- Result := True;
- end;
- end;
- sbsPressed:
- begin
- if not Result then
- begin
- ExState := True;
- State := sbsNormal;
- PaintScrollButtons;
- State := sbsPressed;
- end
- else
- begin
- if ExState then
- begin
- ExState := False;
- PaintScrollButtons;
- end;
- end;
- end;
- sbsHot:
- begin
- if not Result then
- begin
- State := sbsNormal;
- PaintScrollButtons;
- end;
- end;
- end;
- end;
- begin
- Result := False;
- if (FBtnLeftScroll.State <> sbsHidden) then
- Result := HandleButton(FBtnLeftScroll.ExState, FBtnLeftScroll.State, X, Y, FBtnLeftScroll.Rect);
- if not Result and (FBtnRightScroll.State <> sbsHidden) then
- Result := HandleButton(FBtnRightScroll.ExState, FBtnRightScroll.State, X, Y, FBtnRightScroll.Rect);
- end;
- function TJvCustomTabBar.ScrollButtonsMouseUp(Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer): Boolean;
- function HandleButton(Kind: TJvTabBarScrollButtonKind; var State: TJvTabBarScrollButtonState;
- X, Y: Integer; const R: TRect): Boolean;
- begin
- Result := PtInRect(R, Point(X, Y));
- case State of
- sbsPressed:
- begin
- FreeAndNil(FRepeatTimer);
- State := sbsNormal;
- PaintScrollButtons;
- if Result and not FScrollRepeatedClicked then
- ScrollButtonClick(Kind);
- FScrollRepeatedClicked := False;
- end;
- end;
- end;
- begin
- Result := False;
- if (FBtnLeftScroll.State <> sbsHidden) then
- Result := HandleButton(sbScrollLeft, FBtnLeftScroll.State, X, Y, FBtnLeftScroll.Rect);
- if not Result and (FBtnRightScroll.State <> sbsHidden) then
- Result := HandleButton(sbScrollRight, FBtnRightScroll.State, X, Y, FBtnRightScroll.Rect);
- end;
- procedure TJvCustomTabBar.TimerExpired(Sender: TObject);
- var
- Kind: TJvTabBarScrollButtonKind;
- State: TJvTabBarScrollButtonState;
- begin
- FRepeatTimer.Interval := 100;
- Kind := TJvTabBarScrollButtonKind(FRepeatTimer.Tag);
- case Kind of
- sbScrollLeft:
- State := FBtnLeftScroll.State;
- sbScrollRight:
- State := FBtnRightScroll.State;
- else
- Exit;
- end;
- if (State = sbsPressed) and Enabled {and MouseCapture} then
- begin
- try
- FScrollRepeatedClicked := True;
- ScrollButtonClick(Kind);
- case Kind of
- sbScrollLeft:
- if not (FBtnLeftScroll.State in [sbsHidden, sbsDisabled]) then
- FBtnLeftScroll.State := sbsPressed;
- sbScrollRight:
- if not (FBtnRightScroll.State in [sbsHidden, sbsDisabled]) then
- FBtnRightScroll.State := sbsPressed;
- end;
- except
- FRepeatTimer.Enabled := False;
- raise;
- end;
- end
- else
- FreeAndNil(FRepeatTimer);
- end;
- procedure TJvCustomTabBar.SetHotTab(Tab: TJvTabBarItem);
- begin
- if (csDestroying in ComponentState) or not HotTracking then
- FHotTab := nil
- else
- if Tab <> FHotTab then
- begin
- FHotTab := Tab;
- if poPaintsHotTab in CurrentPainter.Options then
- Paint;
- end;
- end;
- function TJvCustomTabBar.CloseTab(ATab: TJvTabBarItem): Boolean;
- begin
- Result := False;
- if ATab <> nil then
- begin
- FClosingTab := ATab;
- try
- Result := TabCloseQuery(FClosingTab);
- if Result then
- TabClosed(FClosingTab);
- finally
- FClosingTab := nil;
- end;
- end;
- end;
- function TJvCustomTabBar.AddTab(const Caption: string): TJvTabBarItem;
- begin
- Result := TJvTabBarItem(Tabs.Add);
- Result.Caption := Caption;
- end;
- function TJvCustomTabBar.FindTab(const Caption: string): TJvTabBarItem;
- var
- i: Integer;
- begin
- for i := 0 to Tabs.Count - 1 do
- if Caption = Tabs[i].Caption then
- begin
- Result := Tabs[i];
- Exit;
- end;
- Result := nil;
- end;
- procedure TJvCustomTabBar.CalcTabsRects;
- var
- I, X: Integer;
- Tab: TJvTabBarItem;
- Offset: Integer;
- Index: Integer;
- begin
- if csDestroying in ComponentState then
- Exit;
- Offset := 0;
- X := Margin; // adjust for scrolled area
- Index := 0;
- for I := 0 to Tabs.Count - 1 do
- begin
- Tab := Tabs[I];
- if Tab.Visible then
- begin
- Tab.FLeft := X;
- Inc(X, GetTabWidth(Tab));
- Inc(X, CurrentPainter.GetDividerWidth(Canvas, Tab));
- if Index < FLeftIndex then
- begin
- Inc(Offset, X); // this tab is placed too left.
- X := 0;
- Tab.FLeft := -Offset - 10;
- end;
- Inc(Index);
- end
- else
- Tab.FLeft := -1;
- end;
- FRequiredWidth := X + Offset;
- FLastTabRight := X;
- end;
- procedure TJvCustomTabBar.Paint;
- var
- I: Integer;
- Bmp: TBitmap;
- R: TRect;
- begin
- CalcTabsRects;
- Bmp := TBitmap.Create;
- try
- Bmp.Width := ClientWidth;
- Bmp.Height := ClientHeight;
- CurrentPainter.DrawBackground(Bmp.Canvas, Self, ClientRect);
- if (FBtnLeftScroll.State <> sbsHidden) and (FBtnRightScroll.State <> sbsHidden) then
- begin
- if FScrollButtonBackground = nil then
- FScrollButtonBackground := TBitmap.Create;
- FScrollButtonBackground.Width := Bmp.Width - FBarWidth;
- FScrollButtonBackground.Height := Bmp.Height;
- R := Rect(FBarWidth, 0, Bmp.Width, Bmp.Height);
- FScrollButtonBackground.Canvas.CopyRect(Rect(0, 0, FScrollButtonBackground.Width, R.Bottom), Bmp.Canvas, R);
- PaintScrollButtons;
- if FBarWidth > 0 then
- Bmp.Width := FBarWidth;
- end;
- if FBarWidth > 0 then
- for I := 0 to Tabs.Count - 1 do
- if Tabs[I].Visible then
- PaintTab(Bmp.Canvas, Tabs[I]);
- Canvas.Draw(0, 0, Bmp);
- finally
- Bmp.Free;
- end;
- end;
- procedure TJvCustomTabBar.PaintTab(Canvas: TCanvas; Tab: TJvTabBarItem);
- var
- R: TRect;
- begin
- if csDestroying in ComponentState then
- Exit;
- if Tab.Visible then
- begin
- R := Tab.DisplayRect;
- if (R.Right >= 0) and (R.Left < FBarWidth) then
- begin
- CurrentPainter.DrawTab(Canvas, Tab, R);
- R.Left := R.Right;
- R.Right := R.Left + CurrentPainter.GetDividerWidth(Canvas, Tab) - 1;
- CurrentPainter.DrawDivider(Canvas, Tab, R);
- end;
- end;
- end;
- procedure TJvCustomTabBar.PaintScrollButtons;
- begin
- if (FScrollButtonBackground = nil) and Visible then
- Paint
- else // paint scroll button's background and the buttons
- Canvas.Draw(FBarWidth, 0, FScrollButtonBackground);
- CurrentPainter.DrawScrollButton(Canvas, Self, sbScrollLeft, FBtnLeftScroll.State, FBtnLeftScroll.Rect);
- CurrentPainter.DrawScrollButton(Canvas, Self, sbScrollRight, FBtnRightScroll.State, FBtnRightScroll.Rect);
- end;
- function TJvCustomTabBar.GetTabHeight(Tab: TJvTabBarItem): Integer;
- begin
- Result := Abs(CurrentPainter.GetTabSize(Canvas, Tab).cy);
- if Result > High(Word) then
- Result := High(Word);
- end;
- function TJvCustomTabBar.GetTabWidth(Tab: TJvTabBarItem): Integer;
- begin
- Result := Abs(CurrentPainter.GetTabSize(Canvas, Tab).cx);
- if Result > High(Word) then
- Result := High(Word);
- end;
- function TJvCustomTabBar.TabAt(X, Y: Integer): TJvTabBarItem;
- var
- I: Integer;
- Pt: TPoint;
- begin
- if (FBtnLeftScroll.State = sbsHidden) or (X < FBarWidth) then
- begin
- CalcTabsRects;
- Pt := Point(X, Y);
- for I := 0 to Tabs.Count - 1 do
- if PtInRect(Tabs[I].DisplayRect, Pt) then
- begin
- Result := Tabs[I];
- Exit;
- end;
- end;
- Result := nil;
- end;
- procedure TJvCustomTabBar.SetClosingTab(Tab: TJvTabBarItem);
- begin
- if Tab <> FClosingTab then
- begin
- FClosingTab := Tab; // this tab should be TabClosed
- Paint;
- end;
- end;
- function TJvCustomTabBar.GetLeftTab: TJvTabBarItem;
- begin
- if (Tabs <> nil) and (FLeftIndex < Tabs.Count) then
- begin
- Result := Tabs[FLeftIndex];
- if not Result.Visible then
- Result := Result.GetNextVisible;
- end
- else
- Result := nil;
- end;
- procedure TJvCustomTabBar.SetLeftTab(Value: TJvTabBarItem);
- var
- Index: Integer;
- Tab: TJvTabBarItem;
- begin
- Index := 0;
- if Value <> nil then
- begin
- // find first visible before or at Value.Index
- if (Tabs <> nil) and (Tabs.Count > 0) and (Value <> Tabs[0]) then
- begin
- while Index < Tabs.Count do
- begin
- Tab := Tabs[Index].GetNextVisible;
- if Tab = nil then
- begin
- Index := FLeftIndex; // do not change
- Break;
- end
- else
- begin
- Index := Tab.Index;
- if Tab.Index >= Value.Index then
- Break;
- end;
- end;
- if Index >= Tabs.Count then
- Index := FLeftIndex; // do not change
- end;
- end;
- if Index <> FLeftIndex then
- begin
- FLeftIndex := Index;
- Invalidate;
- UpdateScrollButtons;
- LeftTabChanged;
- end;
- end;
- procedure TJvCustomTabBar.UpdateScrollButtons;
- const
- State: array[Boolean] of TJvTabBarScrollButtonState = (sbsDisabled, sbsNormal);
- { _mxn_ }
- BtnSizeWidth = 14;
- BtnSizeHeight = 18;
- begin
- CalcTabsRects;
- if (FRequiredWidth < ClientWidth) or ((FLeftIndex = 0) and
- (FLastTabRight <= ClientWidth)) then
- begin
- FBtnLeftScroll.State := sbsHidden;
- FBtnRightScroll.State := sbsHidden;
- FLeftIndex := 0;
- FBarWidth := ClientWidth;
- Invalidate;
- end
- else
- begin
- FBtnLeftScroll.State := sbsNormal;
- FBtnRightScroll.State := sbsNormal;
- if poBottomScrollButtons in CurrentPainter.Options then
- begin
- { _mxn_ }
- FBtnLeftScroll.Rect := Bounds(ClientWidth - BtnSizeWidth * 2 - 1 - 1,
- ClientHeight - BtnSizeWidth - 2, BtnSizeWidth, BtnSizeHeight);
- FBtnRightScroll.Rect := Bounds(FBtnLeftScroll.Rect.Right,
- ClientHeight - BtnSizeWidth - 2, BtnSizeWidth, BtnSizeHeight);
- end
- else
- begin
- { _mxn_ }
- FBtnLeftScroll.Rect := Bounds(ClientWidth - BtnSizeWidth * 2 - 1 - 1, 2, BtnSizeWidth, BtnSizeHeight);
- FBtnRightScroll.Rect := Bounds(FBtnLeftScroll.Rect.Right, 2, BtnSizeWidth, BtnSizeHeight);
- end;
- if not FlatScrollButtons then
- OffsetRect(FBtnRightScroll.Rect, -1, 0);
- //CurrentPainter.GetScrollButtons(Self, FBtnLeftScroll.Rect, FBtnRightScroll.Rect);
- FBarWidth := FBtnLeftScroll.Rect.Left - 2;
- FBtnLeftScroll.State := State[FLeftIndex > 0];
- FBtnRightScroll.State := State[FLastTabRight >= ClientWidth];
- PaintScrollButtons;
- end;
- end;
- procedure TJvCustomTabBar.Resize;
- begin
- UpdateScrollButtons;
- inherited Resize;
- end;
- procedure TJvCustomTabBar.ScrollButtonClick(Button: TJvTabBarScrollButtonKind);
- begin
- if Button = sbScrollLeft then
- begin
- if FBtnLeftScroll.State in [sbsHidden, sbsDisabled] then
- Exit;
- Dec(FLeftIndex);
- end
- else
- if Button = sbScrollRight then
- begin
- if FBtnRightScroll.State in [sbsHidden, sbsDisabled] then
- Exit;
- Inc(FLeftIndex);
- end;
- UpdateScrollButtons;
- Invalidate;
- if Assigned(FOnScrollButtonClick) then
- FOnScrollButtonClick(Self, Button);
- LeftTabChanged;
- end;
- function TJvCustomTabBar.MakeVisible(Tab: TJvTabBarItem): Boolean;
- var
- R: TRect;
- LastLeftIndex: Integer;
- AtLeft: Boolean;
- begin
- Result := False;
- if (Tab = nil) or not Tab.Visible then
- Exit;
- LastLeftIndex := FLeftIndex;
- if FBarWidth > 0 then
- begin
- AtLeft := False;
- repeat
- CalcTabsRects;
- R := Tab.DisplayRect;
- if (R.Right > FBarWidth) and not AtLeft then
- Inc(FLeftIndex)
- else
- if R.Left < 0 then
- begin
- Dec(FLeftIndex);
- AtLeft := True; // prevent an endless loop
- end
- else
- Break;
- until FLeftIndex = Tabs.Count - 1;
- end
- else
- FLeftIndex := 0;
- if (R.Left < 0) and (FLeftIndex > 0) then
- Dec(FLeftIndex); // bar is too small
- if FLeftIndex <> LastLeftIndex then
- begin
- UpdateScrollButtons;
- Invalidate;
- LeftTabChanged;
- end;
- end;
- function TJvCustomTabBar.FindData(Data: TObject): TJvTabBarItem;
- var
- I: Integer;
- begin
- for I := 0 to Tabs.Count - 1 do
- if Tabs[I].Data = Data then
- begin
- Result := Tabs[I];
- Exit;
- end;
- Result := nil;
- end;
- procedure TJvCustomTabBar.SetHint(const Value: TCaption);
- begin
- if Value <> FHint then
- FHint := Value;
- end;
- procedure TJvCustomTabBar.SetFlatScrollButtons(const Value: Boolean);
- begin
- if Value <> FFlatScrollButtons then
- begin
- FFlatScrollButtons := Value;
- FBtnLeftScroll.State := sbsHidden;
- FBtnRightScroll.State := sbsHidden;
- UpdateScrollButtons;
- end;
- end;
- procedure TJvCustomTabBar.SetPageList(const Value: TCustomControl);
- var
- PageListIntf: IPageList;
- begin
- if Value <> FPageList then
- begin
- if Value <> nil then
- begin
- if not Supports(Value, IPageList, PageListIntf) then
- Exit;
- if SelectedTab <> nil then
- PageListIntf.SetActivePageIndex(SelectedTab.Index)
- else
- PageListIntf.SetActivePageIndex(0);
- PageListIntf := nil;
- end;
- if FPageList <> nil then
- FPageList.RemoveFreeNotification(Self);
- FPageList := Value;
- if FPageList <> nil then
- FPageList.FreeNotification(Self);
- end;
- end;
- procedure TJvCustomTabBar.SetOrientation(const Value: TJvTabBarOrientation);
- begin
- if Value <> FOrientation then
- begin
- FOrientation := Value;
- CalcTabsRects;
- Repaint;
- end;
- end;
- //=== { TJvTabBarItem } ======================================================
- constructor TJvTabBarItem.Create(Collection: Classes.TCollection);
- begin
- inherited Create(Collection);
- FImageIndex := -1;
- FEnabled := True;
- FVisible := True;
- FShowHint := True;
- end;
- destructor TJvTabBarItem.Destroy;
- begin
- PopupMenu := nil;
- Visible := False; // CanSelect returns false
- FAutoDeleteDatas.Free;
- inherited Destroy;
- end;
- procedure TJvTabBarItem.Assign(Source: TPersistent);
- begin
- if Source is TJvTabBarItem then
- begin
- with TJvTabBarItem(Source) do
- begin
- Self.FImageIndex := FImageIndex;
- Self.FEnabled := FEnabled;
- Self.FVisible := FVisible;
- Self.FTag := FTag;
- Self.FData := FData;
- Self.FHint := FHint;
- Self.FShowHint := FShowHint;
- Self.FName := FName;
- Self.FCaption := FCaption;
- Self.FModified := FModified;
- Self.FImages := FImages;
- Changed;
- end;
- end
- else
- inherited Assign(Source);
- end;
- procedure TJvTabBarItem.Notification(Component: TComponent;
- Operation: TOperation);
- begin
- if Operation = opRemove then
- if Component = PopupMenu then
- PopupMenu := nil;
- end;
- procedure TJvTabBarItem.Changed;
- begin
- TabBar.Changed;
- end;
- function TJvTabBarItem.GetDisplayRect: TRect;
- begin
- if not Visible then
- Result := Rect(-1, -1, -1, -1)
- else
- begin
- if FLeft = -1 then
- TabBar.CalcTabsRects; // not initialized
- case TabBar.Orientation of
- toBottom:
- Result := Rect(FLeft, 0,
- FLeft + TabBar.GetTabWidth(Self), 0 + TabBar.GetTabHeight(Self));
- else
- // toTop
- Result := Rect(FLeft, TabBar.ClientHeight - TabBar.GetTabHeight(Self),
- FLeft + TabBar.GetTabWidth(Self), TabBar.ClientHeight);
- end;
- end;
- end;
- function TJvTabBarItem.GetHot: Boolean;
- begin
- Result := TabBar.HotTab = Self;
- end;
- function TJvTabBarItem.GetImages: TCustomImageList;
- begin
- Result := TabBar.Images;
- end;
- function TJvTabBarItem.GetSelected: Boolean;
- begin
- Result := TabBar.SelectedTab = Self;
- end;
- function TJvTabBarItem.GetTabBar: TJvCustomTabBar;
- begin
- Result := (GetOwner as TJvTabBarItems).TabBar;
- end;
- procedure TJvTabBarItem.SetCaption(const Value: TCaption);
- var
- PageListIntf: IPageList;
- begin
- if Value <> FCaption then
- begin
- FCaption := Value;
- if TabBar.PageListTabLink and (TabBar.PageList <> nil) and
- not (csLoading in TabBar.ComponentState) and
- Supports(TabBar.PageList, IPageList, PageListIntf) then
- PageListIntf.PageCaptionChanged(Index, FCaption);
- Changed;
- end;
- end;
- procedure TJvTabBarItem.SetEnabled(const Value: Boolean);
- begin
- if Value <> FEnabled then
- begin
- FEnabled := Value;
- Changed;
- end;
- end;
- procedure TJvTabBarItem.SetImageIndex(const Value: TImageIndex);
- begin
- if Value <> FImageIndex then
- begin
- FImageIndex := Value;
- Changed;
- end;
- end;
- procedure TJvTabBarItem.SetName(const Value: string);
- begin
- if (Value <> FName) and (TJvTabBarItems(Collection).Find(Value) = nil) then
- FName := Value;
- end;
- procedure TJvTabBarItem.SetSelected(const Value: Boolean);
- begin
- if Value then
- TabBar.SelectedTab := Self;
- end;
- procedure TJvTabBarItem.SetVisible(const Value: Boolean);
- begin
- if Value <> FVisible then
- begin
- FVisible := Value;
- FLeft := -1; // discard
- Changed;
- end;
- end;
- function TJvTabBarItem.CanSelect: Boolean;
- begin
- Result := Visible and Enabled;
- end;
- function TJvTabBarItem.GetNextVisible: TJvTabBarItem;
- var
- I: Integer;
- begin
- for I := Index + 1 to TabBar.Tabs.Count - 1 do
- if TabBar.Tabs[I].Visible then
- begin
- Result := TabBar.Tabs[I];
- Exit;
- end;
- Result := nil;
- end;
- function TJvTabBarItem.GetPreviousVisible: TJvTabBarItem;
- var
- I: Integer;
- begin
- for I := Index - 1 downto 0 do
- if TabBar.Tabs[I].Visible then
- begin
- Result := TabBar.Tabs[I];
- Exit;
- end;
- Result := nil;
- end;
- function TJvTabBarItem.AutoDeleteData: TObjectList;
- begin
- if FAutoDeleteDatas = nil then
- FAutoDeleteDatas := TObjectList.Create;
- Result := FAutoDeleteDatas;
- end;
- function TJvTabBarItem.GetClosing: Boolean;
- begin
- Result := TabBar.ClosingTab = Self;
- end;
- procedure TJvTabBarItem.SetModified(const Value: Boolean);
- begin
- if Value <> FModified then
- begin
- FModified := Value;
- Changed;
- end;
- end;
- procedure TJvTabBarItem.SetPopupMenu(const Value: TPopupMenu);
- begin
- if Value <> FPopupMenu then
- begin
- if FPopupMenu <> nil then
- FPopupMenu.RemoveFreeNotification(TabBar);
- FPopupMenu := Value;
- if FPopupMenu <> nil then
- FPopupMenu.FreeNotification(TabBar);
- end;
- end;
- procedure TJvTabBarItem.MakeVisible;
- begin
- TabBar.MakeVisible(Self);
- end;
- function TJvTabBarItem.GetEnabled: Boolean;
- begin
- Result := FEnabled;
- if Assigned(FOnGetEnabled) then
- FOnGetEnabled(Self, Result);
- end;
- function TJvTabBarItem.GetModified: Boolean;
- begin
- Result := FModified;
- if Assigned(FOnGetModified) then
- FOnGetModified(Self, Result);
- end;
- procedure TJvTabBarItem.SetIndex(Value: Integer);
- var
- PageListIntf: IPageList;
- LastIndex: Integer;
- begin
- LastIndex := Index;
- inherited SetIndex(Value);
- if TabBar.PageListTabLink and (LastIndex <> Index) and (TabBar.PageList <> nil) and
- not (csLoading in TabBar.ComponentState) and
- Supports(TabBar.PageList, IPageList, PageListIntf) then
- PageListIntf.MovePage(LastIndex, Index);
- Changed;
- end;
- //=== { TJvTabBarItems } =====================================================
- procedure TJvTabBarItems.EndUpdate;
- begin
- inherited EndUpdate;
- if UpdateCount = 0 then
- TabBar.Changed;
- end;
- function TJvTabBarItems.Find(const AName: string): TJvTabBarItem;
- var
- I: Integer;
- begin
- Result := nil;
- for I := 0 to Count - 1 do
- if Items[I].Name = AName then
- begin
- Result := Items[I];
- Break;
- end;
- end;
- function TJvTabBarItems.GetTabBar: TJvCustomTabBar;
- begin
- Result := GetOwner as TJvCustomTabBar;
- end;
- function TJvTabBarItems.GetItem(Index: Integer): TJvTabBarItem;
- begin
- Result := TJvTabBarItem(inherited Items[Index]);
- end;
- procedure TJvTabBarItems.SetItem(Index: Integer; const Value: TJvTabBarItem);
- begin
- if Value <> GetItem(Index) then
- GetItem(Index).Assign(Value);
- end;
- procedure TJvTabBarItems.Notify(Item: TCollectionItem; Action: TCollectionNotification);
- var
- PageListIntf: IPageList;
- begin
- inherited Notify(Item, Action);
- if Action in [cnExtracting, cnDeleting] then
- begin
- // unselect the item to delete
- if TabBar.SelectedTab = Item then
- TabBar.SelectedTab := nil;
- if TabBar.HotTab = Item then
- TabBar.SetHotTab(nil);
- if TabBar.FMouseDownClosingTab = Item then
- TabBar.FMouseDownClosingTab := nil;
- if TabBar.ClosingTab = Item then
- TabBar.FClosingTab := nil;
- if TabBar.FLastInsertTab = Item then
- TabBar.FLastInsertTab := nil;
- if not (csDestroying in TabBar.ComponentState) and (TabBar.LeftTab = Item) then
- TabBar.LeftTab := TabBar.LeftTab.GetPreviousVisible;
- end;
- if TabBar.PageListTabLink and (TabBar.PageList <> nil) and
- not (csLoading in TabBar.ComponentState) and
- Supports(TabBar.PageList, IPageList, PageListIntf) then
- begin
- case Action of
- cnAdded:
- PageListIntf.AddPage(TJvTabBarItem(Item).Caption);
- cnExtracting, cnDeleting:
- PageListIntf.DeletePage(TJvTabBarItem(Item).Index);
- end;
- end;
- TabBar.Changed;
- end;
- function TJvTabBarItems.IndexOf(Item: TJvTabBarItem): Integer;
- begin
- for Result := 0 to Count - 1 do
- if Items[Result] = Item then
- Exit;
- Result := -1;
- end;
- //=== { TJvTabBarPainter } ===================================================
- constructor TJvTabBarPainter.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FOnChangeList := TList.Create;
- end;
- destructor TJvTabBarPainter.Destroy;
- begin
- { _mxn_ }
- // WriteStyleImages(nil);
- inherited Destroy; // invokes TJvTabBar.Notification that accesses FOnChangeList
- FOnChangeList.Free;
- end;
- procedure TJvTabBarPainter.Changed;
- var
- i: Integer;
- begin
- for i := 0 to FOnChangeList.Count - 1 do
- TJvCustomTabBar(FOnChangeList[i]).ImagesChanged(Self);
- end;
- procedure TJvTabBarPainter.GetScrollButtons(TabBar: TJvCustomTabBar; var LeftButton, RightButton: TRect);
- begin
- { reserved for future use }
- end;
- procedure TJvTabBarPainter.DrawScrollButton(Canvas: TCanvas; TabBar: TJvCustomTabBar; Button: TJvTabBarScrollButtonKind;
- State: TJvTabBarScrollButtonState; R: TRect);
- {$IFDEF JVCLThemesEnabled}
- const
- States: array[TJvTabBarScrollButtonState] of Integer = (0, 0, DFCS_HOT, DFCS_PUSHED, DFCS_INACTIVE);
- ScrollTypes: array[TJvTabBarScrollButtonKind] of Integer = (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT);
- {$ENDIF JVCLThemesEnabled}
- begin
- {$IFDEF JVCLThemesEnabled}
- if ThemeServices.{$IFDEF RTL230_UP}Enabled{$ELSE}ThemesEnabled{$ENDIF RTL230_UP} then
- DrawThemedFrameControl(Canvas.Handle, R, DFC_SCROLL, ScrollTypes[Button] or States[State])
- else
- {$ENDIF JVCLThemesEnabled}
- begin
- if TabBar.FlatScrollButtons then
- DrawButtonFace(Canvas, R, 1, bsNew, False, State = sbsPressed, False)
- else
- DrawButtonFace(Canvas, R, 1, bsWin31, False, State = sbsPressed, False);
- if State = sbsPressed then
- OffsetRect(R, 1, 1);
- TabBar.DrawScrollBarGlyph(Canvas,
- R.Left + (R.Right - R.Left - 4) div 2,
- R.Top + (R.Bottom - R.Top - 7) div 2,
- Button = sbScrollLeft, State = sbsDisabled);
- end;
- end;
- //=== { TJvModernTabBarPainter } =============================================
- constructor TJvModernTabBarPainter.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- FFont := TFont.Create;
- FDisabledFont := TFont.Create;
- FSelectedFont := TFont.Create;
- FFont.Color := clWindowText;
- FDisabledFont.Color := clGrayText;
- FSelectedFont.Assign(FFont);
- FFont.OnChange := FontChanged;
- FDisabledFont.OnChange := FontChanged;
- FSelectedFont.OnChange := FontChanged;
- FTabColor := clBtnFace;
- FColor := clWindow;
- FBorderColor := clSilver;
- FControlDivideColor := clBlack;
- FModifiedCrossColor := clRed;
- FCloseColorSelected := $F4F4F4;
- FCloseColor := clWhite;
- FCloseCrossColorSelected := clBlack;
- FCloseCrossColor := $5D5D5D;
- FCloseCrossColorDisabled := $ADADAD;
- FCloseRectColor := $868686;
- FCloseRectColorDisabled := $D6D6D6;
- FDividerColor := $99A8AC;
- FMoveDividerColor := clBlack;
- end;
- destructor TJvModernTabBarPainter.Destroy;
- begin
- FFont.Free;
- FDisabledFont.Free;
- FSelectedFont.Free;
- { _mxn_ }
- // WriteStyleImages(nil);
- inherited Destroy;
- end;
- { _mxn_ }
- procedure TJvCustomTabBar.WriteStyleImages(const Value: TStrings);
- var tmp:TStrings;
- begin
- if(FStyleImages<>nil) then begin
- FreeAndNil(FStyleImages.TOP_background);
- FreeAndNil(FStyleImages.TOP_active_left_side);
- FreeAndNil(FStyleImages.TOP_active_right_side);
- FreeAndNil(FStyleImages.TOP_active_center);
- FreeAndNil(FStyleImages.BOTTOM_background);
- FreeAndNil(FStyleImages.BOTTOM_active_left_side);
- FreeAndNil(FStyleImages.BOTTOM_active_right_side);
- FreeAndNil(FStyleImages.BOTTOM_active_center);
- FreeAndNil(FStyleImages.CLOSEBUTTON_normal);
- FreeAndNil(FStyleImages.CLOSEBUTTON_selected);
- FreeAndNil(FStyleImages.CLOSEBUTTON_disabled);
- FreeAndNil(FStyleImages.CLOSEBUTTON_closing);
- FreeAndNil(FStyleImages.CLOSEBUTTON_modified);
- FreeAndNil(FStyleImages.CLOSEBUTTON_closing_modified);
- FreeAndNil(FStyleImages);
- end;
- if(StyleImagesArray<>nil) then
- FreeAndNil(StyleImagesArray);
- if(Value<>nil) then begin
- tmp:=TStringList.Create;
- tmp.Text:=Value.Text;
- StyleImagesArray:=tmp;
- FStyleImages:=TStyleImages.Create;
- with FStyleImages do begin
- TOP_background:=TPngImage.Create;
- TOP_background.LoadFromFile(StyleImagesArray.Values['TOP_background']);
- TOP_active_left_side:=TPngImage.Create;
- TOP_active_left_side.LoadFromFile(StyleImagesArray.Values['TOP_active_left_side']);
- TOP_active_right_side:=TPngImage.Create;
- TOP_active_right_side.LoadFromFile(StyleImagesArray.Values['TOP_active_right_side']);
- TOP_active_center:=TPngImage.Create;
- TOP_active_center.LoadFromFile(StyleImagesArray.Values['TOP_active_center']);
- BOTTOM_background:=TPngImage.Create;
- BOTTOM_background.LoadFromFile(StyleImagesArray.Values['BOTTOM_background']);
- BOTTOM_active_left_side:=TPngImage.Create;
- BOTTOM_active_left_side.LoadFromFile(StyleImagesArray.Values['BOTTOM_active_left_side']);
- BOTTOM_active_right_side:=TPngImage.Create;
- BOTTOM_active_right_side.LoadFromFile(StyleImagesArray.Values['BOTTOM_active_right_side']);
- BOTTOM_active_center:=TPngImage.Create;
- BOTTOM_active_center.LoadFromFile(StyleImagesArray.Values['BOTTOM_active_center']);
- CLOSEBUTTON_normal:=TPngImage.Create;
- CLOSEBUTTON_normal.LoadFromFile(StyleImagesArray.Values['CLOSEBUTTON_normal']);
- CLOSEBUTTON_selected:=TPngImage.Create;
- CLOSEBUTTON_selected.LoadFromFile(StyleImagesArray.Values['CLOSEBUTTON_selected']);
- CLOSEBUTTON_disabled:=TPngImage.Create;
- CLOSEBUTTON_disabled.LoadFromFile(StyleImagesArray.Values['CLOSEBUTTON_disabled']);
- CLOSEBUTTON_closing:=TPngImage.Create;
- CLOSEBUTTON_closing.LoadFromFile(StyleImagesArray.Values['CLOSEBUTTON_closing']);
- CLOSEBUTTON_modified:=TPngImage.Create;
- CLOSEBUTTON_modified.LoadFromFile(StyleImagesArray.Values['CLOSEBUTTON_modified']);
- CLOSEBUTTON_closing_modified:=TPngImage.Create;
- CLOSEBUTTON_closing_modified.LoadFromFile(StyleImagesArray.Values['CLOSEBUTTON_closing_modified']);
- end;
- end;
- CalcTabsRects;
- Repaint;
- end;
- procedure TJvModernTabBarPainter.DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect);
- begin
- with Canvas do
- begin
- Brush.Style := bsSolid;
- Brush.Color := Color;
- FillRect(R);
- Brush.Style := bsClear;
- Pen.Color := BorderColor;
- Pen.Width := 1;
- if TabBar.Orientation = toBottom then
- begin
- { _mxn_ }
- if(TabBar.StyleImages<>nil) then begin
- // Рисуем фон (заливка)
- StretchDraw(R,TabBar.FStyleImages.BOTTOM_background);
- end else begin
- MoveTo(0, R.Bottom - 1);
- LineTo(0, 0);
- Pen.Color := ControlDivideColor;
- LineTo(R.Right - 1, 0);
- Pen.Color := BorderColor;
- LineTo(R.Right - 1, R.Bottom - 1);
- LineTo(0, R.Bottom - 1);
- end;
- end
- else // toTop
- begin
- { _mxn_ }
- if(TabBar.StyleImages<>nil) then begin
- // Рисуем фон (заливка)
- StretchDraw(R,TabBar.FStyleImages.TOP_background);
- end else begin
- MoveTo(0, R.Bottom - 1);
- LineTo(0, 0);
- LineTo(R.Right - 1, 0);
- LineTo(R.Right - 1, R.Bottom - 1);
- Pen.Color := ControlDivideColor;
- LineTo(0, R.Bottom - 1);
- end;
- end;
- end;
- end;
- procedure TJvModernTabBarPainter.DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect);
- begin
- if not LeftTab.Selected then
- begin
- if (LeftTab.TabBar.SelectedTab = nil) or
- (LeftTab.GetNextVisible <> LeftTab.TabBar.SelectedTab) then
- begin
- with Canvas do
- begin
- Pen.Color := DividerColor;
- Pen.Width := 1;
- MoveTo(R.Right - 1, R.Top + 3);
- LineTo(R.Right - 1, R.Bottom - 3);
- end;
- end;
- end;
- end;
- procedure TJvModernTabBarPainter.DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean);
- var
- R: TRect;
- begin
- with Canvas do
- begin
- R := Tab.DisplayRect;
- Inc(R.Top, 4);
- Dec(R.Bottom, 2);
- if MoveLeft then
- begin
- Dec(R.Left);
- R.Right := R.Left + 4
- end
- else
- begin
- Dec(R.Right, 1);
- R.Left := R.Right - 4;
- end;
- Brush.Color := MoveDividerColor;
- FillRect(R);
- end;
- end;
- procedure TJvModernTabBarPainter.DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect);
- { _mxn_ }
- procedure DrawWithAlphaBend(const Handle:HDC; YourRect:TRect; Graphic:TGraphic);
- var
- bitmap : TBitmap;
- bf : BLENDFUNCTION;
- ret : Boolean;
- begin
- bf.BlendOp:=AC_SRC_OVER;
- bf.BlendFlags:=0;
- bf.AlphaFormat:=AC_SRC_ALPHA;
- bf.SourceConstantAlpha:=$ff; // 255
- bitmap := TBitmap.Create;
- try
- bitmap.Width := YourRect.Width;
- bitmap.Height := YourRect.Height;
- bitmap.PixelFormat := pf32bit;
- bitmap.Assign(Graphic);
- ret := Windows.AlphaBlend(
- Handle,
- YourRect.Left,
- YourRect.Top,
- YourRect.Width,
- YourRect.Height,
- bitmap.Canvas.Handle,
- 0,
- 0,
- YourRect.Width,
- YourRect.Height,
- bf);
- ASSERT(ret);
- finally
- bitmap.Free;
- end;
- end;
- var
- CloseR: TRect;
- begin
- with Canvas do
- begin
- Brush.Style := bsSolid;
- Brush.Color := Color;
- Pen.Mode := pmCopy;
- Pen.Style := psSolid;
- Pen.Width := 1;
- if Tab.Selected then
- begin
- Brush.Style := bsSolid;
- Brush.Color := TabColor;
- { _mxn_ }
- if(Tab.TabBar.StyleImages=nil) then
- FillRect(R); // Затираем область, если не картинками рисуем (убивает прозрачность но добавляет линии)
- Pen.Color := ControlDivideColor;
- if Tab.TabBar.Orientation = toBottom then
- begin
- { _mxn_ }
- if(Tab.TabBar.StyleImages<>nil) then begin
- // Рисуем левый бок
- // DrawWithAlphaBend(Handle,Rect(R.Left,R.Top,R.Left+FStyleImages.BOTTOM_active_left_side.Width,R.Top+FStyleImages.BOTTOM_active_left_side.Height),FStyleImages.BOTTOM_active_left_side);
- Draw(R.Left,R.Top,Tab.TabBar.FStyleImages.BOTTOM_active_left_side);
- // Рисуем правый бок
- Draw(R.Right-Tab.TabBar.FStyleImages.BOTTOM_active_right_side.Width,R.Top,Tab.TabBar.FStyleImages.BOTTOM_active_right_side);
- // Рисуем центр
- StretchDraw(
- Rect(
- R.Left+Tab.TabBar.FStyleImages.BOTTOM_active_left_side.Width,
- R.Top,
- R.Right-Tab.TabBar.FStyleImages.BOTTOM_active_right_side.Width,
- R.Top+Tab.TabBar.FStyleImages.BOTTOM_active_center.Height
- ),
- Tab.TabBar.FStyleImages.BOTTOM_active_center);
- end else begin
- MoveTo(R.Left, R.Top);
- LineTo(R.Left, R.Bottom - 1);
- LineTo(R.Right - 1, R.Bottom - 1);
- LineTo(R.Right - 1, R.Top - 1{end});
- end;
- end
- else // toTop
- begin
- { _mxn_ }
- if(Tab.TabBar.StyleImages<>nil) then begin
- // Рисуем левый бок
- // DrawWithAlphaBend(Handle,Rect(R.Left,R.Top,R.Left+FStyleImages.TOP_active_left_side.Width,R.Top+FStyleImages.TOP_active_left_side.Height),FStyleImages.TOP_active_left_side);
- Draw(R.Left,R.Top,Tab.TabBar.FStyleImages.TOP_active_left_side);
- // Рисуем правый бок
- Draw(R.Right-Tab.TabBar.FStyleImages.TOP_active_right_side.Width,R.Top,Tab.TabBar.FStyleImages.TOP_active_right_side);
- // Рисуем центр
- StretchDraw(
- Rect(
- R.Left+Tab.TabBar.FStyleImages.TOP_active_left_side.Width,
- R.Top,
- R.Right-Tab.TabBar.FStyleImages.TOP_active_right_side.Width,
- R.Top+Tab.TabBar.FStyleImages.TOP_active_center.Height
- ),
- Tab.TabBar.FStyleImages.TOP_active_center);
- end else begin
- MoveTo(R.Left, R.Bottom - 1);
- LineTo(R.Left, R.Top);
- LineTo(R.Right - 1, R.Top);
- LineTo(R.Right - 1, R.Bottom - 1 + 1{end});
- end;
- end;
- end;
- if Tab.Enabled and not Tab.Selected and Tab.Hot then
- begin
- // hot
- Pen.Color := DividerColor;
- MoveTo(R.Left, R.Top);
- LineTo(R.Right - 1 - 1, R.Top);
- end;
- if Tab.TabBar.CloseButton then
- begin
- if(Tab.TabBar.StyleImages<>nil) then begin // Если указан стиль - то меняем рисование крестика на изображения
- CloseR := GetCloseRect(Canvas, Tab, R);
- if Tab.Modified and Tab.Closing then // Modified && Closing
- StretchDraw(CloseR,Tab.TabBar.FStyleImages.CLOSEBUTTON_closing_modified)
- else if Tab.Closing then
- StretchDraw(CloseR,Tab.TabBar.FStyleImages.CLOSEBUTTON_closing)
- else if not Tab.Enabled then // disabled
- StretchDraw(CloseR,Tab.TabBar.FStyleImages.CLOSEBUTTON_disabled)
- else if Tab.Modified then
- StretchDraw(CloseR,Tab.TabBar.FStyleImages.CLOSEBUTTON_modified)
- else if Tab.Selected then
- StretchDraw(CloseR,Tab.TabBar.FStyleImages.CLOSEBUTTON_selected)
- else
- StretchDraw(CloseR,Tab.TabBar.FStyleImages.CLOSEBUTTON_normal);
- { _mxn_ }
- if not Tab.TabBar.CloseButtonRight then
- R.Left := CloseR.Right; // Если убить - текст не смещается в право (для переноса кнопки закрытия в лево)
- end else begin
- // close button color
- if Tab.Selected then
- Brush.Color := CloseColorSelected
- else
- Brush.Color := CloseColor;
- CloseR := GetCloseRect(Canvas, Tab, R);
- Pen.Color := CloseRectColor;
- if not Tab.Enabled then
- Pen.Color := CloseRectColorDisabled;
- if Tab.Closing then
- // shrink
- Rectangle(CloseR.Left + 1, CloseR.Top + 1, CloseR.Right - 1, CloseR.Bottom - 1)
- else
- Rectangle(CloseR);
- if Tab.Modified then
- Pen.Color := ModifiedCrossColor
- else
- if Tab.Selected and not Tab.Closing then
- Pen.Color := CloseCrossColorSelected
- else
- if Tab.Enabled then
- Pen.Color := CloseCrossColor
- else
- Pen.Color := CloseCrossColorDisabled;
- // close cross
- MoveTo(CloseR.Left + 3, CloseR.Top + 3);
- LineTo(CloseR.Right - 3, CloseR.Bottom - 3);
- MoveTo(CloseR.Left + 4, CloseR.Top + 3);
- LineTo(CloseR.Right - 4, CloseR.Bottom - 3);
- MoveTo(CloseR.Right - 4, CloseR.Top + 3);
- LineTo(CloseR.Left + 2, CloseR.Bottom - 3);
- MoveTo(CloseR.Right - 5, CloseR.Top + 3);
- LineTo(CloseR.Left + 3, CloseR.Bottom - 3);
- // remove intersection
- if Tab.Modified then
- FillRect(Rect(CloseR.Left + 5, CloseR.Top + 4, CloseR.Right - 5, CloseR.Bottom - 4));
- { _mxn_ }
- if not Tab.TabBar.CloseButtonRight then
- R.Left := CloseR.Right; // Если убить - текст не смещается в право (для переноса кнопки закрытия в лево)
- end;
- end;
- InflateRect(R, -1, -1);
- if not Tab.TabBar.CloseButton then
- Inc(R.Left, 2);
- if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then
- begin
- { _mxn_ }
- if Tab.TabBar.CloseButtonRight then
- Tab.GetImages.Draw(Canvas, R.Left +2 +2, R.Top + (R.Bottom - R.Top - Tab.GetImages.Height) div 2,
- Tab.ImageIndex, Tab.Enabled)
- else
- Tab.GetImages.Draw(Canvas, R.Left, R.Top + (R.Bottom - R.Top - Tab.GetImages.Height) div 2,
- Tab.ImageIndex, Tab.Enabled);
- Inc(R.Left, Tab.GetImages.Width + 2);
- end;
- if Tab.Enabled then
- begin
- if Tab.Selected then
- Font.Assign(Self.SelectedFont)
- else
- Font.Assign(Self.Font);
- end
- else
- Font.Assign(Self.DisabledFont);
- Brush.Style := bsClear;
- { _mxn_ }
- if Tab.TabBar.CloseButtonRight then
- TextRect(R, R.Left + 3 +3, R.Top + 3 -1, Tab.Caption)
- else
- TextRect(R, R.Left + 3, R.Top + 3 -1, Tab.Caption)
- end;
- end;
- function TJvModernTabBarPainter.GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect;
- begin
- { _mxn_ }
- if Tab.TabBar.CloseButtonRight then
- Result.Left := R.Right - 5 - 12 + 1
- else
- Result.Left := R.Left + 5;
- { _mxn_ }
- if(Tab.TabBar.StyleImages<>nil) then begin // Если указан юзер-стиль то изменяем размер кнопки на 12x12 и сдвигаем ниже
- Result.Top := R.Top + 5 -1; { _mxn_ }
- Result.Right := Result.Left + 12;
- Result.Bottom := Result.Top + 11 +1; { _mxn_ }
- end else begin
- Result.Top := R.Top + 5;
- Result.Right := Result.Left + 12;
- Result.Bottom := Result.Top + 11;
- end;
- end;
- function TJvModernTabBarPainter.GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer;
- begin
- Result := 1;
- end;
- function TJvModernTabBarPainter.GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize;
- begin
- if Tab.Enabled then
- begin
- if Tab.Selected then
- Canvas.Font.Assign(SelectedFont)
- else
- Canvas.Font.Assign(Font)
- end
- else
- Canvas.Font.Assign(DisabledFont);
- { _mxn_ }
- if Tab.Caption<>'' then // Добавляем условие если пустой таб - уменьшить размер
- Result.cx := Canvas.TextWidth(Tab.Caption) + 11// -4
- else
- Result.cx := 5;
- Result.cy := Canvas.TextHeight(Tab.Caption + 'Ag') + 7;
- if Tab.TabBar.CloseButton then
- Result.cx := Result.cx + 15;
- if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then
- Result.cx := Result.cx + Tab.GetImages.Width + 2;
- if TabWidth > 0 then
- Result.cx := TabWidth;
- end;
- function TJvModernTabBarPainter.Options: TJvTabBarPainterOptions;
- begin
- Result := [poPaintsHotTab];
- end;
- procedure TJvModernTabBarPainter.FontChanged(Sender: TObject);
- begin
- Changed;
- end;
- procedure TJvModernTabBarPainter.SetBorderColor(const Value: TColor);
- begin
- if Value <> FBorderColor then
- begin
- FBorderColor := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetColor(const Value: TColor);
- begin
- if Value <> FColor then
- begin
- FColor := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetControlDivideColor(const Value: TColor);
- begin
- if Value <> FControlDivideColor then
- begin
- FControlDivideColor := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetModifiedCrossColor(const Value: TColor);
- begin
- if Value <> FModifiedCrossColor then
- begin
- FModifiedCrossColor := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetTabColor(const Value: TColor);
- begin
- if Value <> FTabColor then
- begin
- FTabColor := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetCloseColor(const Value: TColor);
- begin
- if Value <> FCloseColor then
- begin
- FCloseColor := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetCloseColorSelected(const Value: TColor);
- begin
- if Value <> FCloseColorSelected then
- begin
- FCloseColorSelected := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetCloseCrossColor(const Value: TColor);
- begin
- if Value <> FCloseCrossColor then
- begin
- FCloseCrossColor := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetCloseCrossColorDisabled(const Value: TColor);
- begin
- if Value <> FCloseCrossColorDisabled then
- begin
- FCloseCrossColorDisabled := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetCloseCrossColorSelected(const Value: TColor);
- begin
- if Value <> FCloseCrossColorSelected then
- begin
- FCloseCrossColorSelected := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetCloseRectColor(const Value: TColor);
- begin
- if Value <> FCloseRectColor then
- begin
- FCloseRectColor := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetCloseRectColorDisabled(const Value: TColor);
- begin
- if Value <> FCloseRectColorDisabled then
- begin
- FCloseRectColorDisabled := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetDividerColor(const Value: TColor);
- begin
- if Value <> FDividerColor then
- begin
- FDividerColor := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetTabWidth(Value: Integer);
- begin
- if Value < 0 then
- Value := 0;
- if Value <> FTabWidth then
- begin
- FTabWidth := Value;
- Changed;
- end;
- end;
- procedure TJvModernTabBarPainter.SetFont(const Value: TFont);
- begin
- if Value <> FFont then
- FFont.Assign(Value);
- end;
- procedure TJvModernTabBarPainter.SetDisabledFont(const Value: TFont);
- begin
- if Value <> FDisabledFont then
- FDisabledFont.Assign(Value);
- end;
- procedure TJvModernTabBarPainter.SetSelectedFont(const Value: TFont);
- begin
- if Value <> FSelectedFont then
- FSelectedFont.Assign(Value);
- end;
- {$IFDEF UNITVERSIONING}
- initialization
- RegisterUnitVersion(HInstance, UnitVersioning);
- finalization
- UnregisterUnitVersion(HInstance);
- {$ENDIF UNITVERSIONING}
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement