{----------------------------------------------------------------------------- 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 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$ unit JvTabBar; {$MODE objfpc}{$H+} {$DEFINE JVCLThemesEnabled} interface uses LCLIntf, LCLType, LMessages, LCLVersion, Types, Graphics, Controls, Forms, ImgList, Menus, Buttons, ExtCtrls, SysUtils, Classes, Contnrs, Themes, JvPageList; 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; TJvTabBarItem = class(TCollectionItem) private FLeft: Integer; // used for calculating DisplayRect FImageIndex: TImageIndex; FEnabled: Boolean; FVisible: Boolean; FTag: PtrInt; 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(ACollection: 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: PtrInt 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; TJvTabBarPainter = class(TComponent) private FOnChangeList: TList; protected procedure AutoSize; virtual; procedure Changed; virtual; procedure DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect); virtual; abstract; procedure DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); virtual; abstract; procedure DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean); virtual; abstract; procedure DrawScrollButton(Canvas: TCanvas; TabBar: TJvCustomTabBar; Button: TJvTabBarScrollButtonKind; State: TJvTabBarScrollButtonState; R: TRect); virtual; procedure DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect); virtual; abstract; function GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect; virtual; abstract; function GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; virtual; abstract; function GetPixelsPerInch: Integer; virtual; abstract; function GetRealImageSize(ATab: TJvTabBarItem): TSize; procedure GetScrollButtons({%H-}TabBar: TJvCustomTabBar; var {%H-}LeftButton, {%H-}RightButton: TRect); {virtual; reserved for future use } function GetTabBar(ATab: TJvTabBarItem): TJvCustomTabBar; function GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; virtual; abstract; function Options: TJvTabBarPainterOptions; virtual; abstract; function Scale(ABar: TJvCustomTabBar; n: Integer): Integer; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; 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; FTabHeight: Integer; 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 SetTabHeight(Value: Integer); procedure SetTabWidth(Value: Integer); protected procedure AutoSize; override; procedure DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect); override; procedure DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); override; procedure DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean); override; procedure DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; ATabRect: TRect); override; function GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; ATabRect: TRect): TRect; override; function GetDividerWidth({%H-}Canvas: TCanvas; {%H-}LeftTab: TJvTabBarItem): Integer; override; function GetPixelsPerInch: Integer; override; function GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; 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 TabHeight: Integer read FTabHeight write SetTabHeight default 0; 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; FRightClickSelect: Boolean; FImages: TCustomImageList; FImagesWidth: Integer; 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; function GetHeight: Integer; 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 SetFlatScrollButtons(const Value: Boolean); procedure SetPageList(const Value: TCustomControl); procedure SetOrientation(const Value: TJvTabBarOrientation); procedure TimerExpired(Sender: TObject); procedure SetHeight(AValue: Integer); protected procedure CalcTabsRects; procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override; procedure DrawScrollBarGlyph(ACanvas: TCanvas; X, Y: Integer; ALeft, Disabled: Boolean); procedure Paint; override; procedure PaintScrollButtons; procedure PaintTab(ACanvas: TCanvas; Tab: TJvTabBarItem); virtual; procedure Resize; override; class function GetControlClassDefaultSize: TSize; override; function GetTabHeight(Tab: TJvTabBarItem): Integer; function GetTabWidth(Tab: TJvTabBarItem): Integer; 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: TLMessage); message CM_MOUSELEAVE; procedure WMEraseBkgnd(var Msg: TLMEraseBkgnd); message LM_ERASEBKGND; procedure Loaded; override; procedure SetHint(const Value: TCaption); override; // LCL scaling {$IF LCL_FullVersion >= 1080000} procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override; {$IFEND} {$IF LCL_FullVersion >= 1090000} procedure SetImagesWidth(const AValue: Integer); {$ENDIF} public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function AddTab(const ACaption: string): TJvTabBarItem; function FindTab(const ACaption: string): TJvTabBarItem; // returns the first tab with the given Caption function TabAt(X, Y: Integer): TJvTabBarItem; 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; {$IF LCL_FullVersion >= 1090000} property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0; {$ENDIF} 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; 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 Height read GetHeight write SetHeight; 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; TJvTabBar = class(TJvCustomTabBar) published property Align default alTop; property AutoSize default true; property BorderSpacing; property Constraints; property Cursor; property PopupMenu; property ShowHint default False; property Height; property Hint; property Visible; property Enabled; property Orientation; property CloseButton; property RightClickSelect; property HotTracking; property AutoFreeClosed; property AllowUnselected; property SelectBeforeClose; property Margin; property FlatScrollButtons; property AllowTabMoving; property PageListTabLink; property PageList; property Painter; property Images; {$IF LCL_FullVersion >= 1090000} property ImagesWidth; {$ENDIF} 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; implementation uses JvJVCLUtils; const WHEEL_DELTA = 120; // Pixels at 96 ppi: LEFT_MARGIN = 8; // Distance left edge to image or text RIGHT_MARGIN = 8; // Distance right edge to close button or text TEXT_MARGIN_LEFT = 8; // Distance image to text TEXT_MARGIN_RIGHT = 8; // Distance text to close btn TOP_MARGIN = 4; // Distance top edge to text/image/close btn (whichever is highest) BOTTOM_MARGIN = 4; // Distance bottom edge to text/image/close btn (whichever is lowest) CLOSE_BUTTON_SIZE = 12; // size of the close button box CROSS_MARGIN = 8; // Margin of the "x" inside the close button var LeftMargin: Integer = LEFT_MARGIN; RightMargin: Integer = RIGHT_MARGIN; TextMarginLeft: Integer = TEXT_MARGIN_LEFT; TextMarginRight: Integer = TEXT_MARGIN_RIGHT; TopMargin: Integer = TOP_MARGIN; BottomMargin: Integer = BOTTOM_MARGIN; CloseButtonSize: Integer = CLOSE_BUTTON_SIZE; CrossMargin: Integer = CROSS_MARGIN; function DrawButtonFace(ACanvas: TCanvas; const ARect: TRect; AFlat: Boolean; // BevelWidth: Integer; Style: TButtonStyle; IsRounded, IsDown, IsFocused: Boolean): TRect; var R: TRect; begin R := ARect; ACanvas.Pen.Style := psSolid; if AFlat then begin ACanvas.Brush.Color := clBtnFace; ACanvas.Brush.Style := bsSolid; ACanvas.FillRect(R); if IsDown then begin ACanvas.Pen.Color := clBlack; ACanvas.Line(R.Left, R.Top, R.Left, R.Bottom-1); // left ACanvas.Line(R.Left, R.Top, R.Right-1, R.Top); // top ACanvas.Pen.Color := clBtnHighlight; ACanvas.Line(R.Right-1, R.Top, R.Right-1, R.Bottom-1); // right ACanvas.Line(R.Left, R.Bottom-1, R.Right-1, R.Bottom-1); // bottom InflateRect(R, -1, -1); ACanvas.Pen.Color := clBtnShadow; ACanvas.Line(R.Left, R.Top, R.Left, R.Bottom-1); // left ACanvas.Line(R.Left, R.Top, R.Right-1, R.Top); // top end else begin ACanvas.Pen.Color := clBlack; ACanvas.Line(R.Right-1, R.Top, R.Right-1, R.Bottom-1); // right ACanvas.Line(R.Left, R.Bottom-1, R.Right-1, R.Bottom-1); // bottom dec(R.Right); dec(R.Bottom); ACanvas.Pen.Color := clBtnHighlight; ACanvas.Line(R.Left, R.Top, R.Left, R.Bottom-1); // left ACanvas.Line(R.Left, R.Top, R.Right-1, R.Top); // top Inc(R.Top); Inc(R.Left); ACanvas.Line(R.Right-1, R.Top, R.Right-1, R.Bottom-1); // right ACanvas.Line(R.Left, R.Bottom-1, R.Right-1, R.Bottom-1); // bottom end; end else begin ACanvas.Pen.Color := clWindowFrame; ACanvas.Brush.Color := clBtnFace; ACanvas.Brush.Style := bsSolid; ACanvas.Rectangle(R); if IsFocused then begin InflateRect(R, 1, 1); ACanvas.Brush.Style := bsClear; ACanvas.Pen.Color := clBlack; ACanvas.Rectangle(R); end; InflateRect(R, -1, -1); if not IsDown then begin ACanvas.Pen.Color := clBtnHighlight; ACanvas.Line(R.Left, R.Top, R.Left, R.Bottom); // left ACanvas.Line(R.Left, R.Top, R.Right, R.Top); // top ACanvas.Pen.Color := clBtnShadow; ACanvas.Line(R.Right, R.Top, R.Right, R.Bottom); // right ACanvas.Line(R.Left, R.Bottom, R.Right, R.Bottom); // bottom end else begin ACanvas.Pen.Color := clBtnShadow; ACanvas.MoveTo(R.Left, R.Bottom-1); ACanvas.LineTo(R.Left, R.Top); ACanvas.LineTo(R.Right, R.Top); end; end; Result := Rect(ARect.Left + 1, ARect.Top + 1, ARect.Right - 2, ARect.Bottom - 2); if IsDown then OffsetRect(Result, 1, 1); end; //=== { 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; FAutoFreeClosed := True; FFlatScrollButtons := True; FMargin := 6; Align := alTop; with GetControlClassDefaultSize do SetInitialBounds(0, 0, CX, CY); AutoSize := true; end; destructor TJvCustomTabBar.Destroy; begin // 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(ACanvas: TCanvas; X, Y: Integer; ALeft, 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; savedBrush: TBrush; savedPen: TPen; begin savedBrush := TBrush.Create; savedPen := TPen.Create; try savedBrush.Assign(ACanvas.Brush); savedPen.Assign(ACanvas.Pen); if ALeft 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; ACanvas.Brush.Style := bsSolid; if Disabled then begin ACanvas.Brush.Color := clWhite; OffsetPt(Pts[0], 1, 1); OffsetPt(Pts[1], 1, 1); OffsetPt(Pts[2], 1, 1); end else ACanvas.Brush.Color := clBlack; ACanvas.Pen.Color := ACanvas.Brush.Color; ACanvas.Polygon(Pts); if Disabled then begin ACanvas.Brush.Color := clGray; OffsetPt(Pts[0], -1, -1); OffsetPt(Pts[1], -1, -1); OffsetPt(Pts[2], -1, -1); ACanvas.Pen.Color := ACanvas.Brush.Color; ACanvas.Polygon(Pts); end; finally ACanvas.Pen.Assign(savedPen); ACanvas.Brush.Assign(savedBrush); savedPen.Free; savedBrush.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; {$IF LCL_FullVersion >= 1090000} procedure TJvCustomTabBar.SetImagesWidth(const AValue: Integer); begin if AValue = FImagesWidth then exit; FImagesWidth := AValue; Invalidate; end; {$ENDIF} 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: TLMessage); begin SetHotTab(nil); inherited; end; procedure TJvCustomTabBar.WMEraseBkgnd(var Msg: TLMEraseBkgnd); 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 ACaption: string): TJvTabBarItem; begin Result := TJvTabBarItem(Tabs.Add); Result.Caption := ACaption; end; function TJvCustomTabBar.FindTab(const ACaption: string): TJvTabBarItem; var i: Integer; begin for i := 0 to Tabs.Count - 1 do if ACaption = 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.CalculatePreferredSize( var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); var h: Integer; {$IF LCL_FullVersion >= 1090000} imgRes: TScaledImageListResolution; {$ENDIF} begin inherited CalculatePreferredSize(PreferredWidth,PreferredHeight,WithThemeSpace); CurrentPainter.AutoSize; // Text height Canvas.Font.Assign(Font); PreferredHeight := Canvas.TextHeight('Tg'); // Icon height if FImages <> nil then begin {$IF LCL_FullVersion >= 1090000} imgRes := FImages.ResolutionForPPI[FImagesWidth, Font.PixelsPerInch, GetCanvasScaleFactor]; h := imgRes.Height; if imgRes.Height > PreferredHeight then PreferredHeight := imgRes.Height; {$ELSE} h := Images.Height; {$ENDIF} if h > PReferredHeight then PreferredHeight := h; end; // Close button height if FCloseButton then begin h := CloseButtonSize; if h > PreferredHeight then PreferredHeight := h; end; // Margins inc(PreferredHeight, TopMargin + BottomMargin); end; procedure TJvCustomTabBar.Paint; var I: Integer; Bmp: TBitmap; R: TRect; begin CalcTabsRects; Bmp := TBitmap.Create; try Bmp.SetSize(ClientWidth, ClientHeight); Bmp.Canvas.Brush.Color := clWhite; Bmp.Canvas.FillRect(0, 0, Bmp.Width, Bmp.Height); 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(ACanvas: 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(ACanvas, Tab, R); R.Left := R.Right; R.Right := R.Left + CurrentPainter.GetDividerWidth(ACanvas, Tab) - 1; CurrentPainter.DrawDivider(ACanvas, Tab, R); end; end; end; procedure TJvCustomTabBar.PaintScrollButtons; begin if not HandleAllocated then exit; 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; class function TJvCustomTabBar.GetControlClassDefaultSize: TSize; begin Result.CX := 100; Result.CY := 24; end; function TJvCustomTabBar.GetTabHeight(Tab: TJvTabBarItem): Integer; begin Result := CurrentPainter.GetTabSize(Canvas, Tab).cy; end; function TJvCustomTabBar.GetTabWidth(Tab: TJvTabBarItem): Integer; begin Result := CurrentPainter.GetTabSize(Canvas, Tab).cx; 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); BtnSize = 12; 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 FBtnLeftScroll.Rect := Bounds(ClientWidth - BtnSize * 2 - 1 - 1, ClientHeight - BtnSize - 2, BtnSize, BtnSize); FBtnRightScroll.Rect := Bounds(FBtnLeftScroll.Rect.Right, ClientHeight - BtnSize - 2, BtnSize, BtnSize); end else begin FBtnLeftScroll.Rect := Bounds(ClientWidth - BtnSize * 2 - 1 - 1, 2, BtnSize, BtnSize); FBtnRightScroll.Rect := Bounds(FBtnLeftScroll.Rect.Right, 2, BtnSize, BtnSize); 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; function TJvCustomTabBar.GetHeight: Integer; begin Result := inherited Height; end; procedure TJvCustomTabBar.SetHeight(AValue: Integer); begin if AValue = GetHeight then exit; AutoSize := false; inherited Height := AValue; 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; {$IF LCL_FullVersion >= 1080000} procedure TJvCustomTabBar.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); begin inherited; if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then begin FMargin := round(FMargin * AXProportion); LeftMargin := round(LEFT_MARGIN * AXProportion); RightMargin := round(RIGHT_MARGIN * AXProportion); TextMarginLeft := round(TEXT_MARGIN_LEFT * AXProportion); TextMarginRight := round(TEXT_MARGIN_RIGHT * AXProportion); TopMargin := round(TOP_MARGIN * AYProportion); BottomMargin := round(BOTTOM_MARGIN * AYProportion); CloseButtonSize := round(CLOSE_BUTTON_SIZE * AXProportion); CrossMargin := round(CROSS_MARGIN * AXProportion); end; end; {$IFEND} //=== { TJvTabBarItem } ====================================================== constructor TJvTabBarItem.Create(ACollection: Classes.TCollection); begin inherited Create(ACollection); 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 inherited Destroy; // invokes TJvTabBar.Notification that accesses FOnChangeList FOnChangeList.Free; end; procedure TJvTabBarPainter.AutoSize; begin end; procedure TJvTabBarPainter.Changed; var i: Integer; begin for i := 0 to FOnChangeList.Count - 1 do TJvCustomTabBar(FOnChangeList[i]).ImagesChanged(Self); end; function TJvTabBarPainter.GetRealImageSize(ATab: TJvTabBarItem): TSize; {$IF LCL_FullVersion >= 1090000} var imgRes: TScaledImageListResolution; tabBar: TJvCustomTabBar; f: Double; ppi: Integer; begin tabBar := GetTabBar(ATab); f := tabBar.GetCanvasScaleFactor; ppi := GetPixelsPerInch; imgRes := ATab.GetImages.ResolutionForPPI[tabBar.ImagesWidth, ppi, f]; Result.CX := imgRes.Width; Result.CY := imgRes.Height; end; {$ELSE} begin if Assigned(ATab.GetImages) then begin Result.CX := ATab.GetImages.Width; Result.CY := ATab.GetImages.Height; end else begin Result.CX := 0; Result.CY := 0; end; end; {$ENDIF} function TJvTabBarPainter.Scale(ABar: TJvCustomTabBar; n: Integer): Integer; begin {$IF LCL_FullVersion >= 1080000} Result := ABar.Scale96ToFont(n); {$ELSE} Result := MulDiv(n, Screen.PixelsPerInch, 96); {$IFEND} end; procedure TJvTabBarPainter.GetScrollButtons(TabBar: TJvCustomTabBar; var LeftButton, RightButton: TRect); begin { reserved for future use } end; function TJvTabBarPainter.GetTabBar(ATab: TJvTabBarItem): TJvCustomTabBar; begin Result := TJvTabBarItems(ATab.Collection).TabBar; end; procedure TJvTabBarPainter.DrawScrollButton(Canvas: TCanvas; TabBar: TJvCustomTabBar; Button: TJvTabBarScrollButtonKind; State: TJvTabBarScrollButtonState; R: TRect); {$IFDEF JVCLThemesEnabled} const SCROLL: array[TJvTabBarScrollButtonKind, TJvTabBarScrollButtonState] of TThemedScrollbar = ( // sbsHidden sbsNormal sbsHot sbsPressed sbsDisabled (tsArrowBtnLeftNormal, tsArrowBtnLeftNormal, tsArrowBtnLeftHot, tsArrowBtnLeftPressed, tsArrowBtnLeftDisabled), (tsArrowBtnRightNormal, tsArrowBtnRightNormal, tsArrowBtnRightHot, tsArrowBtnRightPressed, tsArrowBtnRightDisabled) ); var details: TThemedElementDetails; {$ENDIF JVCLThemesEnabled} var dx, dy: Integer; begin {$IFDEF JVCLThemesEnabled} if ThemeServices.ThemesEnabled then begin details := ThemeServices.GetElementDetails(SCROLL[Button, State]); ThemeServices.DrawElement(Canvas.Handle, details, R, nil); end else {$ENDIF JVCLThemesEnabled} begin DrawButtonFace(Canvas, R, TabBar.FlatScrollButtons, State = sbsPressed, false); if State = sbsPressed then OffsetRect(R, 1, 1); {$IF LCL_FullVersion >= 1080000} dx := TabBar.Scale96ToFont(4); dy := TabBar.Scale96ToFont(7); {$ELSE} dx := MulDiv(4, GetPixelsPerInch, 96); dy := MulDiv(7, GetPixelsPerInch, 96); {$IFEND} TabBar.DrawScrollBarGlyph(Canvas, R.Left + (R.Right - R.Left - dx) div 2, R.Top + (R.Bottom - R.Top - dy) 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; inherited Destroy; end; procedure TJvModernTabBarPainter.AutoSize; begin FTabHeight := 0; FTabWidth := 0; 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 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 else // toTop 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; procedure TJvModernTabBarPainter.DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); var delta: Integer; begin if not LeftTab.Selected then begin if (LeftTab.TabBar.SelectedTab = nil) or (LeftTab.GetNextVisible <> LeftTab.TabBar.SelectedTab) then begin delta := Scale(LeftTab.TabBar, 3); with Canvas do begin Pen.Color := DividerColor; Pen.Width := 1; MoveTo(R.Right - 1, R.Top + delta); LineTo(R.Right - 1, R.Bottom - delta); end; end; end; end; procedure TJvModernTabBarPainter.DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean); var R: TRect; delta: integer; begin delta := Scale(Tab.TabBar, 4); with Canvas do begin R := Tab.DisplayRect; Inc(R.Top, delta); Dec(R.Bottom, delta div 2); if MoveLeft then begin Dec(R.Left); R.Right := R.Left + delta end else begin Dec(R.Right, 1); R.Left := R.Right - delta; end; Brush.Color := MoveDividerColor; FillRect(R); end; end; procedure TJvModernTabBarPainter.DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; ATabRect: TRect); var R, CloseR: TRect; ts: TTextStyle; margin: Integer; x, y: Integer; imgsize: TSize; {$IF LCL_FullVersion >= 1090000} imageRes: TScaledImageListResolution; f: Double; ppi: Integer; tabBar: TJvCustomTabBar; {$ENDIF} begin R := ATabRect; 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; FillRect(R); Pen.Color := ControlDivideColor; if Tab.TabBar.Orientation = toBottom then 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 else // toTop 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; 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; inc(R.Left, LeftMargin); dec(R.Right, RightMargin); if Tab.TabBar.CloseButton then begin CloseR := GetCloseRect(Canvas, Tab, ATabRect); // close button color if Tab.Selected then Brush.Color := CloseColorSelected else Brush.Color := CloseColor; 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; Pen.Width := 2; { Draw close cross } margin := CrossMargin; Line(CloseR.Left + margin, CloseR.Top + margin, CloseR.Right - margin - 1, CloseR.Bottom - margin - 1); Line(CloseR.Left + margin, CloseR.Bottom - margin - 1, CloseR.Right - margin - 1, CloseR.Top + margin); { // remove intersection if Tab.Modified then FillRect(Rect(CloseR.Left + 5, CloseR.Top + 4, CloseR.Right - 5, CloseR.Bottom - 4)); } R.Right := CloseR.Left - TextMarginRight; end; { Draw image from image list } if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then begin imgsize := GetRealImageSize(Tab); x := R.Left; y := (R.Top + R.Bottom - imgSize.CY) div 2; {$IF LCL_FullVersion >= 1090000} tabBar := GetTabBar(Tab); f := tabBar.GetCanvasScalefactor; ppi := GetPixelsPerInch; if Tab.GetImages <> nil then imageRes := Tab.GetImages.ResolutionForPPI[tabBar.ImagesWidth, ppi, f]; imageRes.Draw(Canvas, x, y, Tab.ImageIndex, tab.Enabled); {$ELSE} Tab.GetImages.Draw(Canvas, x, y, Tab.ImageIndex, Tab.Enabled); {$ENDIF} Inc(R.Left, imgSize.CX + TextMarginLeft); 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; ts := TextStyle; ts.EndEllipsis := true; ts.Clipping := true; TextRect(R, R.Left, (R.Top + R.Bottom - TextHeight('Tg')) div 2, Tab.Caption, ts); end; end; function TJvModernTabBarPainter.GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; ATabRect: TRect): TRect; var btnSize: TSize; begin btnSize := Size(CloseButtonSize, CloseButtonSize); Result.Right := ATabRect.Right - RightMargin; Result.Left := Result.Right - btnSize.CX; Result.Top := (ATabRect.Top + ATabRect.Bottom - btnSize.CY) div 2; Result.Bottom := Result.Top + btnSize.CY; end; function TJvModernTabBarPainter.GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; begin Result := 1; end; function TJvModernTabBarPainter.GetPixelsPerInch: Integer; begin Result := Font.PixelsPerInch; end; function TJvModernTabBarPainter.GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; var w, h: Integer; imgSize: 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); // Measure text if Tab.Caption = '' then Result := Size(0, Canvas.TextHeight('Tg')) else Result := Canvas.TextExtent(Tab.Caption); inc(Result.CX, LeftMargin + RightMargin); // Extend width by close button if Tab.TabBar.CloseButton then begin w := CloseButtonSize; inc(Result.CX, w + TextMarginRight); h := w; if Result.CY < h then Result.CY := h; end; // Extend width and height by image if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then begin imgSize := GetRealImageSize(Tab); inc(Result.CX, imgSize.CX + TextMarginLeft); if Result.CY < imgSize.CY then Result.CY := imgSize.CY; end; inc(Result.CY, TopMargin + BottomMargin); // Override width if TabWidth/TabHeight is fixed. if TabWidth > 0 then Result.CX := TabWidth; if TabHeight > 0 then Result.CY := TabHeight; 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.SetTabHeight(Value: Integer); begin if Value < 0 then Value := 0; if Value <> FTabHeight then begin FTabHeight := 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; end.