API tools faq
paste
Advertisement
miXOnIN

JvTabBar mod

miXOnIN
Feb 23rd, 2014
328
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 82.96 KB | None | 0 0
raw download clone embed print report
  1. {-----------------------------------------------------------------------------
  2. The contents of this file are subject to the Mozilla Public License
  3. Version 1.1 (the "License"); you may not use this file except in compliance
  4. with the License. You may obtain a copy of the License at
  5. http://www.mozilla.org/MPL/MPL-1.1.html
  6.  
  7. Software distributed under the License is distributed on an "AS IS" basis,
  8. WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
  9. the specific language governing rights and limitations under the License.
  10.  
  11. The Original Code is: JvTabBar.pas, released on 2004-12-23.
  12.  
  13. The Initial Developer of the Original Code is Andreas Hausladen <Andreas dott Hausladen att gmx dott de>
  14. Portions created by Andreas Hausladen are Copyright (C) 2004 Andreas Hausladen.
  15. All Rights Reserved.
  16.  
  17. Contributor(s):
  18.  
  19. You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
  20. located at http://jvcl.delphi-jedi.org
  21.  
  22. Known Issues:
  23. -----------------------------------------------------------------------------}
  24. // $Id: JvTabBar.pas 13415 2012-09-10 09:51:54Z obones $
  25.  
  26. {
  27. ***************** MOD v1.0b *****************
  28. 1. Перенесён close_button в право
  29. 2. Исправлен баг с перекрытием кусочка кнопки скролла
  30. 3. Из protected -> public
  31.     function GetTabWidth(Tab: TJvTabBarItem): Integer;
  32.     function GetTabHeight(Tab: TJvTabBarItem): Integer;
  33. 4. Сдвинул иконку правее на 2px
  34. 5. Уменьшил размер Tab`а в случае пустого Caption
  35. 6. Изменил пропорции и размеры кнопок скролла
  36. 7. Изменил отступы от кнопки закрытия и текста
  37. 8. Добавил в uses Vcl.Imaging.pngimage
  38. 9. Добавил возможность сделать свой стиль из картинок (параметр StyleImages)
  39. 10. Много мелких фиксов и поправок
  40. 11. Изменил размеры кнопок при отсутствии текста в вкладке
  41. 12. Добавил параметр CloseButtonRight, который переносит кнопку в право
  42.  
  43. }
  44.  
  45. unit JvTabBar;
  46.  
  47. {$I jvcl.inc}
  48.  
  49. interface
  50.  
  51. uses
  52.   {$IFDEF UNITVERSIONING}
  53.   JclUnitVersioning,
  54.   {$ENDIF UNITVERSIONING}
  55.   Windows, Messages, Graphics, Controls, Forms, ImgList, Menus, Buttons,
  56.   ExtCtrls,
  57.   SysUtils, Classes, Contnrs,
  58.   {$IFDEF HAS_UNIT_SYSTEM_UITYPES}
  59.   System.UITypes,
  60.   {$ENDIF HAS_UNIT_SYSTEM_UITYPES}
  61.   JvThemes,
  62.   { _mxn_ }
  63.   Vcl.Dialogs, Vcl.Imaging.pngimage;
  64.  
  65. type
  66.   TJvCustomTabBar = class;
  67.   TJvTabBarItem = class;
  68.  
  69.   TJvTabBarOrientation = (toTop, toBottom);
  70.   TJvTabBarScrollButtonKind = (sbScrollLeft, sbScrollRight);
  71.   TJvTabBarScrollButtonState = (sbsHidden, sbsNormal, sbsHot, sbsPressed, sbsDisabled);
  72.  
  73.   TJvGetModifiedEvent = procedure(Sender: TJvTabBarItem; var Modified: Boolean) of object;
  74.   TJvGetEnabledEvent = procedure(Sender: TJvTabBarItem; var Enabled: Boolean) of object;
  75.  
  76.   IPageList = interface
  77.     ['{6BB90183-CFB1-4431-9CFD-E9A032E0C94C}']
  78.     function CanChange(AIndex: Integer): Boolean;
  79.     procedure SetActivePageIndex(AIndex: Integer);
  80.     function GetPageCount: Integer;
  81.     function GetPageCaption(AIndex: Integer): string;
  82.     procedure AddPage(const ACaption: string);
  83.     procedure DeletePage(Index: Integer);
  84.     procedure MovePage(CurIndex, NewIndex: Integer);
  85.     procedure PageCaptionChanged(Index: Integer; const NewCaption: string);
  86.   end;
  87.  
  88.   TJvTabBarItem = class(TCollectionItem)
  89.   private
  90.     FLeft: Integer; // used for calculating DisplayRect
  91.  
  92.     FImageIndex: TImageIndex;
  93.     FEnabled: Boolean;
  94.     FVisible: Boolean;
  95.     FTag: Integer;
  96.     FData: TObject;
  97.     FHint: TCaption;
  98.     FName: string;
  99.     FCaption: TCaption;
  100.     FImages: TCustomImageList;
  101.     FModified: Boolean;
  102.     FPopupMenu: TPopupMenu;
  103.     FOnGetEnabled: TJvGetEnabledEvent;
  104.     FOnGetModified: TJvGetModifiedEvent;
  105.     FShowHint: Boolean;
  106.     FAutoDeleteDatas: TObjectList;
  107.     function GetEnabled: Boolean;
  108.     function GetModified: Boolean;
  109.  
  110.     procedure SetPopupMenu(const Value: TPopupMenu);
  111.     function GetClosing: Boolean;
  112.     procedure SetModified(const Value: Boolean);
  113.     procedure SetCaption(const Value: TCaption);
  114.     procedure SetSelected(const Value: Boolean);
  115.     procedure SetEnabled(const Value: Boolean);
  116.     procedure SetImageIndex(const Value: TImageIndex);
  117.     procedure SetName(const Value: string);
  118.     procedure SetVisible(const Value: Boolean);
  119.     function GetTabBar: TJvCustomTabBar;
  120.     function GetSelected: Boolean;
  121.     function GetDisplayRect: TRect;
  122.     function GetHot: Boolean;
  123.   protected
  124.     procedure Changed; virtual;
  125.  
  126.     procedure SetIndex(Value: Integer); override;
  127.     procedure Notification(Component: TComponent; Operation: TOperation); virtual;
  128.     property Name: string read FName write SetName;
  129.   public
  130.     constructor Create(Collection: Classes.TCollection); override;
  131.     destructor Destroy; override;
  132.     procedure Assign(Source: TPersistent); override;
  133.     function GetImages: TCustomImageList;
  134.     function CanSelect: Boolean;
  135.     function GetNextVisible: TJvTabBarItem;
  136.     function GetPreviousVisible: TJvTabBarItem;
  137.     procedure MakeVisible;
  138.     function AutoDeleteData: TObjectList;
  139.  
  140.     property Data: TObject read FData write FData;
  141.     property TabBar: TJvCustomTabBar read GetTabBar;
  142.     property DisplayRect: TRect read GetDisplayRect;
  143.     property Hot: Boolean read GetHot;
  144.     property Closing: Boolean read GetClosing;
  145.   published
  146.     property Caption: TCaption read FCaption write SetCaption;
  147.     property Selected: Boolean read GetSelected write SetSelected default False;
  148.     property Enabled: Boolean read GetEnabled write SetEnabled default True;
  149.     property Modified: Boolean read GetModified write SetModified default False;
  150.     property Hint: TCaption read FHint write FHint;
  151.     property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
  152.     property Tag: Integer read FTag write FTag default 0;
  153.     property Visible: Boolean read FVisible write SetVisible default True;
  154.     property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
  155.     property ShowHint: Boolean read FShowHint write FShowHint default True;
  156.  
  157.     property OnGetModified: TJvGetModifiedEvent read FOnGetModified write FOnGetModified;
  158.     property OnGetEnabled: TJvGetEnabledEvent read FOnGetEnabled write FOnGetEnabled;
  159.   end;
  160.  
  161.   TJvTabBarItems = class(TOwnedCollection)
  162.   private
  163.     function GetTabBar: TJvCustomTabBar;
  164.     function GetItem(Index: Integer): TJvTabBarItem;
  165.     procedure SetItem(Index: Integer; const Value: TJvTabBarItem);
  166.   protected
  167.     function Find(const AName: string): TJvTabBarItem;
  168.     procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
  169.   public
  170.     function IndexOf(Item: TJvTabBarItem): Integer;
  171.     procedure EndUpdate; override;
  172.     property Items[Index: Integer]: TJvTabBarItem read GetItem write SetItem; default;
  173.  
  174.     property TabBar: TJvCustomTabBar read GetTabBar;
  175.   end;
  176.  
  177.   TJvTabBarPainterOptionType = (poPaintsHotTab, poBottomScrollButtons);
  178.   TJvTabBarPainterOptions = set of TJvTabBarPainterOptionType;
  179.  
  180.   { _mxn_ }
  181.   TStyleImages = class
  182.     TOP_background:TPngImage;
  183.     TOP_active_left_side:TPngImage;
  184.     TOP_active_right_side:TPngImage;
  185.     TOP_active_center:TPngImage;
  186.  
  187.     BOTTOM_background:TPngImage;
  188.     BOTTOM_active_left_side:TPngImage;
  189.     BOTTOM_active_right_side:TPngImage;
  190.     BOTTOM_active_center:TPngImage;
  191.  
  192.     CLOSEBUTTON_normal:TPngImage;
  193.     CLOSEBUTTON_selected:TPngImage;
  194.     CLOSEBUTTON_disabled:TPngImage;
  195.     CLOSEBUTTON_closing:TPngImage;
  196.     CLOSEBUTTON_modified:TPngImage;
  197.     CLOSEBUTTON_closing_modified:TPngImage;
  198.   end;
  199.  
  200.   TJvTabBarPainter = class(TComponent)
  201.   private
  202.     FOnChangeList: TList;
  203.   protected
  204.     procedure Changed; virtual;
  205.  
  206.     procedure DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect); virtual; abstract;
  207.     procedure DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect); virtual; abstract;
  208.     procedure DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); virtual; abstract;
  209.     procedure DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean); virtual; abstract;
  210.     function GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; virtual; abstract;
  211.     function GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; virtual; abstract;
  212.     function GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect; virtual; abstract;
  213.     function Options: TJvTabBarPainterOptions; virtual; abstract;
  214.  
  215.     procedure DrawScrollButton(Canvas: TCanvas; TabBar: TJvCustomTabBar; Button: TJvTabBarScrollButtonKind;
  216.       State: TJvTabBarScrollButtonState; R: TRect); virtual;
  217.     procedure GetScrollButtons(TabBar: TJvCustomTabBar; var LeftButton, RightButton: TRect); {virtual; reserved for future use }
  218.   public
  219.     constructor Create(AOwner: TComponent); override;
  220.     destructor Destroy; override;
  221.   end;
  222.  
  223.   {$IFDEF RTL230_UP}
  224.   [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
  225.   {$ENDIF RTL230_UP}
  226.   TJvModernTabBarPainter = class(TJvTabBarPainter)
  227.   private
  228.     FFont: TFont;
  229.     FDisabledFont: TFont;
  230.     FSelectedFont: TFont;
  231.     FColor: TColor;
  232.     FTabColor: TColor;
  233.     FControlDivideColor: TColor;
  234.     FBorderColor: TColor;
  235.     FModifiedCrossColor: TColor;
  236.     FCloseRectColor: TColor;
  237.     FCloseRectColorDisabled: TColor;
  238.     FCloseCrossColorDisabled: TColor;
  239.     FCloseCrossColorSelected: TColor;
  240.     FCloseCrossColor: TColor;
  241.     FCloseColor: TColor;
  242.     FCloseColorSelected: TColor;
  243.     FDividerColor: TColor;
  244.     FMoveDividerColor: TColor;
  245.     FTabWidth: Integer;
  246.    
  247.     procedure SetCloseRectColorDisabled(const Value: TColor);
  248.     procedure SetCloseColor(const Value: TColor);
  249.     procedure SetCloseColorSelected(const Value: TColor);
  250.     procedure SetCloseCrossColor(const Value: TColor);
  251.     procedure SetCloseCrossColorDisabled(const Value: TColor);
  252.     procedure SetCloseRectColor(const Value: TColor);
  253.     procedure SetFont(const Value: TFont);
  254.     procedure SetDisabledFont(const Value: TFont);
  255.     procedure SetSelectedFont(const Value: TFont);
  256.  
  257.     procedure SetModifiedCrossColor(const Value: TColor);
  258.     procedure SetBorderColor(const Value: TColor);
  259.     procedure SetControlDivideColor(const Value: TColor);
  260.  
  261.     procedure SetTabColor(const Value: TColor);
  262.     procedure SetColor(const Value: TColor);
  263.     procedure FontChanged(Sender: TObject);
  264.     procedure SetDividerColor(const Value: TColor);
  265.     procedure SetCloseCrossColorSelected(const Value: TColor);
  266.     procedure SetTabWidth(Value: Integer);
  267.   protected
  268.     procedure DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect); override;
  269.     procedure DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect); override;
  270.     procedure DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect); override;
  271.     procedure DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean); override;
  272.     function GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer; override;
  273.     function GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize; override;
  274.     function GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect; override;
  275.     function Options: TJvTabBarPainterOptions; override;
  276.   public
  277.     constructor Create(AOwner: TComponent); override;
  278.     destructor Destroy; override;
  279.   published
  280.     property TabColor: TColor read FTabColor write SetTabColor default clBtnFace;
  281.     property Color: TColor read FColor write SetColor default clWindow;
  282.     property BorderColor: TColor read FBorderColor write SetBorderColor default clSilver;
  283.     property ControlDivideColor: TColor read FControlDivideColor write SetControlDivideColor default clBlack;
  284.     property ModifiedCrossColor: TColor read FModifiedCrossColor write SetModifiedCrossColor default clRed;
  285.     property CloseColorSelected: TColor read FCloseColorSelected write SetCloseColorSelected default $F4F4F4;
  286.     property CloseColor: TColor read FCloseColor write SetCloseColor default clWhite;
  287.     property CloseCrossColorSelected: TColor read FCloseCrossColorSelected write SetCloseCrossColorSelected default clBlack;
  288.     property CloseCrossColor: TColor read FCloseCrossColor write SetCloseCrossColor default $5D5D5D;
  289.     property CloseCrossColorDisabled: TColor read FCloseCrossColorDisabled write SetCloseCrossColorDisabled default $ADADAD;
  290.     property CloseRectColor: TColor read FCloseRectColor write SetCloseRectColor default $868686;
  291.     property CloseRectColorDisabled: TColor read FCloseRectColorDisabled write SetCloseRectColorDisabled default $D6D6D6;
  292.     property DividerColor: TColor read FDividerColor write SetDividerColor default $99A8AC;
  293.     property MoveDividerColor: TColor read FMoveDividerColor write FMoveDividerColor default clBlack;
  294.     property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
  295.  
  296.     property Font: TFont read FFont write SetFont;
  297.     property DisabledFont: TFont read FDisabledFont write SetDisabledFont;
  298.     property SelectedFont: TFont read FSelectedFont write SetSelectedFont;
  299.   end;
  300.   TJvTabBarModernPainter = TJvModernTabBarPainter; // TJvModernTabBarPainter should have been named TJvTabBarModernPainter
  301.  
  302.   TJvTabBarItemEvent = procedure(Sender: TObject; Item: TJvTabBarItem) of object;
  303.   TJvTabBarSelectingEvent = procedure(Sender: TObject; Item: TJvTabBarItem; var AllowSelect: Boolean) of object;
  304.   TJvTabBarClosingEvent = procedure(Sender: TObject; Item: TJvTabBarItem; var AllowClose: Boolean) of object;
  305.   TJvTabBarCloseQueryEvent = procedure(Sender: TObject; Item: TJvTabBarItem; var CanClose: Boolean) of object;
  306.   TJvTabBarScrollButtonClickEvent = procedure(Sender: TObject; Button: TJvTabBarScrollButtonKind) of object;
  307.  
  308.   TJvTabBarScrollButtonInfo = record
  309.     State: TJvTabBarScrollButtonState;
  310.     Rect: TRect;
  311.     ExState: Boolean;
  312.   end;
  313.  
  314.   TJvCustomTabBar = class(TCustomControl)
  315.   private
  316.     FTabs: TJvTabBarItems;
  317.     FPainter: TJvTabBarPainter;
  318.     FDefaultPainter: TJvTabBarPainter;
  319.     FChangeLink: TChangeLink;
  320.     FCloseButton: Boolean;
  321.     { _mxn_ }
  322.     FCloseButtonRight: Boolean;
  323.  
  324.     { _mxn_ }
  325.     FStyleImages: TStyleImages;
  326.     StyleImagesArray: TStrings;
  327.  
  328.     FRightClickSelect: Boolean;
  329.     FImages: TCustomImageList;
  330.     FHotTracking: Boolean;
  331.     FHotTab: TJvTabBarItem;
  332.     FSelectedTab: TJvTabBarItem;
  333.     FClosingTab: TJvTabBarItem;
  334.     FLastInsertTab: TJvTabBarItem;
  335.     FMouseDownClosingTab: TJvTabBarItem;
  336.     FMargin: Integer;
  337.     FAutoFreeClosed: Boolean;
  338.     FAllowUnselected: Boolean;
  339.     FSelectBeforeClose: Boolean;
  340.     FPageList: TCustomControl;
  341.  
  342.     FOnTabClosing: TJvTabBarClosingEvent;
  343.     FOnTabSelected: TJvTabBarItemEvent;
  344.     FOnTabSelecting: TJvTabBarSelectingEvent;
  345.     FOnTabCloseQuery: TJvTabBarCloseQueryEvent;
  346.     FOnTabClosed: TJvTabBarItemEvent;
  347.     FOnTabMoved: TJvTabBarItemEvent;
  348.     FOnChange: TNotifyEvent;
  349.  
  350.     // scrolling
  351.     FLeftIndex: Integer;
  352.     FLastTabRight: Integer;
  353.     FRequiredWidth: Integer;
  354.     FBarWidth: Integer;
  355.     FBtnLeftScroll: TJvTabBarScrollButtonInfo;
  356.     FBtnRightScroll: TJvTabBarScrollButtonInfo;
  357.     FScrollButtonBackground: TBitmap;
  358.     FHint: TCaption;
  359.     FFlatScrollButtons: Boolean;
  360.     FAllowTabMoving: Boolean;
  361.     FOrientation: TJvTabBarOrientation;
  362.     FOnScrollButtonClick: TJvTabBarScrollButtonClickEvent;
  363.     FPageListTabLink: Boolean;
  364.  
  365.     FRepeatTimer: TTimer;
  366.     FScrollRepeatedClicked: Boolean;
  367.     FOnLeftTabChange: TNotifyEvent;
  368.  
  369.     { _mxn_ }
  370.     procedure WriteStyleImages(const Value: TStrings);
  371.  
  372.     function GetLeftTab: TJvTabBarItem;
  373.     procedure SetLeftTab(Value: TJvTabBarItem);
  374.     procedure SetSelectedTab(Value: TJvTabBarItem);
  375.     procedure SetTabs(Value: TJvTabBarItems);
  376.     procedure SetPainter(Value: TJvTabBarPainter);
  377.     procedure SetImages(Value: TCustomImageList);
  378.     procedure SetCloseButton(Value: Boolean);
  379.     procedure SetMargin(Value: Integer);
  380.  
  381.     procedure SetHotTab(Tab: TJvTabBarItem);
  382.     procedure SetClosingTab(Tab: TJvTabBarItem);
  383.     procedure UpdateScrollButtons;
  384.     function FindSelectableTab(Tab: TJvTabBarItem): TJvTabBarItem;
  385.     procedure SetHint(const Value: TCaption);
  386.     procedure SetFlatScrollButtons(const Value: Boolean);
  387.     procedure SetPageList(const Value: TCustomControl);
  388.     procedure SetOrientation(const Value: TJvTabBarOrientation);
  389.     procedure TimerExpired(Sender: TObject);
  390.   protected
  391.     procedure DrawScrollBarGlyph(Canvas: TCanvas; X, Y: Integer; Left, Disabled: Boolean);
  392.     procedure Resize; override;
  393.     procedure CalcTabsRects;
  394.     procedure Paint; override;
  395.     procedure PaintTab(Canvas: TCanvas; Tab: TJvTabBarItem); virtual;
  396.     procedure PaintScrollButtons;
  397.  
  398.     function CurrentPainter: TJvTabBarPainter;
  399.     procedure Notification(Component: TComponent; Operation: TOperation); override;
  400.  
  401.     function TabClosing(Tab: TJvTabBarItem): Boolean; virtual;
  402.     function TabCloseQuery(Tab: TJvTabBarItem): Boolean; virtual;
  403.     procedure TabClosed(Tab: TJvTabBarItem); virtual;
  404.     function TabSelecting(Tab: TJvTabBarItem): Boolean; virtual;
  405.     procedure TabSelected(Tab: TJvTabBarItem); virtual;
  406.     procedure TabMoved(Tab: TJvTabBarItem); virtual;
  407.     procedure Changed; virtual;
  408.     procedure ImagesChanged(Sender: TObject); virtual;
  409.     procedure ScrollButtonClick(Button: TJvTabBarScrollButtonKind); virtual;
  410.     procedure LeftTabChanged; virtual;
  411.  
  412.     procedure DragOver(Source: TObject; X: Integer; Y: Integer;
  413.       State: TDragState; var Accept: Boolean); override;
  414.     procedure DragCanceled; override;
  415.  
  416.     function ScrollButtonsMouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer): Boolean; virtual;
  417.     function ScrollButtonsMouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer): Boolean; virtual;
  418.     function ScrollButtonsMouseMove(Shift: TShiftState; X: Integer; Y: Integer): Boolean; virtual;
  419.  
  420.     function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
  421.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
  422.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
  423.     procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
  424.     procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
  425.     procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
  426.     procedure Loaded; override;
  427.   public
  428.     constructor Create(AOwner: TComponent); override;
  429.     destructor Destroy; override;
  430.  
  431.     function AddTab(const Caption: string): TJvTabBarItem;
  432.     function FindTab(const Caption: string): TJvTabBarItem; // returns the first tab with the given Caption
  433.     function TabAt(X, Y: Integer): TJvTabBarItem;
  434.  
  435.     { _mxn_ }
  436.     function GetTabWidth(Tab: TJvTabBarItem): Integer;
  437.     function GetTabHeight(Tab: TJvTabBarItem): Integer;
  438.  
  439.     function MakeVisible(Tab: TJvTabBarItem): Boolean;
  440.     function FindData(Data: TObject): TJvTabBarItem;
  441.     function CloseTab(ATab: TJvTabBarItem): Boolean;
  442.  
  443.     procedure DragDrop(Source: TObject; X: Integer; Y: Integer); override;
  444.  
  445.     property PageListTabLink: Boolean read FPageListTabLink write FPageListTabLink default False; // if true the PageList's Pages[] are kept in sync with the Tabs
  446.     property PageList: TCustomControl read FPageList write SetPageList;
  447.     property Painter: TJvTabBarPainter read FPainter write SetPainter;
  448.     property Images: TCustomImageList read FImages write SetImages;
  449.     property Tabs: TJvTabBarItems read FTabs write SetTabs;
  450.  
  451.     // Status
  452.     property SelectedTab: TJvTabBarItem read FSelectedTab write SetSelectedTab;
  453.     property LeftTab: TJvTabBarItem read GetLeftTab write SetLeftTab;
  454.     property HotTab: TJvTabBarItem read FHotTab;
  455.     property ClosingTab: TJvTabBarItem read FClosingTab;
  456.  
  457.     // Options
  458.     property Orientation: TJvTabBarOrientation read FOrientation write SetOrientation default toTop;
  459.     property CloseButton: Boolean read FCloseButton write SetCloseButton default True;
  460.     { _mxn_ }
  461.     property CloseButtonRight: Boolean read FCloseButtonRight write FCloseButtonRight default True;
  462.     property StyleImages: TStrings read StyleImagesArray write WriteStyleImages;
  463.  
  464.     property RightClickSelect: Boolean read FRightClickSelect write FRightClickSelect default True;
  465.     property HotTracking: Boolean read FHotTracking write FHotTracking default False;
  466.     property AutoFreeClosed: Boolean read FAutoFreeClosed write FAutoFreeClosed default True;
  467.     property AllowUnselected: Boolean read FAllowUnselected write FAllowUnselected default False;
  468.     property SelectBeforeClose: Boolean read FSelectBeforeClose write FSelectBeforeClose default False;
  469.     property Margin: Integer read FMargin write SetMargin default 6;
  470.     property FlatScrollButtons: Boolean read FFlatScrollButtons write SetFlatScrollButtons default True;
  471.     property Hint: TCaption read FHint write SetHint;
  472.     property AllowTabMoving: Boolean read FAllowTabMoving write FAllowTabMoving default False;
  473.  
  474.     // Events
  475.  
  476.     { With OnTabClosing you can prevent the close button [X] in the tab from shrinking.
  477.       If you want to ask the user you should use OnTabCloseQuery }
  478.     property OnTabClosing: TJvTabBarClosingEvent read FOnTabClosing write FOnTabClosing;
  479.     property OnTabCloseQuery: TJvTabBarCloseQueryEvent read FOnTabCloseQuery write FOnTabCloseQuery;
  480.     property OnTabClosed: TJvTabBarItemEvent read FOnTabClosed write FOnTabClosed;
  481.     property OnTabSelecting: TJvTabBarSelectingEvent read FOnTabSelecting write FOnTabSelecting;
  482.     property OnTabSelected: TJvTabBarItemEvent read FOnTabSelected write FOnTabSelected;
  483.     property OnTabMoved: TJvTabBarItemEvent read FOnTabMoved write FOnTabMoved;
  484.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  485.     property OnScrollButtonClick: TJvTabBarScrollButtonClickEvent read FOnScrollButtonClick write FOnScrollButtonClick;
  486.     property OnLeftTabChange: TNotifyEvent read FOnLeftTabChange write FOnLeftTabChange;
  487.   end;
  488.  
  489.   {$IFDEF RTL230_UP}
  490.   [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
  491.   {$ENDIF RTL230_UP}
  492.   TJvTabBar = class(TJvCustomTabBar)
  493.   published
  494.     property Align default alTop;
  495.     property Cursor;
  496.     property PopupMenu;
  497.     property ShowHint default False;
  498.     property Height default 23;
  499.     property Hint;
  500.     property Visible;
  501.     property Enabled;
  502.  
  503.     property Orientation;
  504.     property CloseButton;
  505.     { _mxn_ }
  506.     property CloseButtonRight;
  507.     property RightClickSelect;
  508.     property HotTracking;
  509.     property AutoFreeClosed;
  510.     property AllowUnselected;
  511.     property SelectBeforeClose;
  512.     property Margin;
  513.     property FlatScrollButtons;
  514.     property AllowTabMoving;
  515.  
  516.     property PageListTabLink;
  517.     property PageList;
  518.     property Painter;
  519.     property Images;
  520.     property Tabs;
  521.  
  522.     property OnTabClosing;
  523.     property OnTabCloseQuery;
  524.     property OnTabClosed;
  525.     property OnTabSelecting;
  526.     property OnTabSelected;
  527.     property OnTabMoved;
  528.     property OnChange;
  529.     property OnLeftTabChange;
  530.  
  531.     property OnMouseDown;
  532.     property OnMouseMove;
  533.     property OnMouseUp;
  534.     property OnContextPopup;
  535.  
  536.     property OnClick;
  537.     property OnDblClick;
  538.  
  539.     property OnDragDrop;
  540.     property OnDragOver;
  541.     property OnStartDrag;
  542.     property OnEndDrag;
  543.  
  544.     property OnStartDock;
  545.     property OnEndDock;
  546.   end;
  547.  
  548. {$IFDEF UNITVERSIONING}
  549. const
  550.   UnitVersioning: TUnitVersionInfo = (
  551.     RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_47_PREPARATION/run/JvTabBar.pas $';
  552.     Revision: '$Revision: 13415 $';
  553.     Date: '$Date: 2012-09-10 11:51:54 +0200 (lun. 10 sept. 2012) $';
  554.     LogPath: 'JVCL\run'
  555.   );
  556. {$ENDIF UNITVERSIONING}
  557.  
  558. implementation
  559.  
  560. uses
  561.   Types,
  562.   JvJVCLUtils;
  563.  
  564. //=== { TJvCustomTabBar } ====================================================
  565.  
  566. constructor TJvCustomTabBar.Create(AOwner: TComponent);
  567. begin
  568.   inherited Create(AOwner);
  569.   ControlStyle := ControlStyle - [csAcceptsControls, csOpaque] {+ [csDesignInteractive]};
  570.  
  571.   FTabs := TJvTabBarItems.Create(Self, TJvTabBarItem);
  572.   FChangeLink := TChangeLink.Create;
  573.   FChangeLink.OnChange := ImagesChanged;
  574.  
  575.   FOrientation := toTop;
  576.   FRightClickSelect := True;
  577.   FCloseButton := True;
  578.   { _mxn_ }
  579.   FCloseButtonRight := True;
  580.   FAutoFreeClosed := True;
  581.   FFlatScrollButtons := True;
  582.  
  583.   FMargin := 6;
  584.  
  585.   Align := alTop;
  586.   Height := 23;
  587. end;
  588.  
  589. destructor TJvCustomTabBar.Destroy;
  590. begin
  591.   { _mxn_ }
  592.   WriteStyleImages(nil);
  593.  
  594.   // these events are too dangerous during object destruction
  595.   FOnTabSelected := nil;
  596.   FOnTabSelecting := nil;
  597.   FOnChange := nil;
  598.  
  599.   Painter := nil;
  600.   Images := nil;
  601.   FChangeLink.Free;
  602.   FTabs.Free;
  603.   FTabs := nil;
  604.   FScrollButtonBackground.Free;
  605.   FScrollButtonBackground := nil;
  606.  
  607.   inherited Destroy;
  608. end;
  609.  
  610. procedure TJvCustomTabBar.LeftTabChanged;
  611. begin
  612.   if Assigned(FOnLeftTabChange) then
  613.     FOnLeftTabChange(Self);
  614. end;
  615.  
  616. procedure TJvCustomTabBar.Loaded;
  617. begin
  618.   inherited Loaded;
  619.   SelectedTab := FindSelectableTab(nil);
  620.   UpdateScrollButtons;
  621. end;
  622.  
  623. procedure TJvCustomTabBar.Notification(Component: TComponent; Operation: TOperation);
  624. var
  625.   I: Integer;
  626. begin
  627.   inherited Notification(Component, Operation);
  628.   if Operation = opRemove then
  629.   begin
  630.     if Component = FPainter then
  631.       Painter := nil
  632.     else
  633.     if Component = FImages then
  634.       Images := nil
  635.     else
  636.     if Component = FPageList then
  637.       PageList := nil;
  638.   end;
  639.   if FTabs <> nil then
  640.     for I := Tabs.Count - 1 downto 0 do
  641.       Tabs[I].Notification(Component, Operation);
  642. end;
  643.  
  644. procedure TJvCustomTabBar.DrawScrollBarGlyph(Canvas: TCanvas; X, Y: Integer; Left, Disabled: Boolean);
  645.  
  646.   procedure OffsetPt(var Pt: TPoint; X, Y: Integer);
  647.   begin
  648.     Pt := Point(Pt.X + X, Pt.Y + Y);
  649.   end;
  650.  
  651. const
  652.   W = 4;
  653.   H = 7;
  654. var
  655.   Pts: array [0..2] of TPoint;
  656.   Brush: TBrush;
  657.   Pen: TPen;
  658. begin
  659.   Brush := TBrush.Create;
  660.   Pen := TPen.Create;
  661.   try
  662.     Brush.Assign(Canvas.Brush);
  663.     Pen.Assign(Canvas.Pen);
  664.  
  665.     if Left then
  666.     begin
  667.       Pts[0] := Point(X + W - 1, Y + 0);
  668.       Pts[1] := Point(X + W - 1, Y + H - 1);
  669.       Pts[2] := Point(X + 0, Y + (H - 1) div 2);
  670.     end
  671.     else
  672.     begin
  673.       Pts[0] := Point(X + 0, Y + 0);
  674.       Pts[1] := Point(X + 0, Y + H - 1);
  675.       Pts[2] := Point(X + W - 1, Y + (H - 1) div 2);
  676.     end;
  677.     Canvas.Brush.Style := bsSolid;
  678.     if Disabled then
  679.     begin
  680.       Canvas.Brush.Color := clWhite;
  681.       OffsetPt(Pts[0], 1, 1);
  682.       OffsetPt(Pts[1], 1, 1);
  683.       OffsetPt(Pts[2], 1, 1);
  684.     end
  685.     else
  686.       Canvas.Brush.Color := clBlack;
  687.  
  688.     Canvas.Pen.Color := Canvas.Brush.Color;
  689.     Canvas.Polygon(Pts);
  690.     if Disabled then
  691.     begin
  692.       Canvas.Brush.Color := clGray;
  693.       OffsetPt(Pts[0], -1, -1);
  694.       OffsetPt(Pts[1], -1, -1);
  695.       OffsetPt(Pts[2], -1, -1);
  696.       Canvas.Pen.Color := Canvas.Brush.Color;
  697.       Canvas.Polygon(Pts);
  698.     end;
  699.   finally
  700.     Canvas.Pen.Assign(Pen);
  701.     Canvas.Brush.Assign(Brush);
  702.     Pen.Free;
  703.     Brush.Free;
  704.   end;
  705. end;
  706.  
  707. procedure TJvCustomTabBar.SetTabs(Value: TJvTabBarItems);
  708. begin
  709.   if Value <> FTabs then
  710.     FTabs.Assign(Value);
  711. end;
  712.  
  713. procedure TJvCustomTabBar.SetPainter(Value: TJvTabBarPainter);
  714. begin
  715.   if Value <> FPainter then
  716.   begin
  717.     if FPainter <> nil then
  718.       FPainter.FOnChangeList.Extract(Self);
  719.     ReplaceComponentReference(Self, Value, tComponent(FPainter));
  720.     if FPainter <> nil then
  721.     begin
  722.       FreeAndNil(FDefaultPainter);
  723.       FPainter.FOnChangeList.Add(Self);
  724.       if Parent <> nil then
  725.         UpdateScrollButtons;
  726.     end;
  727.  
  728.     if not (csDestroying in ComponentState) then
  729.       Invalidate;
  730.   end;
  731. end;
  732.  
  733. procedure TJvCustomTabBar.SetImages(Value: TCustomImageList);
  734. begin
  735.   if ReplaceImageListReference(Self, Value, FImages, FChangeLink) then
  736.     if not (csDestroying in ComponentState) then
  737.       Invalidate;
  738. end;
  739.  
  740. procedure TJvCustomTabBar.SetCloseButton(Value: Boolean);
  741. begin
  742.   if Value <> FCloseButton then
  743.   begin
  744.     FCloseButton := Value;
  745.     Invalidate;
  746.   end;
  747. end;
  748.  
  749. procedure TJvCustomTabBar.SetMargin(Value: Integer);
  750. begin
  751.   if Value <> FMargin then
  752.   begin
  753.     FMargin := Value;
  754.     Invalidate;
  755.   end;
  756. end;
  757.  
  758. procedure TJvCustomTabBar.SetSelectedTab(Value: TJvTabBarItem);
  759. begin
  760.   if Value <> FSelectedTab then
  761.   begin
  762.     if (Value <> nil) and not Value.CanSelect then
  763.       Exit;
  764.  
  765.     if TabSelecting(Value) then
  766.     begin
  767.       FSelectedTab := Value;
  768.       if not (csDestroying in ComponentState) then
  769.         Invalidate;
  770.       MakeVisible(FSelectedTab);
  771.       TabSelected(FSelectedTab);
  772.     end;
  773.   end;
  774. end;
  775.  
  776. function TJvCustomTabBar.CurrentPainter: TJvTabBarPainter;
  777. begin
  778.   Result := FPainter;
  779.   if Result = nil then
  780.   begin
  781.     if FDefaultPainter = nil then
  782.       FDefaultPainter := TJvModernTabBarPainter.Create(Self);
  783.     Result := FDefaultPainter;
  784.   end;
  785. end;
  786.  
  787. function TJvCustomTabBar.TabClosing(Tab: TJvTabBarItem): Boolean;
  788. begin
  789.   Result := True;
  790.   if Assigned(FOnTabClosing) then
  791.     FOnTabClosing(Self, Tab, Result);
  792. end;
  793.  
  794. function TJvCustomTabBar.TabCloseQuery(Tab: TJvTabBarItem): Boolean;
  795. begin
  796.   Result := True;
  797.   if Assigned(FOnTabCloseQuery) then
  798.     FOnTabCloseQuery(Self, Tab, Result);
  799. end;
  800.  
  801. procedure TJvCustomTabBar.TabClosed(Tab: TJvTabBarItem);
  802. begin
  803.   if AutoFreeClosed and not (csDesigning in ComponentState) then
  804.     Tab.Visible := False;
  805.   try
  806.     if Assigned(FOnTabClosed) then
  807.       FOnTabClosed(Self, Tab);
  808.   finally
  809.     // Do not double release if somebody "accidentally" released the Tab in TabClosed even if AutoFreeClosed is true
  810.     if AutoFreeClosed and not (csDesigning in ComponentState) and (FTabs.IndexOf(Tab) <> -1) then
  811.       Tab.Free;
  812.   end;
  813. end;
  814.  
  815. function TJvCustomTabBar.TabSelecting(Tab: TJvTabBarItem): Boolean;
  816. begin
  817.   Result := True;
  818.   if Assigned(FOnTabSelecting) then
  819.     FOnTabSelecting(Self, Tab, Result);
  820. end;
  821.  
  822. procedure TJvCustomTabBar.TabSelected(Tab: TJvTabBarItem);
  823. var
  824.   PageListIntf: IPageList;
  825. begin
  826.   if (PageList <> nil) and Supports(PageList, IPageList, PageListIntf) then
  827.   begin
  828.     if Tab <> nil then
  829.       PageListIntf.SetActivePageIndex(Tab.Index)
  830.     else
  831.       PageListIntf.SetActivePageIndex(-1);
  832.     PageListIntf := nil; // who knows what OnTabSelected does with the PageList
  833.   end;
  834.   if Assigned(FOnTabSelected) then
  835.     FOnTabSelected(Self, Tab);
  836. end;
  837.  
  838. function TJvCustomTabBar.FindSelectableTab(Tab: TJvTabBarItem): TJvTabBarItem;
  839. var
  840.   Index: Integer;
  841. begin
  842.   Result := Tab;
  843.   if (Result <> nil) and not Result.CanSelect then
  844.   begin
  845.     if AllowUnselected then
  846.       Result := nil
  847.     else
  848.     begin
  849.       Index := Result.Index + 1;
  850.       while Index < Tabs.Count do
  851.       begin
  852.         if Tabs[Index].CanSelect then
  853.           Break;
  854.         Inc(Index);
  855.       end;
  856.       if Index >= Tabs.Count then
  857.       begin
  858.         Index := Result.Index - 1;
  859.         while Index >= 0 do
  860.         begin
  861.           if Tabs[Index].CanSelect then
  862.             Break;
  863.           Dec(Index);
  864.         end;
  865.       end;
  866.       if Index >= 0 then
  867.         Result := Tabs[Index]
  868.       else
  869.         Result := nil;
  870.     end;
  871.   end;
  872.   if not AllowUnselected and not (Result <> nil) then
  873.   begin
  874.     // try to find a selectable tab
  875.     for Index := 0 to Tabs.Count - 1 do
  876.       if Tabs[Index].CanSelect then
  877.       begin
  878.         Result := Tabs[Index];
  879.         Break;
  880.       end;
  881.   end;
  882. end;
  883.  
  884. procedure TJvCustomTabBar.Changed;
  885. begin
  886.   if not (csDestroying in ComponentState) then
  887.   begin
  888.     // The TabSelected tab is now no more selectable
  889.     SelectedTab := FindSelectableTab(SelectedTab);
  890.     if Tabs.UpdateCount = 0 then
  891.     begin
  892.       Invalidate;
  893.       if Assigned(FOnChange) then
  894.         FOnChange(Self);
  895.       UpdateScrollButtons;
  896.     end;
  897.   end;
  898. end;
  899.  
  900. procedure TJvCustomTabBar.ImagesChanged(Sender: TObject);
  901. begin
  902.   if not (csDestroying in ComponentState) then
  903.     Invalidate;
  904. end;
  905.  
  906. procedure TJvCustomTabBar.TabMoved(Tab: TJvTabBarItem);
  907. begin
  908.   if Assigned(FOnTabMoved) then
  909.     FOnTabMoved(Self, Tab);
  910. end;
  911.  
  912. procedure TJvCustomTabBar.DragOver(Source: TObject; X: Integer; Y: Integer;
  913.   State: TDragState; var Accept: Boolean);
  914. var
  915.   InsertTab: TJvTabBarItem;
  916. begin
  917.   if AllowTabMoving then
  918.   begin
  919.     InsertTab := TabAt(X, Y);
  920.     if InsertTab = nil then
  921.       if (LeftTab <> nil) and (X < LeftTab.FLeft) then
  922.         InsertTab := LeftTab
  923.       else
  924.       if Tabs.Count > 0 then
  925.         InsertTab := Tabs[Tabs.Count - 1];
  926.  
  927.     Accept := (Source = Self) and (SelectedTab <> nil) and (InsertTab <> SelectedTab) and (InsertTab <> nil);
  928.     if Accept then
  929.     begin
  930.       if InsertTab <> FLastInsertTab then
  931.       begin
  932.         if FLastInsertTab <> nil then
  933.           Repaint;
  934.         { Paint MoveDivider }
  935.         FLastInsertTab := InsertTab;
  936.         CurrentPainter.DrawMoveDivider(Canvas, InsertTab, InsertTab.Index < SelectedTab.Index);
  937.       end;
  938.       { inherited DrawOver sets Accept to False if no event handler is assigned. }
  939.       if Assigned(OnDragOver) then
  940.         OnDragOver(Self, Source, X, Y, State, Accept);
  941.       Exit;
  942.     end
  943.     else
  944.     if FLastInsertTab <> nil then
  945.     begin
  946.       Repaint;
  947.       FLastInsertTab := nil;
  948.     end;
  949.   end;
  950.   inherited DragOver(Source, X, Y, State, Accept);
  951. end;
  952.  
  953. procedure TJvCustomTabBar.DragCanceled;
  954. begin
  955.   if FLastInsertTab <> nil then
  956.     Repaint;
  957.   FLastInsertTab := nil;
  958.   inherited DragCanceled;
  959. end;
  960.  
  961. procedure TJvCustomTabBar.DragDrop(Source: TObject; X: Integer; Y: Integer);
  962. var
  963.   InsertTab: TJvTabBarItem;
  964. begin
  965.   if AllowTabMoving and (Source = Self) and (SelectedTab <> nil) then
  966.   begin
  967.     InsertTab := TabAt(X, Y);
  968.     if InsertTab = nil then
  969.       if (LeftTab <> nil) and (X < LeftTab.FLeft) then
  970.         InsertTab := LeftTab
  971.       else
  972.         InsertTab := Tabs[Tabs.Count - 1];
  973.     if InsertTab <> nil then
  974.     begin
  975.       SelectedTab.Index := InsertTab.Index;
  976.       TabMoved(SelectedTab);
  977.       SelectedTab.MakeVisible;
  978.       UpdateScrollButtons;
  979.     end;
  980.   end
  981.   else
  982.   if FLastInsertTab <> nil then
  983.     Repaint;
  984.   FLastInsertTab := nil;
  985.   inherited DragDrop(Source, X, Y);
  986. end;
  987.  
  988. procedure TJvCustomTabBar.CMMouseLeave(var Msg: TMessage);
  989. begin
  990.   SetHotTab(nil);
  991.   inherited;
  992. end;
  993.  
  994. procedure TJvCustomTabBar.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
  995. begin
  996.   Msg.Result := 1;
  997. end;
  998.  
  999. function TJvCustomTabBar.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
  1000. begin
  1001.   Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  1002.   if not Result then
  1003.   begin
  1004.     Result := True;
  1005.  
  1006.     if SelectedTab = nil then
  1007.       SelectedTab := LeftTab;
  1008.     if SelectedTab = nil then
  1009.       Exit; // nothing to do
  1010.  
  1011.     WheelDelta := WheelDelta div WHEEL_DELTA;
  1012.     while WheelDelta <> 0 do
  1013.     begin
  1014.       if WheelDelta < 0 then
  1015.       begin
  1016.         if SelectedTab.GetNextVisible <> nil then
  1017.           SelectedTab := SelectedTab.GetNextVisible
  1018.         else
  1019.           Break;
  1020.       end
  1021.       else
  1022.       begin
  1023.         if SelectedTab.GetPreviousVisible <> nil then
  1024.           SelectedTab := SelectedTab.GetPreviousVisible
  1025.         else
  1026.           Break;
  1027.       end;
  1028.  
  1029.       if WheelDelta < 0 then
  1030.         Inc(WheelDelta)
  1031.       else
  1032.         Dec(WheelDelta);
  1033.     end;
  1034.   end;
  1035. end;
  1036.  
  1037. procedure TJvCustomTabBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  1038.   Y: Integer);
  1039. var
  1040.   Tab: TJvTabBarItem;
  1041.   LastSelected: TJvTabBarItem;
  1042. begin
  1043.   if ScrollButtonsMouseDown(Button, Shift, X, Y) then
  1044.     Exit;
  1045.  
  1046.   if Button = mbLeft then
  1047.   begin
  1048.     FMouseDownClosingTab := nil;
  1049.     SetClosingTab(nil); // no tab should be closed
  1050.  
  1051.     LastSelected := SelectedTab;
  1052.     Tab := TabAt(X, Y);
  1053.     if Tab <> nil then
  1054.       SelectedTab := Tab;
  1055.  
  1056.     if (Tab <> nil) and (Tab = SelectedTab) then
  1057.       if CloseButton and (not SelectBeforeClose or (SelectedTab = LastSelected)) then
  1058.       begin
  1059.         if PtInRect(CurrentPainter.GetCloseRect(Canvas, Tab, Tab.DisplayRect), Point(X, Y)) then
  1060.         begin
  1061.           if TabClosing(Tab) then
  1062.           begin
  1063.             if FTabs.IndexOf(Tab) = -1 then
  1064.               Tab := nil; // We should not keep a reference if somebody "accidentally" released the Tab in TabClosing
  1065.             FMouseDownClosingTab := Tab;
  1066.             SetClosingTab(Tab);
  1067.           end;
  1068.           inherited MouseDown(Button, Shift, X, Y);
  1069.           Exit;
  1070.         end;
  1071.       end;
  1072.     if (FClosingTab = nil) and AllowTabMoving and
  1073.        ([ssLeft, ssMiddle, ssRight] * Shift = [ssLeft]) then
  1074.       BeginDrag(False);
  1075.   end;
  1076.   inherited MouseDown(Button, Shift, X, Y);
  1077. end;
  1078.  
  1079. procedure TJvCustomTabBar.MouseUp(Button: TMouseButton; Shift: TShiftState;
  1080.   X, Y: Integer);
  1081. var
  1082.   Pt: TPoint;
  1083.   Tab: TJvTabBarItem;
  1084. begin
  1085.   if ScrollButtonsMouseUp(Button, Shift, X, Y) then
  1086.     Exit;
  1087.  
  1088.   try
  1089.     if RightClickSelect and not (PopupMenu <> nil) and (Button = mbRight) then
  1090.     begin
  1091.       Tab := TabAt(X, Y);
  1092.       if Tab <> nil then
  1093.         SelectedTab := Tab;
  1094.       if (Tab <> nil) and (Tab.PopupMenu <> nil) then
  1095.       begin
  1096.         Pt := ClientToScreen(Point(X, Y));
  1097.         Tab.PopupMenu.Popup(Pt.X, Pt.Y);
  1098.       end;
  1099.     end
  1100.     else
  1101.     if Button = mbLeft then
  1102.     begin
  1103.       if (FClosingTab <> nil) and CloseButton then
  1104.       begin
  1105.         CalcTabsRects;
  1106.         if PtInRect(CurrentPainter.GetCloseRect(Canvas, FClosingTab, FClosingTab.DisplayRect), Point(X, Y)) then
  1107.         begin
  1108.           if TabCloseQuery(FClosingTab) then
  1109.             TabClosed(FClosingTab)
  1110.         end;
  1111.       end;
  1112.     end;
  1113.   finally
  1114.     FMouseDownClosingTab := nil;
  1115.     SetClosingTab(nil);
  1116.   end;
  1117.   inherited MouseUp(Button, Shift, X, Y);
  1118. end;
  1119.  
  1120. procedure TJvCustomTabBar.MouseMove(Shift: TShiftState; X, Y: Integer);
  1121. var
  1122.   Tab: TJvTabBarItem;
  1123.   NewHint: TCaption;
  1124. begin
  1125.   CalcTabsRects; // maybe inefficent
  1126.   if ScrollButtonsMouseMove(Shift, X, Y) then
  1127.     Exit;
  1128.  
  1129.   Tab := TabAt(X, Y);
  1130.   if HotTracking and ([ssLeft, ssMiddle, ssRight] * Shift = []) then
  1131.     SetHotTab(Tab);
  1132.  
  1133.   if CloseButton and (FMouseDownClosingTab <> nil) and (ssLeft in Shift) then
  1134.   begin
  1135.     if PtInRect(CurrentPainter.GetCloseRect(Canvas, FMouseDownClosingTab,
  1136.       FMouseDownClosingTab.DisplayRect), Point(X, Y)) then
  1137.       SetClosingTab(FMouseDownClosingTab)
  1138.     else
  1139.       SetClosingTab(nil)
  1140.   end;
  1141.  
  1142.   if (Tab <> nil) and Tab.ShowHint then
  1143.     NewHint := Tab.Hint
  1144.   else
  1145.     NewHint := FHint;
  1146.  
  1147.   if NewHint <> inherited Hint then
  1148.   begin
  1149.     Application.CancelHint;
  1150.     ShowHint := False;
  1151.     ShowHint := True;
  1152.     inherited Hint := NewHint;
  1153.   end;
  1154.  
  1155.   inherited MouseMove(Shift, X, Y);
  1156. end;
  1157.  
  1158. function TJvCustomTabBar.ScrollButtonsMouseDown(Button: TMouseButton;
  1159.   Shift: TShiftState; X, Y: Integer): Boolean;
  1160.  
  1161.   function HandleButton(Kind: TJvTabBarScrollButtonKind; var State: TJvTabBarScrollButtonState;
  1162.     X, Y: Integer; const R: TRect): Boolean;
  1163.   begin
  1164.     Result := PtInRect(R, Point(X, Y));
  1165.     case State of
  1166.       sbsNormal, sbsHot:
  1167.         begin
  1168.           if Result then
  1169.           begin
  1170.             State := sbsPressed;
  1171.             PaintScrollButtons;
  1172.  
  1173.             if FRepeatTimer = nil then
  1174.               FRepeatTimer := TTimer.Create(Self);
  1175.             FRepeatTimer.OnTimer := TimerExpired;
  1176.             FRepeatTimer.Interval := 400;
  1177.             FRepeatTimer.Enabled := True;
  1178.             FRepeatTimer.Tag := Integer(Kind);
  1179.             FScrollRepeatedClicked := False;
  1180.           end;
  1181.         end;
  1182.     end;
  1183.   end;
  1184.  
  1185. begin
  1186.   Result := False;
  1187.   if (FBtnLeftScroll.State <> sbsHidden) then
  1188.     Result := HandleButton(sbScrollLeft, FBtnLeftScroll.State, X, Y, FBtnLeftScroll.Rect);
  1189.   if not Result and (FBtnRightScroll.State <> sbsHidden) then
  1190.     Result := HandleButton(sbScrollRight, FBtnRightScroll.State, X, Y, FBtnRightScroll.Rect);
  1191. end;
  1192.  
  1193. function TJvCustomTabBar.ScrollButtonsMouseMove(Shift: TShiftState; X, Y: Integer): Boolean;
  1194.  
  1195.   function HandleButton(var ExState: Boolean; var State: TJvTabBarScrollButtonState;
  1196.     X, Y: Integer; const R: TRect): Boolean;
  1197.   begin
  1198.     Result := PtInRect(R, Point(X, Y));
  1199.     case State of
  1200.       sbsNormal:
  1201.         begin
  1202.           if Result then
  1203.           begin
  1204.             State := sbsHot;
  1205.             PaintScrollButtons;
  1206.             Result := True;
  1207.           end;
  1208.         end;
  1209.       sbsPressed:
  1210.         begin
  1211.           if not Result then
  1212.           begin
  1213.             ExState := True;
  1214.             State := sbsNormal;
  1215.             PaintScrollButtons;
  1216.             State := sbsPressed;
  1217.           end
  1218.           else
  1219.           begin
  1220.             if ExState then
  1221.             begin
  1222.               ExState := False;
  1223.               PaintScrollButtons;
  1224.             end;
  1225.           end;
  1226.         end;
  1227.       sbsHot:
  1228.         begin
  1229.           if not Result then
  1230.           begin
  1231.             State := sbsNormal;
  1232.             PaintScrollButtons;
  1233.           end;
  1234.         end;
  1235.     end;
  1236.   end;
  1237.  
  1238. begin
  1239.   Result := False;
  1240.   if (FBtnLeftScroll.State <> sbsHidden) then
  1241.     Result := HandleButton(FBtnLeftScroll.ExState, FBtnLeftScroll.State, X, Y, FBtnLeftScroll.Rect);
  1242.   if not Result and (FBtnRightScroll.State <> sbsHidden) then
  1243.     Result := HandleButton(FBtnRightScroll.ExState, FBtnRightScroll.State, X, Y, FBtnRightScroll.Rect);
  1244. end;
  1245.  
  1246. function TJvCustomTabBar.ScrollButtonsMouseUp(Button: TMouseButton;
  1247.   Shift: TShiftState; X, Y: Integer): Boolean;
  1248.  
  1249.   function HandleButton(Kind: TJvTabBarScrollButtonKind; var State: TJvTabBarScrollButtonState;
  1250.     X, Y: Integer; const R: TRect): Boolean;
  1251.   begin
  1252.     Result := PtInRect(R, Point(X, Y));
  1253.     case State of
  1254.       sbsPressed:
  1255.         begin
  1256.           FreeAndNil(FRepeatTimer);
  1257.           State := sbsNormal;
  1258.           PaintScrollButtons;
  1259.           if Result and not FScrollRepeatedClicked then
  1260.             ScrollButtonClick(Kind);
  1261.           FScrollRepeatedClicked := False;
  1262.         end;
  1263.     end;
  1264.   end;
  1265.  
  1266. begin
  1267.   Result := False;
  1268.   if (FBtnLeftScroll.State <> sbsHidden) then
  1269.     Result := HandleButton(sbScrollLeft, FBtnLeftScroll.State, X, Y, FBtnLeftScroll.Rect);
  1270.   if not Result and (FBtnRightScroll.State <> sbsHidden) then
  1271.     Result := HandleButton(sbScrollRight, FBtnRightScroll.State, X, Y, FBtnRightScroll.Rect);
  1272. end;
  1273.  
  1274. procedure TJvCustomTabBar.TimerExpired(Sender: TObject);
  1275. var
  1276.   Kind: TJvTabBarScrollButtonKind;
  1277.   State: TJvTabBarScrollButtonState;
  1278. begin
  1279.   FRepeatTimer.Interval := 100;
  1280.   Kind := TJvTabBarScrollButtonKind(FRepeatTimer.Tag);
  1281.   case Kind of
  1282.     sbScrollLeft:
  1283.       State := FBtnLeftScroll.State;
  1284.     sbScrollRight:
  1285.       State := FBtnRightScroll.State;
  1286.   else
  1287.     Exit;
  1288.   end;
  1289.  
  1290.   if (State = sbsPressed) and Enabled {and MouseCapture} then
  1291.   begin
  1292.     try
  1293.       FScrollRepeatedClicked := True;
  1294.       ScrollButtonClick(Kind);
  1295.       case Kind of
  1296.         sbScrollLeft:
  1297.           if not (FBtnLeftScroll.State in [sbsHidden, sbsDisabled]) then
  1298.             FBtnLeftScroll.State := sbsPressed;
  1299.         sbScrollRight:
  1300.           if not (FBtnRightScroll.State in [sbsHidden, sbsDisabled]) then
  1301.             FBtnRightScroll.State := sbsPressed;
  1302.       end;
  1303.     except
  1304.       FRepeatTimer.Enabled := False;
  1305.       raise;
  1306.     end;
  1307.   end
  1308.   else
  1309.     FreeAndNil(FRepeatTimer);
  1310. end;
  1311.  
  1312. procedure TJvCustomTabBar.SetHotTab(Tab: TJvTabBarItem);
  1313. begin
  1314.   if (csDestroying in ComponentState) or not HotTracking then
  1315.     FHotTab := nil
  1316.   else
  1317.   if Tab <> FHotTab then
  1318.   begin
  1319.     FHotTab := Tab;
  1320.     if poPaintsHotTab in CurrentPainter.Options then
  1321.       Paint;
  1322.   end;
  1323. end;
  1324.  
  1325. function TJvCustomTabBar.CloseTab(ATab: TJvTabBarItem): Boolean;
  1326. begin
  1327.   Result := False;
  1328.   if ATab <> nil then
  1329.   begin
  1330.      FClosingTab := ATab;
  1331.     try
  1332.       Result := TabCloseQuery(FClosingTab);
  1333.       if Result then
  1334.         TabClosed(FClosingTab);
  1335.     finally
  1336.       FClosingTab := nil;
  1337.     end;
  1338.   end;
  1339. end;
  1340.  
  1341. function TJvCustomTabBar.AddTab(const Caption: string): TJvTabBarItem;
  1342. begin
  1343.   Result := TJvTabBarItem(Tabs.Add);
  1344.   Result.Caption := Caption;
  1345. end;
  1346.  
  1347. function TJvCustomTabBar.FindTab(const Caption: string): TJvTabBarItem;
  1348. var
  1349.   i: Integer;
  1350. begin
  1351.   for i := 0 to Tabs.Count - 1 do
  1352.     if Caption = Tabs[i].Caption then
  1353.     begin
  1354.       Result := Tabs[i];
  1355.       Exit;
  1356.     end;
  1357.   Result := nil;
  1358. end;
  1359.  
  1360. procedure TJvCustomTabBar.CalcTabsRects;
  1361. var
  1362.   I, X: Integer;
  1363.   Tab: TJvTabBarItem;
  1364.   Offset: Integer;
  1365.   Index: Integer;
  1366. begin
  1367.   if csDestroying in ComponentState then
  1368.     Exit;
  1369.  
  1370.   Offset := 0;
  1371.   X := Margin;  // adjust for scrolled area
  1372.   Index := 0;
  1373.   for I := 0 to Tabs.Count - 1 do
  1374.   begin
  1375.     Tab := Tabs[I];
  1376.     if Tab.Visible then
  1377.     begin
  1378.       Tab.FLeft := X;
  1379.       Inc(X, GetTabWidth(Tab));
  1380.       Inc(X, CurrentPainter.GetDividerWidth(Canvas, Tab));
  1381.       if Index < FLeftIndex then
  1382.       begin
  1383.         Inc(Offset, X); // this tab is placed too left.
  1384.         X := 0;
  1385.         Tab.FLeft := -Offset - 10;
  1386.       end;
  1387.       Inc(Index);
  1388.     end
  1389.     else
  1390.       Tab.FLeft := -1;
  1391.   end;
  1392.  
  1393.   FRequiredWidth := X + Offset;
  1394.   FLastTabRight := X;
  1395. end;
  1396.  
  1397. procedure TJvCustomTabBar.Paint;
  1398. var
  1399.   I: Integer;
  1400.   Bmp: TBitmap;
  1401.   R: TRect;
  1402. begin
  1403.   CalcTabsRects;
  1404.   Bmp := TBitmap.Create;
  1405.   try
  1406.     Bmp.Width := ClientWidth;
  1407.     Bmp.Height := ClientHeight;
  1408.     CurrentPainter.DrawBackground(Bmp.Canvas, Self, ClientRect);
  1409.     if (FBtnLeftScroll.State <> sbsHidden) and (FBtnRightScroll.State <> sbsHidden) then
  1410.     begin
  1411.       if FScrollButtonBackground = nil then
  1412.         FScrollButtonBackground := TBitmap.Create;
  1413.       FScrollButtonBackground.Width := Bmp.Width - FBarWidth;
  1414.       FScrollButtonBackground.Height := Bmp.Height;
  1415.       R := Rect(FBarWidth, 0, Bmp.Width, Bmp.Height);
  1416.       FScrollButtonBackground.Canvas.CopyRect(Rect(0, 0, FScrollButtonBackground.Width, R.Bottom), Bmp.Canvas, R);
  1417.       PaintScrollButtons;
  1418.       if FBarWidth > 0 then
  1419.         Bmp.Width := FBarWidth;
  1420.     end;
  1421.  
  1422.     if FBarWidth > 0 then
  1423.       for I := 0 to Tabs.Count - 1 do
  1424.         if Tabs[I].Visible then
  1425.           PaintTab(Bmp.Canvas, Tabs[I]);
  1426.     Canvas.Draw(0, 0, Bmp);
  1427.   finally
  1428.     Bmp.Free;
  1429.   end;
  1430. end;
  1431.  
  1432. procedure TJvCustomTabBar.PaintTab(Canvas: TCanvas; Tab: TJvTabBarItem);
  1433. var
  1434.   R: TRect;
  1435. begin
  1436.   if csDestroying in ComponentState then
  1437.     Exit;
  1438.  
  1439.   if Tab.Visible then
  1440.   begin
  1441.     R := Tab.DisplayRect;
  1442.     if (R.Right >= 0) and (R.Left < FBarWidth) then
  1443.     begin
  1444.       CurrentPainter.DrawTab(Canvas, Tab, R);
  1445.       R.Left := R.Right;
  1446.       R.Right := R.Left + CurrentPainter.GetDividerWidth(Canvas, Tab) - 1;
  1447.       CurrentPainter.DrawDivider(Canvas, Tab, R);
  1448.     end;
  1449.   end;
  1450. end;
  1451.  
  1452. procedure TJvCustomTabBar.PaintScrollButtons;
  1453. begin
  1454.   if (FScrollButtonBackground = nil) and Visible then
  1455.     Paint
  1456.   else // paint scroll button's background and the buttons
  1457.     Canvas.Draw(FBarWidth, 0, FScrollButtonBackground);
  1458.  
  1459.   CurrentPainter.DrawScrollButton(Canvas, Self, sbScrollLeft, FBtnLeftScroll.State, FBtnLeftScroll.Rect);
  1460.   CurrentPainter.DrawScrollButton(Canvas, Self, sbScrollRight, FBtnRightScroll.State, FBtnRightScroll.Rect);
  1461. end;
  1462.  
  1463. function TJvCustomTabBar.GetTabHeight(Tab: TJvTabBarItem): Integer;
  1464. begin
  1465.   Result := Abs(CurrentPainter.GetTabSize(Canvas, Tab).cy);
  1466.   if Result > High(Word) then
  1467.     Result := High(Word);
  1468. end;
  1469.  
  1470. function TJvCustomTabBar.GetTabWidth(Tab: TJvTabBarItem): Integer;
  1471. begin
  1472.   Result := Abs(CurrentPainter.GetTabSize(Canvas, Tab).cx);
  1473.   if Result > High(Word) then
  1474.     Result := High(Word);
  1475. end;
  1476.  
  1477. function TJvCustomTabBar.TabAt(X, Y: Integer): TJvTabBarItem;
  1478. var
  1479.   I: Integer;
  1480.   Pt: TPoint;
  1481. begin
  1482.   if (FBtnLeftScroll.State = sbsHidden) or (X < FBarWidth) then
  1483.   begin
  1484.     CalcTabsRects;
  1485.     Pt := Point(X, Y);
  1486.     for I := 0 to Tabs.Count - 1 do
  1487.       if PtInRect(Tabs[I].DisplayRect, Pt) then
  1488.       begin
  1489.         Result := Tabs[I];
  1490.         Exit;
  1491.       end;
  1492.   end;
  1493.   Result := nil;
  1494. end;
  1495.  
  1496. procedure TJvCustomTabBar.SetClosingTab(Tab: TJvTabBarItem);
  1497. begin
  1498.   if Tab <> FClosingTab then
  1499.   begin
  1500.     FClosingTab := Tab; // this tab should be TabClosed
  1501.     Paint;
  1502.   end;
  1503. end;
  1504.  
  1505. function TJvCustomTabBar.GetLeftTab: TJvTabBarItem;
  1506. begin
  1507.   if (Tabs <> nil) and (FLeftIndex < Tabs.Count) then
  1508.   begin
  1509.     Result := Tabs[FLeftIndex];
  1510.     if not Result.Visible then
  1511.       Result := Result.GetNextVisible;
  1512.   end
  1513.   else
  1514.     Result := nil;
  1515. end;
  1516.  
  1517. procedure TJvCustomTabBar.SetLeftTab(Value: TJvTabBarItem);
  1518. var
  1519.   Index: Integer;
  1520.   Tab: TJvTabBarItem;
  1521. begin
  1522.   Index := 0;
  1523.   if Value <> nil then
  1524.   begin
  1525.     // find first visible before or at Value.Index
  1526.     if (Tabs <> nil) and (Tabs.Count > 0) and (Value <> Tabs[0]) then
  1527.     begin
  1528.       while Index < Tabs.Count do
  1529.       begin
  1530.         Tab := Tabs[Index].GetNextVisible;
  1531.         if Tab = nil then
  1532.         begin
  1533.           Index := FLeftIndex; // do not change
  1534.           Break;
  1535.         end
  1536.         else
  1537.         begin
  1538.           Index := Tab.Index;
  1539.           if Tab.Index >= Value.Index then
  1540.             Break;
  1541.         end;
  1542.       end;
  1543.       if Index >= Tabs.Count then
  1544.         Index := FLeftIndex; // do not change
  1545.     end;
  1546.   end;
  1547.   if Index <> FLeftIndex then
  1548.   begin
  1549.     FLeftIndex := Index;
  1550.     Invalidate;
  1551.     UpdateScrollButtons;
  1552.     LeftTabChanged;
  1553.   end;
  1554. end;
  1555.  
  1556. procedure TJvCustomTabBar.UpdateScrollButtons;
  1557. const
  1558.   State: array[Boolean] of TJvTabBarScrollButtonState = (sbsDisabled, sbsNormal);
  1559.   { _mxn_ }
  1560.   BtnSizeWidth = 14;
  1561.   BtnSizeHeight = 18;
  1562. begin
  1563.   CalcTabsRects;
  1564.   if (FRequiredWidth < ClientWidth) or ((FLeftIndex = 0) and
  1565.     (FLastTabRight <= ClientWidth)) then
  1566.   begin
  1567.     FBtnLeftScroll.State := sbsHidden;
  1568.     FBtnRightScroll.State := sbsHidden;
  1569.     FLeftIndex := 0;
  1570.     FBarWidth := ClientWidth;
  1571.     Invalidate;
  1572.   end
  1573.   else
  1574.   begin
  1575.     FBtnLeftScroll.State := sbsNormal;
  1576.     FBtnRightScroll.State := sbsNormal;
  1577.  
  1578.     if poBottomScrollButtons in CurrentPainter.Options then
  1579.     begin
  1580.       { _mxn_ }
  1581.       FBtnLeftScroll.Rect := Bounds(ClientWidth - BtnSizeWidth * 2 - 1 - 1,
  1582.         ClientHeight - BtnSizeWidth - 2, BtnSizeWidth, BtnSizeHeight);
  1583.       FBtnRightScroll.Rect := Bounds(FBtnLeftScroll.Rect.Right,
  1584.         ClientHeight - BtnSizeWidth - 2, BtnSizeWidth, BtnSizeHeight);
  1585.     end
  1586.     else
  1587.     begin
  1588.       { _mxn_ }
  1589.       FBtnLeftScroll.Rect := Bounds(ClientWidth - BtnSizeWidth * 2 - 1 - 1, 2, BtnSizeWidth, BtnSizeHeight);
  1590.       FBtnRightScroll.Rect := Bounds(FBtnLeftScroll.Rect.Right, 2, BtnSizeWidth, BtnSizeHeight);
  1591.     end;
  1592.     if not FlatScrollButtons then
  1593.       OffsetRect(FBtnRightScroll.Rect, -1, 0);
  1594.  
  1595.     //CurrentPainter.GetScrollButtons(Self, FBtnLeftScroll.Rect, FBtnRightScroll.Rect);
  1596.  
  1597.     FBarWidth := FBtnLeftScroll.Rect.Left - 2;
  1598.  
  1599.     FBtnLeftScroll.State := State[FLeftIndex > 0];
  1600.     FBtnRightScroll.State := State[FLastTabRight >= ClientWidth];
  1601.  
  1602.     PaintScrollButtons;
  1603.   end;
  1604. end;
  1605.  
  1606. procedure TJvCustomTabBar.Resize;
  1607. begin
  1608.   UpdateScrollButtons;
  1609.   inherited Resize;
  1610. end;
  1611.  
  1612. procedure TJvCustomTabBar.ScrollButtonClick(Button: TJvTabBarScrollButtonKind);
  1613. begin
  1614.   if Button = sbScrollLeft then
  1615.   begin
  1616.     if FBtnLeftScroll.State in [sbsHidden, sbsDisabled] then
  1617.       Exit;
  1618.     Dec(FLeftIndex);
  1619.   end
  1620.   else
  1621.   if Button = sbScrollRight then
  1622.   begin
  1623.     if FBtnRightScroll.State in [sbsHidden, sbsDisabled] then
  1624.       Exit;
  1625.     Inc(FLeftIndex);
  1626.   end;
  1627.   UpdateScrollButtons;
  1628.   Invalidate;
  1629.   if Assigned(FOnScrollButtonClick) then
  1630.     FOnScrollButtonClick(Self, Button);
  1631.   LeftTabChanged;
  1632. end;
  1633.  
  1634. function TJvCustomTabBar.MakeVisible(Tab: TJvTabBarItem): Boolean;
  1635. var
  1636.   R: TRect;
  1637.   LastLeftIndex: Integer;
  1638.   AtLeft: Boolean;
  1639. begin
  1640.   Result := False;
  1641.   if (Tab = nil) or not Tab.Visible then
  1642.     Exit;
  1643.  
  1644.   LastLeftIndex := FLeftIndex;
  1645.   if FBarWidth > 0 then
  1646.   begin
  1647.     AtLeft := False;
  1648.     repeat
  1649.       CalcTabsRects;
  1650.       R := Tab.DisplayRect;
  1651.       if (R.Right > FBarWidth) and not AtLeft then
  1652.         Inc(FLeftIndex)
  1653.       else
  1654.       if R.Left < 0 then
  1655.       begin
  1656.         Dec(FLeftIndex);
  1657.         AtLeft := True; // prevent an endless loop
  1658.       end
  1659.       else
  1660.         Break;
  1661.     until FLeftIndex = Tabs.Count - 1;
  1662.   end
  1663.   else
  1664.     FLeftIndex := 0;
  1665.   if (R.Left < 0) and (FLeftIndex > 0) then
  1666.     Dec(FLeftIndex); // bar is too small
  1667.   if FLeftIndex <> LastLeftIndex then
  1668.   begin
  1669.     UpdateScrollButtons;
  1670.     Invalidate;
  1671.     LeftTabChanged;
  1672.   end;
  1673. end;
  1674.  
  1675. function TJvCustomTabBar.FindData(Data: TObject): TJvTabBarItem;
  1676. var
  1677.   I: Integer;
  1678. begin
  1679.   for I := 0 to Tabs.Count - 1 do
  1680.     if Tabs[I].Data = Data then
  1681.     begin
  1682.       Result := Tabs[I];
  1683.       Exit;
  1684.     end;
  1685.   Result := nil;
  1686. end;
  1687.  
  1688. procedure TJvCustomTabBar.SetHint(const Value: TCaption);
  1689. begin
  1690.   if Value <> FHint then
  1691.     FHint := Value;
  1692. end;
  1693.  
  1694. procedure TJvCustomTabBar.SetFlatScrollButtons(const Value: Boolean);
  1695. begin
  1696.   if Value <> FFlatScrollButtons then
  1697.   begin
  1698.     FFlatScrollButtons := Value;
  1699.     FBtnLeftScroll.State := sbsHidden;
  1700.     FBtnRightScroll.State := sbsHidden;
  1701.     UpdateScrollButtons;
  1702.   end;
  1703. end;
  1704.  
  1705. procedure TJvCustomTabBar.SetPageList(const Value: TCustomControl);
  1706. var
  1707.   PageListIntf: IPageList;
  1708. begin
  1709.   if Value <> FPageList then
  1710.   begin
  1711.     if Value <> nil then
  1712.     begin
  1713.       if not Supports(Value, IPageList, PageListIntf) then
  1714.         Exit;
  1715.       if SelectedTab <> nil then
  1716.         PageListIntf.SetActivePageIndex(SelectedTab.Index)
  1717.       else
  1718.         PageListIntf.SetActivePageIndex(0);
  1719.       PageListIntf := nil;
  1720.     end;
  1721.     if FPageList <> nil then
  1722.       FPageList.RemoveFreeNotification(Self);
  1723.     FPageList := Value;
  1724.     if FPageList <> nil then
  1725.       FPageList.FreeNotification(Self);
  1726.   end;
  1727. end;
  1728.  
  1729. procedure TJvCustomTabBar.SetOrientation(const Value: TJvTabBarOrientation);
  1730. begin
  1731.   if Value <> FOrientation then
  1732.   begin
  1733.     FOrientation := Value;
  1734.     CalcTabsRects;
  1735.     Repaint;
  1736.   end;
  1737. end;
  1738.  
  1739. //=== { TJvTabBarItem } ======================================================
  1740.  
  1741. constructor TJvTabBarItem.Create(Collection: Classes.TCollection);
  1742. begin
  1743.   inherited Create(Collection);
  1744.   FImageIndex := -1;
  1745.   FEnabled := True;
  1746.   FVisible := True;
  1747.   FShowHint := True;
  1748. end;
  1749.  
  1750. destructor TJvTabBarItem.Destroy;
  1751. begin
  1752.   PopupMenu := nil;
  1753.   Visible := False; // CanSelect returns false
  1754.   FAutoDeleteDatas.Free;
  1755.   inherited Destroy;
  1756. end;
  1757.  
  1758. procedure TJvTabBarItem.Assign(Source: TPersistent);
  1759. begin
  1760.   if Source is TJvTabBarItem then
  1761.   begin
  1762.     with TJvTabBarItem(Source) do
  1763.     begin
  1764.       Self.FImageIndex := FImageIndex;
  1765.       Self.FEnabled := FEnabled;
  1766.       Self.FVisible := FVisible;
  1767.       Self.FTag := FTag;
  1768.       Self.FData := FData;
  1769.       Self.FHint := FHint;
  1770.       Self.FShowHint := FShowHint;
  1771.       Self.FName := FName;
  1772.       Self.FCaption := FCaption;
  1773.       Self.FModified := FModified;
  1774.       Self.FImages := FImages;
  1775.       Changed;
  1776.     end;
  1777.   end
  1778.   else
  1779.     inherited Assign(Source);
  1780. end;
  1781.  
  1782. procedure TJvTabBarItem.Notification(Component: TComponent;
  1783.   Operation: TOperation);
  1784. begin
  1785.   if Operation = opRemove then
  1786.     if Component = PopupMenu then
  1787.       PopupMenu := nil;
  1788. end;
  1789.  
  1790. procedure TJvTabBarItem.Changed;
  1791. begin
  1792.   TabBar.Changed;
  1793. end;
  1794.  
  1795. function TJvTabBarItem.GetDisplayRect: TRect;
  1796. begin
  1797.   if not Visible then
  1798.     Result := Rect(-1, -1, -1, -1)
  1799.   else
  1800.   begin
  1801.     if FLeft = -1 then
  1802.       TabBar.CalcTabsRects; // not initialized
  1803.  
  1804.     case TabBar.Orientation of
  1805.       toBottom:
  1806.         Result := Rect(FLeft, 0,
  1807.           FLeft + TabBar.GetTabWidth(Self), 0 + TabBar.GetTabHeight(Self));
  1808.     else
  1809.       // toTop
  1810.       Result := Rect(FLeft, TabBar.ClientHeight - TabBar.GetTabHeight(Self),
  1811.           FLeft + TabBar.GetTabWidth(Self), TabBar.ClientHeight);
  1812.     end;
  1813.   end;
  1814. end;
  1815.  
  1816. function TJvTabBarItem.GetHot: Boolean;
  1817. begin
  1818.   Result := TabBar.HotTab = Self;
  1819. end;
  1820.  
  1821. function TJvTabBarItem.GetImages: TCustomImageList;
  1822. begin
  1823.   Result := TabBar.Images;
  1824. end;
  1825.  
  1826. function TJvTabBarItem.GetSelected: Boolean;
  1827. begin
  1828.   Result := TabBar.SelectedTab = Self;
  1829. end;
  1830.  
  1831. function TJvTabBarItem.GetTabBar: TJvCustomTabBar;
  1832. begin
  1833.   Result := (GetOwner as TJvTabBarItems).TabBar;
  1834. end;
  1835.  
  1836. procedure TJvTabBarItem.SetCaption(const Value: TCaption);
  1837. var
  1838.   PageListIntf: IPageList;
  1839. begin
  1840.   if Value <> FCaption then
  1841.   begin
  1842.     FCaption := Value;
  1843.     if TabBar.PageListTabLink and (TabBar.PageList <> nil) and
  1844.        not (csLoading in TabBar.ComponentState) and
  1845.        Supports(TabBar.PageList, IPageList, PageListIntf) then
  1846.       PageListIntf.PageCaptionChanged(Index, FCaption);
  1847.     Changed;
  1848.   end;
  1849. end;
  1850.  
  1851. procedure TJvTabBarItem.SetEnabled(const Value: Boolean);
  1852. begin
  1853.   if Value <> FEnabled then
  1854.   begin
  1855.     FEnabled := Value;
  1856.     Changed;
  1857.   end;
  1858. end;
  1859.  
  1860. procedure TJvTabBarItem.SetImageIndex(const Value: TImageIndex);
  1861. begin
  1862.   if Value <> FImageIndex then
  1863.   begin
  1864.     FImageIndex := Value;
  1865.     Changed;
  1866.   end;
  1867. end;
  1868.  
  1869. procedure TJvTabBarItem.SetName(const Value: string);
  1870. begin
  1871.   if (Value <> FName) and (TJvTabBarItems(Collection).Find(Value) = nil) then
  1872.     FName := Value;
  1873. end;
  1874.  
  1875. procedure TJvTabBarItem.SetSelected(const Value: Boolean);
  1876. begin
  1877.   if Value then
  1878.     TabBar.SelectedTab := Self;
  1879. end;
  1880.  
  1881. procedure TJvTabBarItem.SetVisible(const Value: Boolean);
  1882. begin
  1883.   if Value <> FVisible then
  1884.   begin
  1885.     FVisible := Value;
  1886.     FLeft := -1; // discard
  1887.     Changed;
  1888.   end;
  1889. end;
  1890.  
  1891. function TJvTabBarItem.CanSelect: Boolean;
  1892. begin
  1893.   Result := Visible and Enabled;
  1894. end;
  1895.  
  1896. function TJvTabBarItem.GetNextVisible: TJvTabBarItem;
  1897. var
  1898.   I: Integer;
  1899. begin
  1900.   for I := Index + 1 to TabBar.Tabs.Count - 1 do
  1901.     if TabBar.Tabs[I].Visible then
  1902.     begin
  1903.       Result := TabBar.Tabs[I];
  1904.       Exit;
  1905.     end;
  1906.   Result := nil;
  1907. end;
  1908.  
  1909. function TJvTabBarItem.GetPreviousVisible: TJvTabBarItem;
  1910. var
  1911.   I: Integer;
  1912. begin
  1913.   for I := Index - 1 downto 0 do
  1914.     if TabBar.Tabs[I].Visible then
  1915.     begin
  1916.       Result := TabBar.Tabs[I];
  1917.       Exit;
  1918.     end;
  1919.   Result := nil;
  1920. end;
  1921.  
  1922. function TJvTabBarItem.AutoDeleteData: TObjectList;
  1923. begin
  1924.   if FAutoDeleteDatas = nil then
  1925.     FAutoDeleteDatas := TObjectList.Create;
  1926.   Result := FAutoDeleteDatas;
  1927. end;
  1928.  
  1929. function TJvTabBarItem.GetClosing: Boolean;
  1930. begin
  1931.   Result := TabBar.ClosingTab = Self;
  1932. end;
  1933.  
  1934. procedure TJvTabBarItem.SetModified(const Value: Boolean);
  1935. begin
  1936.   if Value <> FModified then
  1937.   begin
  1938.     FModified := Value;
  1939.     Changed;
  1940.   end;
  1941. end;
  1942.  
  1943. procedure TJvTabBarItem.SetPopupMenu(const Value: TPopupMenu);
  1944. begin
  1945.   if Value <> FPopupMenu then
  1946.   begin
  1947.     if FPopupMenu <> nil then
  1948.       FPopupMenu.RemoveFreeNotification(TabBar);
  1949.     FPopupMenu := Value;
  1950.     if FPopupMenu <> nil then
  1951.       FPopupMenu.FreeNotification(TabBar);
  1952.   end;
  1953. end;
  1954.  
  1955. procedure TJvTabBarItem.MakeVisible;
  1956. begin
  1957.   TabBar.MakeVisible(Self);
  1958. end;
  1959.  
  1960. function TJvTabBarItem.GetEnabled: Boolean;
  1961. begin
  1962.   Result := FEnabled;
  1963.   if Assigned(FOnGetEnabled) then
  1964.     FOnGetEnabled(Self, Result);
  1965. end;
  1966.  
  1967. function TJvTabBarItem.GetModified: Boolean;
  1968. begin
  1969.   Result := FModified;
  1970.   if Assigned(FOnGetModified) then
  1971.     FOnGetModified(Self, Result);
  1972. end;
  1973.  
  1974. procedure TJvTabBarItem.SetIndex(Value: Integer);
  1975. var
  1976.   PageListIntf: IPageList;
  1977.   LastIndex: Integer;
  1978. begin
  1979.   LastIndex := Index;
  1980.   inherited SetIndex(Value);
  1981.   if TabBar.PageListTabLink and (LastIndex <> Index) and (TabBar.PageList <> nil) and
  1982.      not (csLoading in TabBar.ComponentState) and
  1983.      Supports(TabBar.PageList, IPageList, PageListIntf) then
  1984.     PageListIntf.MovePage(LastIndex, Index);
  1985.   Changed;
  1986. end;
  1987.  
  1988. //=== { TJvTabBarItems } =====================================================
  1989.  
  1990. procedure TJvTabBarItems.EndUpdate;
  1991. begin
  1992.   inherited EndUpdate;
  1993.   if UpdateCount = 0 then
  1994.     TabBar.Changed;
  1995. end;
  1996.  
  1997. function TJvTabBarItems.Find(const AName: string): TJvTabBarItem;
  1998. var
  1999.   I: Integer;
  2000. begin
  2001.   Result := nil;
  2002.   for I := 0 to Count - 1 do
  2003.     if Items[I].Name = AName then
  2004.     begin
  2005.       Result := Items[I];
  2006.       Break;
  2007.     end;
  2008. end;
  2009.  
  2010. function TJvTabBarItems.GetTabBar: TJvCustomTabBar;
  2011. begin
  2012.   Result := GetOwner as TJvCustomTabBar;
  2013. end;
  2014.  
  2015. function TJvTabBarItems.GetItem(Index: Integer): TJvTabBarItem;
  2016. begin
  2017.   Result := TJvTabBarItem(inherited Items[Index]);
  2018. end;
  2019.  
  2020. procedure TJvTabBarItems.SetItem(Index: Integer; const Value: TJvTabBarItem);
  2021. begin
  2022.   if Value <> GetItem(Index) then
  2023.     GetItem(Index).Assign(Value);
  2024. end;
  2025.  
  2026. procedure TJvTabBarItems.Notify(Item: TCollectionItem; Action: TCollectionNotification);
  2027. var
  2028.   PageListIntf: IPageList;
  2029. begin
  2030.   inherited Notify(Item, Action);
  2031.   if Action in [cnExtracting, cnDeleting] then
  2032.   begin
  2033.     // unselect the item to delete
  2034.     if TabBar.SelectedTab = Item then
  2035.       TabBar.SelectedTab := nil;
  2036.     if TabBar.HotTab = Item then
  2037.       TabBar.SetHotTab(nil);
  2038.     if TabBar.FMouseDownClosingTab = Item then
  2039.       TabBar.FMouseDownClosingTab := nil;
  2040.     if TabBar.ClosingTab = Item then
  2041.       TabBar.FClosingTab := nil;
  2042.     if TabBar.FLastInsertTab = Item then
  2043.       TabBar.FLastInsertTab := nil;
  2044.     if not (csDestroying in TabBar.ComponentState) and (TabBar.LeftTab = Item) then
  2045.       TabBar.LeftTab := TabBar.LeftTab.GetPreviousVisible;
  2046.   end;
  2047.   if TabBar.PageListTabLink and (TabBar.PageList <> nil) and
  2048.      not (csLoading in TabBar.ComponentState) and
  2049.      Supports(TabBar.PageList, IPageList, PageListIntf) then
  2050.   begin
  2051.     case Action of
  2052.       cnAdded:
  2053.         PageListIntf.AddPage(TJvTabBarItem(Item).Caption);
  2054.       cnExtracting, cnDeleting:
  2055.         PageListIntf.DeletePage(TJvTabBarItem(Item).Index);
  2056.     end;
  2057.   end;
  2058.   TabBar.Changed;
  2059. end;
  2060.  
  2061. function TJvTabBarItems.IndexOf(Item: TJvTabBarItem): Integer;
  2062. begin
  2063.   for Result := 0 to Count - 1 do
  2064.     if Items[Result] = Item then
  2065.       Exit;
  2066.   Result := -1;
  2067. end;
  2068.  
  2069. //=== { TJvTabBarPainter } ===================================================
  2070.  
  2071. constructor TJvTabBarPainter.Create(AOwner: TComponent);
  2072. begin
  2073.   inherited Create(AOwner);
  2074.   FOnChangeList := TList.Create;
  2075. end;
  2076.  
  2077. destructor TJvTabBarPainter.Destroy;
  2078. begin
  2079.   { _mxn_ }
  2080. //  WriteStyleImages(nil);
  2081.   inherited Destroy; // invokes TJvTabBar.Notification that accesses FOnChangeList
  2082.   FOnChangeList.Free;
  2083. end;
  2084.  
  2085. procedure TJvTabBarPainter.Changed;
  2086. var
  2087.   i: Integer;
  2088. begin
  2089.   for i := 0 to FOnChangeList.Count - 1 do
  2090.     TJvCustomTabBar(FOnChangeList[i]).ImagesChanged(Self);
  2091. end;
  2092.  
  2093. procedure TJvTabBarPainter.GetScrollButtons(TabBar: TJvCustomTabBar; var LeftButton, RightButton: TRect);
  2094. begin
  2095.   { reserved for future use }
  2096. end;
  2097.  
  2098. procedure TJvTabBarPainter.DrawScrollButton(Canvas: TCanvas; TabBar: TJvCustomTabBar; Button: TJvTabBarScrollButtonKind;
  2099.   State: TJvTabBarScrollButtonState; R: TRect);
  2100. {$IFDEF JVCLThemesEnabled}
  2101. const
  2102.   States: array[TJvTabBarScrollButtonState] of Integer = (0, 0, DFCS_HOT, DFCS_PUSHED, DFCS_INACTIVE);
  2103.   ScrollTypes: array[TJvTabBarScrollButtonKind] of Integer = (DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT);
  2104. {$ENDIF JVCLThemesEnabled}
  2105. begin
  2106.   {$IFDEF JVCLThemesEnabled}
  2107.   if ThemeServices.{$IFDEF RTL230_UP}Enabled{$ELSE}ThemesEnabled{$ENDIF RTL230_UP} then
  2108.     DrawThemedFrameControl(Canvas.Handle, R, DFC_SCROLL, ScrollTypes[Button] or States[State])
  2109.   else
  2110.   {$ENDIF JVCLThemesEnabled}
  2111.   begin
  2112.     if TabBar.FlatScrollButtons then
  2113.       DrawButtonFace(Canvas, R, 1, bsNew, False, State = sbsPressed, False)
  2114.     else
  2115.       DrawButtonFace(Canvas, R, 1, bsWin31, False, State = sbsPressed, False);
  2116.     if State = sbsPressed then
  2117.       OffsetRect(R, 1, 1);
  2118.     TabBar.DrawScrollBarGlyph(Canvas,
  2119.       R.Left + (R.Right - R.Left - 4) div 2,
  2120.       R.Top + (R.Bottom - R.Top - 7) div 2,
  2121.       Button = sbScrollLeft, State = sbsDisabled);
  2122.   end;
  2123. end;
  2124.  
  2125. //=== { TJvModernTabBarPainter } =============================================
  2126.  
  2127. constructor TJvModernTabBarPainter.Create(AOwner: TComponent);
  2128. begin
  2129.   inherited Create(AOwner);
  2130.   FFont := TFont.Create;
  2131.   FDisabledFont := TFont.Create;
  2132.   FSelectedFont := TFont.Create;
  2133.  
  2134.   FFont.Color := clWindowText;
  2135.   FDisabledFont.Color := clGrayText;
  2136.   FSelectedFont.Assign(FFont);
  2137.  
  2138.   FFont.OnChange := FontChanged;
  2139.   FDisabledFont.OnChange := FontChanged;
  2140.   FSelectedFont.OnChange := FontChanged;
  2141.  
  2142.   FTabColor := clBtnFace;
  2143.   FColor := clWindow;
  2144.   FBorderColor := clSilver;
  2145.   FControlDivideColor := clBlack;
  2146.  
  2147.   FModifiedCrossColor := clRed;
  2148.   FCloseColorSelected := $F4F4F4;
  2149.   FCloseColor := clWhite;
  2150.   FCloseCrossColorSelected := clBlack;
  2151.   FCloseCrossColor := $5D5D5D;
  2152.   FCloseCrossColorDisabled := $ADADAD;
  2153.   FCloseRectColor := $868686;
  2154.   FCloseRectColorDisabled := $D6D6D6;
  2155.   FDividerColor := $99A8AC;
  2156.   FMoveDividerColor := clBlack;
  2157. end;
  2158.  
  2159. destructor TJvModernTabBarPainter.Destroy;
  2160. begin
  2161.   FFont.Free;
  2162.   FDisabledFont.Free;
  2163.   FSelectedFont.Free;
  2164.   { _mxn_ }
  2165. //  WriteStyleImages(nil);
  2166.   inherited Destroy;
  2167. end;
  2168.  
  2169. { _mxn_ }
  2170. procedure TJvCustomTabBar.WriteStyleImages(const Value: TStrings);
  2171. var tmp:TStrings;
  2172. begin
  2173.   if(FStyleImages<>nil) then begin
  2174.     FreeAndNil(FStyleImages.TOP_background);
  2175.     FreeAndNil(FStyleImages.TOP_active_left_side);
  2176.     FreeAndNil(FStyleImages.TOP_active_right_side);
  2177.     FreeAndNil(FStyleImages.TOP_active_center);
  2178.  
  2179.     FreeAndNil(FStyleImages.BOTTOM_background);
  2180.     FreeAndNil(FStyleImages.BOTTOM_active_left_side);
  2181.     FreeAndNil(FStyleImages.BOTTOM_active_right_side);
  2182.     FreeAndNil(FStyleImages.BOTTOM_active_center);
  2183.  
  2184.     FreeAndNil(FStyleImages.CLOSEBUTTON_normal);
  2185.     FreeAndNil(FStyleImages.CLOSEBUTTON_selected);
  2186.     FreeAndNil(FStyleImages.CLOSEBUTTON_disabled);
  2187.     FreeAndNil(FStyleImages.CLOSEBUTTON_closing);
  2188.     FreeAndNil(FStyleImages.CLOSEBUTTON_modified);
  2189.     FreeAndNil(FStyleImages.CLOSEBUTTON_closing_modified);
  2190.  
  2191.     FreeAndNil(FStyleImages);
  2192.   end;
  2193.  
  2194.   if(StyleImagesArray<>nil) then
  2195.     FreeAndNil(StyleImagesArray);
  2196.  
  2197.   if(Value<>nil) then begin
  2198.  
  2199.     tmp:=TStringList.Create;
  2200.     tmp.Text:=Value.Text;
  2201.     StyleImagesArray:=tmp;
  2202.     FStyleImages:=TStyleImages.Create;
  2203.     with FStyleImages do begin
  2204.       TOP_background:=TPngImage.Create;
  2205.       TOP_background.LoadFromFile(StyleImagesArray.Values['TOP_background']);
  2206.  
  2207.       TOP_active_left_side:=TPngImage.Create;
  2208.       TOP_active_left_side.LoadFromFile(StyleImagesArray.Values['TOP_active_left_side']);
  2209.  
  2210.       TOP_active_right_side:=TPngImage.Create;
  2211.       TOP_active_right_side.LoadFromFile(StyleImagesArray.Values['TOP_active_right_side']);
  2212.  
  2213.       TOP_active_center:=TPngImage.Create;
  2214.       TOP_active_center.LoadFromFile(StyleImagesArray.Values['TOP_active_center']);
  2215.  
  2216.  
  2217.       BOTTOM_background:=TPngImage.Create;
  2218.       BOTTOM_background.LoadFromFile(StyleImagesArray.Values['BOTTOM_background']);
  2219.  
  2220.       BOTTOM_active_left_side:=TPngImage.Create;
  2221.       BOTTOM_active_left_side.LoadFromFile(StyleImagesArray.Values['BOTTOM_active_left_side']);
  2222.  
  2223.       BOTTOM_active_right_side:=TPngImage.Create;
  2224.       BOTTOM_active_right_side.LoadFromFile(StyleImagesArray.Values['BOTTOM_active_right_side']);
  2225.  
  2226.       BOTTOM_active_center:=TPngImage.Create;
  2227.       BOTTOM_active_center.LoadFromFile(StyleImagesArray.Values['BOTTOM_active_center']);
  2228.  
  2229.       CLOSEBUTTON_normal:=TPngImage.Create;
  2230.       CLOSEBUTTON_normal.LoadFromFile(StyleImagesArray.Values['CLOSEBUTTON_normal']);
  2231.  
  2232.       CLOSEBUTTON_selected:=TPngImage.Create;
  2233.       CLOSEBUTTON_selected.LoadFromFile(StyleImagesArray.Values['CLOSEBUTTON_selected']);
  2234.  
  2235.       CLOSEBUTTON_disabled:=TPngImage.Create;
  2236.       CLOSEBUTTON_disabled.LoadFromFile(StyleImagesArray.Values['CLOSEBUTTON_disabled']);
  2237.  
  2238.       CLOSEBUTTON_closing:=TPngImage.Create;
  2239.       CLOSEBUTTON_closing.LoadFromFile(StyleImagesArray.Values['CLOSEBUTTON_closing']);
  2240.  
  2241.       CLOSEBUTTON_modified:=TPngImage.Create;
  2242.       CLOSEBUTTON_modified.LoadFromFile(StyleImagesArray.Values['CLOSEBUTTON_modified']);
  2243.  
  2244.       CLOSEBUTTON_closing_modified:=TPngImage.Create;
  2245.       CLOSEBUTTON_closing_modified.LoadFromFile(StyleImagesArray.Values['CLOSEBUTTON_closing_modified']);
  2246.     end;
  2247.   end;
  2248.   CalcTabsRects;
  2249.   Repaint;
  2250. end;
  2251.  
  2252. procedure TJvModernTabBarPainter.DrawBackground(Canvas: TCanvas; TabBar: TJvCustomTabBar; R: TRect);
  2253. begin
  2254.   with Canvas do
  2255.   begin
  2256.     Brush.Style := bsSolid;
  2257.     Brush.Color := Color;
  2258.     FillRect(R);
  2259.  
  2260.     Brush.Style := bsClear;
  2261.     Pen.Color := BorderColor;
  2262.     Pen.Width := 1;
  2263.     if TabBar.Orientation = toBottom then
  2264.     begin
  2265.       { _mxn_ }
  2266.       if(TabBar.StyleImages<>nil) then begin
  2267.         // Рисуем фон (заливка)
  2268.         StretchDraw(R,TabBar.FStyleImages.BOTTOM_background);
  2269.       end else begin
  2270.         MoveTo(0, R.Bottom - 1);
  2271.         LineTo(0, 0);
  2272.         Pen.Color := ControlDivideColor;
  2273.         LineTo(R.Right - 1, 0);
  2274.         Pen.Color := BorderColor;
  2275.         LineTo(R.Right - 1, R.Bottom - 1);
  2276.         LineTo(0, R.Bottom - 1);
  2277.       end;
  2278.     end
  2279.     else // toTop
  2280.     begin
  2281.       { _mxn_ }
  2282.       if(TabBar.StyleImages<>nil) then begin
  2283.         // Рисуем фон (заливка)
  2284.         StretchDraw(R,TabBar.FStyleImages.TOP_background);
  2285.       end else begin
  2286.         MoveTo(0, R.Bottom - 1);
  2287.         LineTo(0, 0);
  2288.         LineTo(R.Right - 1, 0);
  2289.         LineTo(R.Right - 1, R.Bottom - 1);
  2290.         Pen.Color := ControlDivideColor;
  2291.         LineTo(0, R.Bottom - 1);
  2292.       end;
  2293.     end;
  2294.   end;
  2295. end;
  2296.  
  2297. procedure TJvModernTabBarPainter.DrawDivider(Canvas: TCanvas; LeftTab: TJvTabBarItem; R: TRect);
  2298. begin
  2299.   if not LeftTab.Selected then
  2300.   begin
  2301.     if (LeftTab.TabBar.SelectedTab = nil) or
  2302.       (LeftTab.GetNextVisible <> LeftTab.TabBar.SelectedTab) then
  2303.     begin
  2304.       with Canvas do
  2305.       begin
  2306.         Pen.Color := DividerColor;
  2307.         Pen.Width := 1;
  2308.         MoveTo(R.Right - 1, R.Top + 3);
  2309.         LineTo(R.Right - 1, R.Bottom - 3);
  2310.       end;
  2311.     end;
  2312.   end;
  2313. end;
  2314.  
  2315. procedure TJvModernTabBarPainter.DrawMoveDivider(Canvas: TCanvas; Tab: TJvTabBarItem; MoveLeft: Boolean);
  2316. var
  2317.   R: TRect;
  2318. begin
  2319.   with Canvas do
  2320.   begin
  2321.     R := Tab.DisplayRect;
  2322.     Inc(R.Top, 4);
  2323.     Dec(R.Bottom, 2);
  2324.     if MoveLeft then
  2325.     begin
  2326.       Dec(R.Left);
  2327.       R.Right := R.Left + 4
  2328.     end
  2329.     else
  2330.     begin
  2331.       Dec(R.Right, 1);
  2332.       R.Left := R.Right - 4;
  2333.     end;
  2334.     Brush.Color := MoveDividerColor;
  2335.     FillRect(R);
  2336.   end;
  2337. end;
  2338.  
  2339. procedure TJvModernTabBarPainter.DrawTab(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect);
  2340.   { _mxn_ }
  2341.   procedure DrawWithAlphaBend(const Handle:HDC; YourRect:TRect; Graphic:TGraphic);
  2342.   var
  2343.     bitmap  : TBitmap;
  2344.     bf : BLENDFUNCTION;
  2345.     ret     : Boolean;
  2346.   begin
  2347.       bf.BlendOp:=AC_SRC_OVER;
  2348.       bf.BlendFlags:=0;
  2349.       bf.AlphaFormat:=AC_SRC_ALPHA;
  2350.       bf.SourceConstantAlpha:=$ff; // 255
  2351.  
  2352.     bitmap := TBitmap.Create;
  2353.  
  2354.     try
  2355.       bitmap.Width              := YourRect.Width;
  2356.       bitmap.Height             := YourRect.Height;
  2357.       bitmap.PixelFormat        := pf32bit;
  2358.  
  2359.       bitmap.Assign(Graphic);
  2360.  
  2361.       ret := Windows.AlphaBlend(
  2362.                         Handle,
  2363.                         YourRect.Left,
  2364.                         YourRect.Top,
  2365.                         YourRect.Width,
  2366.                         YourRect.Height,
  2367.                         bitmap.Canvas.Handle,
  2368.                         0,
  2369.                         0,
  2370.                         YourRect.Width,
  2371.                         YourRect.Height,
  2372.                         bf);
  2373.       ASSERT(ret);
  2374.     finally
  2375.       bitmap.Free;
  2376.     end;
  2377.   end;
  2378.  
  2379. var
  2380.   CloseR: TRect;
  2381. begin
  2382.   with Canvas do
  2383.   begin
  2384.     Brush.Style := bsSolid;
  2385.     Brush.Color := Color;
  2386.     Pen.Mode := pmCopy;
  2387.     Pen.Style := psSolid;
  2388.     Pen.Width := 1;
  2389.  
  2390.     if Tab.Selected then
  2391.     begin
  2392.       Brush.Style := bsSolid;
  2393.       Brush.Color := TabColor;
  2394.       { _mxn_ }
  2395.       if(Tab.TabBar.StyleImages=nil) then
  2396.         FillRect(R); // Затираем область, если не картинками рисуем (убивает прозрачность но добавляет линии)
  2397.  
  2398.       Pen.Color := ControlDivideColor;
  2399.       if Tab.TabBar.Orientation = toBottom then
  2400.       begin
  2401.         { _mxn_ }
  2402.         if(Tab.TabBar.StyleImages<>nil) then begin
  2403.           // Рисуем левый бок
  2404. //          DrawWithAlphaBend(Handle,Rect(R.Left,R.Top,R.Left+FStyleImages.BOTTOM_active_left_side.Width,R.Top+FStyleImages.BOTTOM_active_left_side.Height),FStyleImages.BOTTOM_active_left_side);
  2405.           Draw(R.Left,R.Top,Tab.TabBar.FStyleImages.BOTTOM_active_left_side);
  2406.           // Рисуем правый бок
  2407.           Draw(R.Right-Tab.TabBar.FStyleImages.BOTTOM_active_right_side.Width,R.Top,Tab.TabBar.FStyleImages.BOTTOM_active_right_side);
  2408.           // Рисуем центр
  2409.           StretchDraw(
  2410.                       Rect(
  2411.                             R.Left+Tab.TabBar.FStyleImages.BOTTOM_active_left_side.Width,
  2412.                             R.Top,
  2413.                             R.Right-Tab.TabBar.FStyleImages.BOTTOM_active_right_side.Width,
  2414.                             R.Top+Tab.TabBar.FStyleImages.BOTTOM_active_center.Height
  2415.                       ),
  2416.           Tab.TabBar.FStyleImages.BOTTOM_active_center);
  2417.         end else begin
  2418.           MoveTo(R.Left, R.Top);
  2419.           LineTo(R.Left, R.Bottom - 1);
  2420.           LineTo(R.Right - 1, R.Bottom - 1);
  2421.           LineTo(R.Right - 1, R.Top - 1{end});
  2422.         end;
  2423.       end
  2424.       else // toTop
  2425.       begin
  2426.         { _mxn_ }
  2427.         if(Tab.TabBar.StyleImages<>nil) then begin
  2428.           // Рисуем левый бок
  2429. //          DrawWithAlphaBend(Handle,Rect(R.Left,R.Top,R.Left+FStyleImages.TOP_active_left_side.Width,R.Top+FStyleImages.TOP_active_left_side.Height),FStyleImages.TOP_active_left_side);
  2430.           Draw(R.Left,R.Top,Tab.TabBar.FStyleImages.TOP_active_left_side);
  2431.           // Рисуем правый бок
  2432.           Draw(R.Right-Tab.TabBar.FStyleImages.TOP_active_right_side.Width,R.Top,Tab.TabBar.FStyleImages.TOP_active_right_side);
  2433.           // Рисуем центр
  2434.           StretchDraw(
  2435.                       Rect(
  2436.                             R.Left+Tab.TabBar.FStyleImages.TOP_active_left_side.Width,
  2437.                             R.Top,
  2438.                             R.Right-Tab.TabBar.FStyleImages.TOP_active_right_side.Width,
  2439.                             R.Top+Tab.TabBar.FStyleImages.TOP_active_center.Height
  2440.                       ),
  2441.           Tab.TabBar.FStyleImages.TOP_active_center);
  2442.         end else begin
  2443.           MoveTo(R.Left, R.Bottom - 1);
  2444.           LineTo(R.Left, R.Top);
  2445.           LineTo(R.Right - 1, R.Top);
  2446.           LineTo(R.Right - 1, R.Bottom - 1 + 1{end});
  2447.         end;
  2448.       end;
  2449.     end;
  2450.  
  2451.     if Tab.Enabled and not Tab.Selected and Tab.Hot then
  2452.     begin
  2453.       // hot
  2454.       Pen.Color := DividerColor;
  2455.       MoveTo(R.Left, R.Top);
  2456.       LineTo(R.Right - 1 - 1, R.Top);
  2457.     end;
  2458.    
  2459.     if Tab.TabBar.CloseButton then
  2460.     begin
  2461.  
  2462.       if(Tab.TabBar.StyleImages<>nil) then begin // Если указан стиль - то меняем рисование крестика на изображения
  2463.         CloseR := GetCloseRect(Canvas, Tab, R);
  2464.  
  2465.         if Tab.Modified and Tab.Closing then // Modified && Closing
  2466.           StretchDraw(CloseR,Tab.TabBar.FStyleImages.CLOSEBUTTON_closing_modified)
  2467.         else if Tab.Closing then
  2468.           StretchDraw(CloseR,Tab.TabBar.FStyleImages.CLOSEBUTTON_closing)
  2469.         else if not Tab.Enabled then // disabled
  2470.           StretchDraw(CloseR,Tab.TabBar.FStyleImages.CLOSEBUTTON_disabled)
  2471.         else if Tab.Modified then
  2472.           StretchDraw(CloseR,Tab.TabBar.FStyleImages.CLOSEBUTTON_modified)
  2473.         else if Tab.Selected then
  2474.           StretchDraw(CloseR,Tab.TabBar.FStyleImages.CLOSEBUTTON_selected)
  2475.         else
  2476.           StretchDraw(CloseR,Tab.TabBar.FStyleImages.CLOSEBUTTON_normal);
  2477.          
  2478.         { _mxn_ }
  2479.         if not Tab.TabBar.CloseButtonRight then
  2480.           R.Left := CloseR.Right; // Если убить - текст не смещается в право (для переноса кнопки закрытия в лево)
  2481.       end else begin
  2482.         // close button color
  2483.         if Tab.Selected then
  2484.           Brush.Color := CloseColorSelected
  2485.         else
  2486.           Brush.Color := CloseColor;
  2487.  
  2488.         CloseR := GetCloseRect(Canvas, Tab, R);
  2489.         Pen.Color := CloseRectColor;
  2490.         if not Tab.Enabled then
  2491.           Pen.Color := CloseRectColorDisabled;
  2492.  
  2493.         if Tab.Closing then
  2494.           // shrink
  2495.           Rectangle(CloseR.Left + 1, CloseR.Top + 1, CloseR.Right - 1, CloseR.Bottom - 1)
  2496.         else
  2497.           Rectangle(CloseR);
  2498.  
  2499.         if Tab.Modified then
  2500.           Pen.Color := ModifiedCrossColor
  2501.         else
  2502.         if Tab.Selected and not Tab.Closing then
  2503.           Pen.Color := CloseCrossColorSelected
  2504.         else
  2505.         if Tab.Enabled then
  2506.           Pen.Color := CloseCrossColor
  2507.         else
  2508.           Pen.Color := CloseCrossColorDisabled;
  2509.        
  2510.         // close cross
  2511.         MoveTo(CloseR.Left + 3, CloseR.Top + 3);
  2512.         LineTo(CloseR.Right - 3, CloseR.Bottom - 3);
  2513.         MoveTo(CloseR.Left + 4, CloseR.Top + 3);
  2514.         LineTo(CloseR.Right - 4, CloseR.Bottom - 3);
  2515.  
  2516.         MoveTo(CloseR.Right - 4, CloseR.Top + 3);
  2517.         LineTo(CloseR.Left + 2, CloseR.Bottom - 3);
  2518.         MoveTo(CloseR.Right - 5, CloseR.Top + 3);
  2519.         LineTo(CloseR.Left + 3, CloseR.Bottom - 3);
  2520.  
  2521.         // remove intersection
  2522.         if Tab.Modified then
  2523.           FillRect(Rect(CloseR.Left + 5, CloseR.Top + 4, CloseR.Right - 5, CloseR.Bottom - 4));
  2524.         { _mxn_ }
  2525.         if not Tab.TabBar.CloseButtonRight then
  2526.           R.Left := CloseR.Right; // Если убить - текст не смещается в право (для переноса кнопки закрытия в лево)
  2527.       end;
  2528.  
  2529.     end;
  2530.  
  2531.     InflateRect(R, -1, -1);
  2532.  
  2533.     if not Tab.TabBar.CloseButton then
  2534.       Inc(R.Left, 2);
  2535.  
  2536.     if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then
  2537.     begin
  2538.       { _mxn_ }
  2539.       if Tab.TabBar.CloseButtonRight then
  2540.         Tab.GetImages.Draw(Canvas, R.Left +2 +2, R.Top + (R.Bottom - R.Top - Tab.GetImages.Height) div 2,
  2541.           Tab.ImageIndex, Tab.Enabled)
  2542.       else
  2543.         Tab.GetImages.Draw(Canvas, R.Left, R.Top + (R.Bottom - R.Top - Tab.GetImages.Height) div 2,
  2544.           Tab.ImageIndex, Tab.Enabled);
  2545.       Inc(R.Left, Tab.GetImages.Width + 2);
  2546.     end;
  2547.  
  2548.     if Tab.Enabled then
  2549.     begin
  2550.       if Tab.Selected then
  2551.         Font.Assign(Self.SelectedFont)
  2552.       else
  2553.         Font.Assign(Self.Font);
  2554.     end
  2555.     else
  2556.       Font.Assign(Self.DisabledFont);
  2557.  
  2558.     Brush.Style := bsClear;
  2559.     { _mxn_ }
  2560.     if Tab.TabBar.CloseButtonRight then
  2561.       TextRect(R, R.Left + 3 +3, R.Top + 3 -1, Tab.Caption)
  2562.     else
  2563.       TextRect(R, R.Left + 3, R.Top + 3 -1, Tab.Caption)
  2564.   end;
  2565. end;
  2566.  
  2567. function TJvModernTabBarPainter.GetCloseRect(Canvas: TCanvas; Tab: TJvTabBarItem; R: TRect): TRect;
  2568. begin
  2569.   { _mxn_ }
  2570.   if Tab.TabBar.CloseButtonRight then
  2571.     Result.Left := R.Right - 5 - 12 + 1
  2572.   else
  2573.     Result.Left := R.Left + 5;
  2574.  
  2575.   { _mxn_ }
  2576.   if(Tab.TabBar.StyleImages<>nil) then begin // Если указан юзер-стиль то изменяем размер кнопки на 12x12 и сдвигаем ниже
  2577.     Result.Top :=  R.Top + 5 -1; { _mxn_ }
  2578.     Result.Right := Result.Left + 12;
  2579.     Result.Bottom := Result.Top + 11 +1; { _mxn_ }
  2580.   end else begin
  2581.     Result.Top :=  R.Top + 5;
  2582.     Result.Right := Result.Left + 12;
  2583.     Result.Bottom := Result.Top + 11;
  2584.   end;
  2585. end;
  2586.  
  2587. function TJvModernTabBarPainter.GetDividerWidth(Canvas: TCanvas; LeftTab: TJvTabBarItem): Integer;
  2588. begin
  2589.   Result := 1;
  2590. end;
  2591.  
  2592. function TJvModernTabBarPainter.GetTabSize(Canvas: TCanvas; Tab: TJvTabBarItem): TSize;
  2593. begin
  2594.   if Tab.Enabled then
  2595.   begin
  2596.     if Tab.Selected then
  2597.       Canvas.Font.Assign(SelectedFont)
  2598.     else
  2599.       Canvas.Font.Assign(Font)
  2600.   end
  2601.   else
  2602.     Canvas.Font.Assign(DisabledFont);
  2603.  
  2604.   { _mxn_ }
  2605.   if Tab.Caption<>'' then // Добавляем условие если пустой таб - уменьшить размер
  2606.     Result.cx := Canvas.TextWidth(Tab.Caption) + 11// -4
  2607.   else
  2608.     Result.cx := 5;
  2609.   Result.cy := Canvas.TextHeight(Tab.Caption + 'Ag') + 7;
  2610.   if Tab.TabBar.CloseButton then
  2611.     Result.cx := Result.cx + 15;
  2612.   if (Tab.ImageIndex <> -1) and (Tab.GetImages <> nil) then
  2613.     Result.cx := Result.cx + Tab.GetImages.Width + 2;
  2614.  
  2615.   if TabWidth > 0 then
  2616.     Result.cx := TabWidth;
  2617. end;
  2618.  
  2619. function TJvModernTabBarPainter.Options: TJvTabBarPainterOptions;
  2620. begin
  2621.   Result := [poPaintsHotTab];
  2622. end;
  2623.  
  2624. procedure TJvModernTabBarPainter.FontChanged(Sender: TObject);
  2625. begin
  2626.   Changed;
  2627. end;
  2628.  
  2629. procedure TJvModernTabBarPainter.SetBorderColor(const Value: TColor);
  2630. begin
  2631.   if Value <> FBorderColor then
  2632.   begin
  2633.     FBorderColor := Value;
  2634.     Changed;
  2635.   end;
  2636. end;
  2637.  
  2638. procedure TJvModernTabBarPainter.SetColor(const Value: TColor);
  2639. begin
  2640.   if Value <> FColor then
  2641.   begin
  2642.     FColor := Value;
  2643.     Changed;
  2644.   end;
  2645. end;
  2646.  
  2647. procedure TJvModernTabBarPainter.SetControlDivideColor(const Value: TColor);
  2648. begin
  2649.   if Value <> FControlDivideColor then
  2650.   begin
  2651.     FControlDivideColor := Value;
  2652.     Changed;
  2653.   end;
  2654. end;
  2655.  
  2656. procedure TJvModernTabBarPainter.SetModifiedCrossColor(const Value: TColor);
  2657. begin
  2658.   if Value <> FModifiedCrossColor then
  2659.   begin
  2660.     FModifiedCrossColor := Value;
  2661.     Changed;
  2662.   end;
  2663. end;
  2664.  
  2665. procedure TJvModernTabBarPainter.SetTabColor(const Value: TColor);
  2666. begin
  2667.   if Value <> FTabColor then
  2668.   begin
  2669.     FTabColor := Value;
  2670.     Changed;
  2671.   end;
  2672. end;
  2673.  
  2674. procedure TJvModernTabBarPainter.SetCloseColor(const Value: TColor);
  2675. begin
  2676.   if Value <> FCloseColor then
  2677.   begin
  2678.     FCloseColor := Value;
  2679.     Changed;
  2680.   end;
  2681. end;
  2682.  
  2683. procedure TJvModernTabBarPainter.SetCloseColorSelected(const Value: TColor);
  2684. begin
  2685.   if Value <> FCloseColorSelected then
  2686.   begin
  2687.     FCloseColorSelected := Value;
  2688.     Changed;
  2689.   end;
  2690. end;
  2691.  
  2692. procedure TJvModernTabBarPainter.SetCloseCrossColor(const Value: TColor);
  2693. begin
  2694.   if Value <> FCloseCrossColor then
  2695.   begin
  2696.     FCloseCrossColor := Value;
  2697.     Changed;
  2698.   end;
  2699. end;
  2700.  
  2701. procedure TJvModernTabBarPainter.SetCloseCrossColorDisabled(const Value: TColor);
  2702. begin
  2703.   if Value <> FCloseCrossColorDisabled then
  2704.   begin
  2705.     FCloseCrossColorDisabled := Value;
  2706.     Changed;
  2707.   end;
  2708. end;
  2709.  
  2710. procedure TJvModernTabBarPainter.SetCloseCrossColorSelected(const Value: TColor);
  2711. begin
  2712.   if Value <> FCloseCrossColorSelected then
  2713.   begin
  2714.     FCloseCrossColorSelected := Value;
  2715.     Changed;
  2716.   end;
  2717. end;
  2718.  
  2719. procedure TJvModernTabBarPainter.SetCloseRectColor(const Value: TColor);
  2720. begin
  2721.   if Value <> FCloseRectColor then
  2722.   begin
  2723.     FCloseRectColor := Value;
  2724.     Changed;
  2725.   end;
  2726. end;
  2727.  
  2728. procedure TJvModernTabBarPainter.SetCloseRectColorDisabled(const Value: TColor);
  2729. begin
  2730.   if Value <> FCloseRectColorDisabled then
  2731.   begin
  2732.     FCloseRectColorDisabled := Value;
  2733.     Changed;
  2734.   end;
  2735. end;
  2736.  
  2737. procedure TJvModernTabBarPainter.SetDividerColor(const Value: TColor);
  2738. begin
  2739.   if Value <> FDividerColor then
  2740.   begin
  2741.     FDividerColor := Value;
  2742.     Changed;
  2743.   end;
  2744. end;
  2745.  
  2746. procedure TJvModernTabBarPainter.SetTabWidth(Value: Integer);
  2747. begin
  2748.   if Value < 0 then
  2749.     Value := 0;
  2750.   if Value <> FTabWidth then
  2751.   begin
  2752.     FTabWidth := Value;
  2753.     Changed;
  2754.   end;
  2755. end;
  2756.  
  2757. procedure TJvModernTabBarPainter.SetFont(const Value: TFont);
  2758. begin
  2759.   if Value <> FFont then
  2760.     FFont.Assign(Value);
  2761. end;
  2762.  
  2763. procedure TJvModernTabBarPainter.SetDisabledFont(const Value: TFont);
  2764. begin
  2765.   if Value <> FDisabledFont then
  2766.     FDisabledFont.Assign(Value);
  2767. end;
  2768.  
  2769. procedure TJvModernTabBarPainter.SetSelectedFont(const Value: TFont);
  2770. begin
  2771.   if Value <> FSelectedFont then
  2772.     FSelectedFont.Assign(Value);
  2773. end;
  2774.  
  2775. {$IFDEF UNITVERSIONING}
  2776. initialization
  2777.   RegisterUnitVersion(HInstance, UnitVersioning);
  2778.  
  2779. finalization
  2780.   UnregisterUnitVersion(HInstance);
  2781. {$ENDIF UNITVERSIONING}
  2782.  
  2783. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!