Show JvTabBar.pas syntax highlighted
{-----------------------------------------------------------------------------
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.sourceforge.net
Known Issues:
-----------------------------------------------------------------------------}
// $Id$
unit JvTabBar;
{$I jvcl.inc}
{.$DEFINE WINFORMS}
interface
uses
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
{$IFDEF WINFORMS}
System.Windows.Forms, System.Drawing,
Borland.Vcl.Windows, Borland.Vcl.Messages, Borland.Vcl.SysUtils,
Borland.Vcl.Classes, Borland.Vcl.Types, Borland.Vcl.Contnrs,
Jedi.WinForms.Vcl.Graphics, Jedi.WinForms.Vcl.Controls,
Jedi.WinForms.Vcl.Forms, Jedi.WinForms.Vcl.ImgList, Jedi.WinForms.Vcl.Menus,
Jedi.WinForms.Vcl.Buttons, Jedi.WinForms.Vcl.ExtCtrls;
{$ELSE}
{$IFDEF VCL}
Windows, Messages, Graphics, Controls, Forms, ImgList, Menus, Buttons,
ExtCtrls,
{$IFDEF CLR}
Types,
{$ENDIF CLR}
{$ENDIF VCL}
{$IFDEF VisualCLX}
Types, Qt, QTypes, QGraphics, QControls, QForms, QImgList, QMenus, QButtons,
QExtCtrls,
{$ENDIF VisualCLX}
SysUtils, Classes, Contnrs,
JvVCL5Utils;
{$ENDIF WINFORMS}
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;
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;
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;
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;
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;
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;
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 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 GetTabWidth(Tab: TJvTabBarItem): Integer;
function GetTabHeight(Tab: TJvTabBarItem): Integer;
function CurrentPainter: TJvTabBarPainter;
procedure Notification(Component: TComponent; Operation: TOperation); override;
function TabClosing(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;
{$IFDEF VCL}
procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
{$ENDIF VCL}
{$IFDEF VisualCLX}
procedure InitWidget; override;
procedure MouseLeave(AControl: TControl); override;
{$ENDIF VisualCLX}
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;
function MakeVisible(Tab: TJvTabBarItem): Boolean;
function FindData(Data: TObject): TJvTabBarItem;
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;
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
property OnTabClosing: TJvTabBarClosingEvent read FOnTabClosing write FOnTabClosing;
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 Cursor;
property PopupMenu;
property ShowHint default False;
property Height default 23;
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;
property Tabs;
property OnTabClosing;
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;
{$IFDEF VCL}
{$IFNDEF WINFORMS}
property OnStartDock;
property OnEndDock;
{$ENDIF !WINFORMS}
{$ENDIF VCL}
end;
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
RCSfile: '$URL$';
Revision: '$Revision$';
Date: '$Date$';
LogPath: 'JVCL\run'
);
{$ENDIF UNITVERSIONING}
implementation
type
{$IFDEF VCL}
TCanvasX = TCanvas;
{$ENDIF VCL}
{$IFDEF VisualCLX}
TCanvasX = class(TCanvas)
// LineTo under CLX draws the last point, Windows doesn't. This wrapper
// restores the last point.
procedure LineTo(X, Y: Integer);
end;
procedure TCanvasX.LineTo(X, Y: Integer);
var
C: TColor;
begin
// Should be replaced because GetPixel is not really working under Linux
C := Pixels[X, Y];
inherited LineTo(X, Y);
Pixels[X, Y] := C;
end;
{$ENDIF VisualCLX}
//=== { 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;
Height := 23;
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 Assigned(FTabs) 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 Assigned(FPainter) then
begin
FPainter.FOnChangeList.Extract(Self);
FPainter.RemoveFreeNotification(Self);
end;
FPainter := Value;
if Assigned(FPainter) then
begin
FreeAndNil(FDefaultPainter);
FPainter.FreeNotification(Self);
FPainter.FOnChangeList.Add(Self);
end;
if not (csDestroying in ComponentState) then
Invalidate;
end;
end;
procedure TJvCustomTabBar.SetImages(Value: TCustomImageList);
begin
if Value <> FImages then
begin
if Assigned(FImages) then
begin
FImages.UnregisterChanges(FChangeLink);
FImages.RemoveFreeNotification(Self);
end;
FImages := Value;
if Assigned(FImages) then
begin
FImages.RegisterChanges(FChangeLink);
FImages.FreeNotification(Self);
end;
if not (csDestroying in ComponentState) then
Invalidate;
end;
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 Assigned(Value) 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 not Assigned(Result) then
begin
if not Assigned(FDefaultPainter) 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;
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
if AutoFreeClosed and not (csDesigning in ComponentState) 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 Assigned(PageList) and Supports(PageList, IPageList, PageListIntf) then
begin
if Assigned(Tab) 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 Assigned(Result) 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 Assigned(Result) 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);
Accept := (Source = Self) and Assigned(SelectedTab) and (InsertTab <> SelectedTab) and
Assigned(InsertTab);
if Accept then
begin
if InsertTab <> FLastInsertTab then
begin
if Assigned(FLastInsertTab) 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 Assigned(FLastInsertTab) then
begin
Repaint;
FLastInsertTab := nil;
end;
end;
inherited DragOver(Source, X, Y, State, Accept);
end;
procedure TJvCustomTabBar.DragCanceled;
begin
if Assigned(FLastInsertTab) 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 Assigned(SelectedTab) then
begin
InsertTab := TabAt(X, Y);
if Assigned(InsertTab) then
begin
SelectedTab.Index := InsertTab.Index;
TabMoved(SelectedTab);
UpdateScrollButtons;
end;
end
else
if Assigned(FLastInsertTab) then
Repaint;
FLastInsertTab := nil;
inherited DragDrop(Source, X, Y);
end;
{$IFDEF VCL}
procedure TJvCustomTabBar.CMMouseLeave(var Msg: TMessage);
begin
SetHotTab(nil);
inherited;
end;
procedure TJvCustomTabBar.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
Msg.Result := 1;
end;
{$ENDIF VCL}
{$IFDEF VisualCLX}
procedure TJvCustomTabBar.InitWidget;
begin
inherited InitWidget;
QWidget_setBackgroundMode(Handle, QWidgetBackgroundMode_NoBackground); // reduces flicker
end;
procedure TJvCustomTabBar.MouseLeave(AControl: TControl);
begin
SetHotTab(nil);
inherited MouseLeave(AControl);
end;
{$ENDIF VisualCLX}
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 Assigned(Tab) then
SelectedTab := Tab;
if Assigned(Tab) and (Tab = SelectedTab) then
if CloseButton and (not SelectBeforeClose or (SelectedTab = LastSelected)) and
PtInRect(CurrentPainter.GetCloseRect(Canvas, Tab, Tab.DisplayRect), Point(X, Y)) then
if TabClosing(Tab) then
begin
FMouseDownClosingTab := Tab;
SetClosingTab(Tab);
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 Assigned(PopupMenu) and (Button = mbRight) then
begin
Tab := TabAt(X, Y);
if Assigned(Tab) then
SelectedTab := Tab;
if Assigned(Tab) and Assigned(Tab.PopupMenu) then
begin
Pt := ClientToScreen(Point(X, Y));
Tab.PopupMenu.Popup(Pt.X, Pt.Y);
end;
end
else
if Button = mbLeft then
begin
if Assigned(FClosingTab) and CloseButton then
begin
CalcTabsRects;
if PtInRect(CurrentPainter.GetCloseRect(Canvas, FClosingTab,
FClosingTab.DisplayRect), Point(X, Y)) then
TabClosed(FClosingTab);
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 Assigned(FMouseDownClosingTab) 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 Assigned(Tab) 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.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 not Assigned(FScrollButtonBackground) 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 not Assigned(FScrollButtonBackground) 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 := 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 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 Assigned(Value) then
begin
// find first visible before or at Value.Index
Index := 0;
if (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 not Assigned(Tab) 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 Assigned(FPageList) then
FPageList.RemoveFreeNotification(Self);
FPageList := Value;
if Assigned(FPageList) 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 Assigned(TabBar.PageList) 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 not Assigned(FAutoDeleteDatas) 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 Assigned(FPopupMenu) then
FPopupMenu.RemoveFreeNotification(TabBar);
FPopupMenu := Value;
if Assigned(FPopupMenu) 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 Assigned(TabBar.PageList) 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 TabBar.LeftTab = Item then
TabBar.LeftTab := TabBar.LeftTab.GetPreviousVisible;
end;
if TabBar.PageListTabLink and Assigned(TabBar.PageList) 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.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);
begin
{$IFDEF VCL}
if TabBar.FlatScrollButtons then
DrawButtonFace(Canvas, R, 1, bsNew, False, State = sbsPressed, False)
else
DrawButtonFace(Canvas, R, 1, bsWin31, False, State = sbsPressed, False);
{$ENDIF VCL}
{$IFDEF VisualCLX}
DrawButtonFace(Canvas, R, 1, State = sbsPressed, False, TabBar.FlatScrollButtons);
{$ENDIF VisualCLX}
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;
//=== { 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.DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect);
begin
with TCanvasX(Canvas) do
begin
Brush.Style := bsSolid;
Brush.Color := Color;
FillRect(R);
Brush.Style := bsClear;
Pen.Color := BorderColor;
Pen.Width := 1;
case TabBar.Orientation of
toBottom:
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
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);
begin
if not LeftTab.Selected then
begin
if not Assigned(LeftTab.TabBar.SelectedTab) or
(LeftTab.GetNextVisible <> LeftTab.TabBar.SelectedTab) then
begin
with TCanvasX(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 TCanvasX(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);
var
CloseR: TRect;
begin
with TCanvasX(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;
case Tab.TabBar.Orientation of
toBottom:
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
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;
if Tab.TabBar.CloseButton then
begin
// close button color
if Tab.Selected then
Brush.Color := CloseColorSelected
else
Brush.Color := CloseColor;
CloseR := GetCloseRect(Canvas, Tab, Tab.DisplayRect);
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));
R.Left := CloseR.Right;
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
Tab.GetImages.Draw(Canvas, R.Left, R.Top + (R.Bottom - R.Top - Tab.GetImages.Height) div 2,
Tab.ImageIndex, {$IFDEF VisualCLX} itImage, {$ENDIF} 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;
TextRect(R, R.Left + 3, R.Top + 3, Tab.Caption);
end;
end;
function TJvModernTabBarPainter.GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect;
begin
Result.Left := R.Left + 5;
Result.Top := R.Top + 5;
Result.Right := Result.Left + 12;
Result.Bottom := Result.Top + 11;
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);
Result.cx := Canvas.TextWidth(Tab.Caption) + 11;
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.
See more files for this project here