1 {
2 ATTabs component for Delphi/Lazarus
3 Copyright (c) Alexey Torgashin (UVviewsoft.com)
4 License: MPL 2.0 or LGPL
5 }
6
7 //{$define tabs_paint_counter}
8
9 unit attabs;
10
11 {$ifdef FPC}
12 {$mode delphi}
13 {$else}
14 {$define windows}
15 {$ifdef VER150} //Delphi 7
16 {$define WIDE}
17 {$endif}
18 {$endif}
19
20 interface
21
22 uses
23 {$ifdef windows}
24 Windows,
25 {$endif}
26 Classes, Types, Graphics,
27 Controls, Messages, ImgList,
28 {$ifdef FPC}
29 InterfaceBase,
30 LCLIntf,
31 LCLType,
32 LCLProc,
33 {$else}
34 System.UITypes,
35 {$endif}
36 ATCanvasPrimitives,
37 ATTabs_Picture,
38 ATFlatControls_Separator,
39 Menus;
40
41 type
42 TATTabString = {$ifdef WIDE} WideString {$else} string {$endif};
43
44 //these global options disable features in all ATTabs objects
45 var
46 ATTabsStretchDrawEnabled: boolean = true;
47 ATTabsCircleDrawEnabled: boolean = true;
48 ATTabsPixelsDrawEnabled: boolean = true;
49 ATTabsAddonSeparator: string = ' • ';
50
51 type
52 TATTabPosition = (
53 atpTop,
54 atpBottom,
55 atpLeft,
56 atpRight
57 );
58
59 type
60
61 { TATTabListCollection }
62
63 TATTabListCollection = class(TCollection)
64 public
65 AOwner: TCustomControl;
66 destructor Destroy; override;
67 procedure Clear;
68 end;
69
70 type
71 { TATTabData }
72
73 TATTabData = class(TCollectionItem)
74 private
75 FTabCaption: TATTabString;
76 FTabCaptionAddon: TATTabString;
77 FTabCaptionRect: TRect;
78 FTabHint: TATTabString;
79 FTabObject: TObject;
80 FTabColor: TColor;
81 FTabColorActive: TColor;
82 FTabColorOver: TColor;
83 FTabModified: boolean;
84 FTabSpecial: boolean;
85 FTabSpecialWidth: integer;
86 FTabSpecialHeight: integer;
87 FTabRect: TRect;
88 FTabRectX: TRect;
89 FTabImageIndex: TImageIndex;
90 FTabPopupMenu: TPopupMenu;
91 FTabFontStyle: TFontStyles;
92 FTabStartsNewLine: boolean;
93 FTabHideXButton: boolean;
94 FTabVisible: boolean;
95 FTabVisibleX: boolean;
96 FTabPinned: boolean;
GetTabCaptionFullnull97 function GetTabCaptionFull: TATTabString;
98 procedure UpdateTabSet;
99 procedure SetTabImageIndex(const Value: TImageIndex);
100 procedure SetTabCaption(const Value: TATTabString);
101 procedure SetTabColor(const Value: TColor);
102 procedure SetTabColorActive(const Value: TColor);
103 procedure SetTabColorOver(const Value: TColor);
104 procedure SetTabHideXButton(const Value: boolean);
105 procedure SetTabVisible(const Value: boolean);
106 public
107 constructor Create(ACollection: TCollection); override;
108 destructor Destroy; override;
109 procedure Clear;
110 property TabCaptionFull: TATTabString read GetTabCaptionFull;
111 property TabCaptionRect: TRect read FTabCaptionRect write FTabCaptionRect;
112 property TabObject: TObject read FTabObject write FTabObject;
113 property TabRect: TRect read FTabRect write FTabRect;
114 property TabRectX: TRect read FTabRectX write FTabRectX;
115 property TabSpecial: boolean read FTabSpecial write FTabSpecial;
116 property TabStartsNewLine: boolean read FTabStartsNewLine write FTabStartsNewLine;
117 property TabVisibleX: boolean read FTabVisibleX write FTabVisibleX;
118 procedure Assign(Source: TPersistent); override;
119 published
120 property TabCaption: TATTabString read FTabCaption write SetTabCaption;
121 property TabCaptionAddon: TATTabString read FTabCaptionAddon write FTabCaptionAddon;
122 property TabHint: TATTabString read FTabHint write FTabHint;
123 property TabColor: TColor read FTabColor write SetTabColor default clNone;
124 property TabColorActive: TColor read FTabColorActive write SetTabColorActive default clNone;
125 property TabColorOver: TColor read FTabColorOver write SetTabColorOver default clNone;
126 property TabModified: boolean read FTabModified write FTabModified default false;
127 property TabImageIndex: TImageIndex read FTabImageIndex write SetTabImageIndex default -1;
128 property TabFontStyle: TFontStyles read FTabFontStyle write FTabFontStyle default [];
129 property TabPopupMenu: TPopupMenu read FTabPopupMenu write FTabPopupMenu;
130 property TabSpecialWidth: integer read FTabSpecialWidth write FTabSpecialWidth default 0;
131 property TabSpecialHeight: integer read FTabSpecialHeight write FTabSpecialHeight default 0;
132 property TabHideXButton: boolean read FTabHideXButton write SetTabHideXButton default false;
133 property TabVisible: boolean read FTabVisible write SetTabVisible default true;
134 property TabPinned: boolean read FTabPinned write FTabPinned default false;
135 end;
136
137 type
138 TATTabElemType = (
139 aeBackground,
140 aeSpacerRect,
141 aeTabActive,
142 aeTabPassive,
143 aeTabPassiveOver,
144 aeTabPlus,
145 aeTabPlusOver,
146 aeTabIconX,
147 aeTabIconXOver,
148 aeArrowDropdown,
149 aeArrowDropdownOver,
150 aeArrowScrollLeft,
151 aeArrowScrollLeftOver,
152 aeArrowScrollRight,
153 aeArrowScrollRightOver,
154 aeButtonPlus,
155 aeButtonPlusOver,
156 aeButtonClose,
157 aeButtonCloseOver,
158 aeButtonUser,
159 aeButtonUserOver
160 );
161
162 type
163 TATTabButton = (
164 atbPlus,
165 atbClose,
166 atbScrollLeft,
167 atbScrollRight,
168 atbDropdownMenu,
169 atbSpace,
170 atbSeparator,
171 atbUser0,
172 atbUser1,
173 atbUser2,
174 atbUser3,
175 atbUser4
176 );
177
178 TATTabButtons = array of record
179 Id: TATTabButton;
180 Size: integer;
181 end;
182
183 type
184 TATTabIconPosition = (
185 aipIconLefterThanText,
186 aipIconRighterThanText,
187 aipIconCentered,
188 aipIconAboveTextCentered,
189 aipIconBelowTextCentered
190 );
191
192 type
193 TATTabActionOnClose = (
194 aocNone,
195 aocDefault,
196 aocRight,
197 aocRecent
198 );
199
200 { TATTabPaintInfo }
201
202 TATTabPaintInfo = record
203 Rect: TRect;
204 Caption: TATTabString;
205 Modified: boolean;
206 Pinned: boolean;
207 TabIndex: integer;
208 ColorFont: TColor;
209 TabActive,
210 TabMouseOver,
211 TabMouseOverX: boolean;
212 FontStyle: TFontStyles;
213 procedure Clear;
214 end;
215
216 type
217 TATTabOverEvent = procedure (Sender: TObject; ATabIndex: integer) of object;
218 TATTabCloseEvent = procedure (Sender: TObject; ATabIndex: integer;
219 var ACanClose, ACanContinue: boolean) of object;
220 TATTabMenuEvent = procedure (Sender: TObject; var ACanShow: boolean) of object;
221 TATTabDrawEvent = procedure (Sender: TObject;
222 AElemType: TATTabElemType; ATabIndex: integer;
223 ACanvas: TCanvas; const ARect: TRect; var ACanDraw: boolean) of object;
224 TATTabMoveEvent = procedure (Sender: TObject; AIndexFrom, AIndexTo: integer) of object;
225 TATTabChangeQueryEvent = procedure (Sender: TObject; ANewTabIndex: integer;
226 var ACanChange: boolean) of object;
227 TATTabClickUserButton = procedure (Sender: TObject; AIndex: integer) of object;
228 TATTabGetTickEvent = function (Sender: TObject; ATabObject: TObject): Int64 of object;
229 TATTabGetCloseActionEvent = procedure (Sender: TObject; var AAction: TATTabActionOnClose) of object;
230 TATTabDblClickEvent = procedure (Sender: TObject; AIndex: integer) of object;
231 TATTabDropQueryEvent = procedure (Sender: TObject; AIndexFrom, AIndexTo: integer; var ACanDrop: boolean) of object;
232
233 type
234 TATTabTriangle = (
235 atriDown,
236 atriLeft,
237 atriRight
238 );
239
240 TATTabShowClose = (
241 atbxShowNone,
242 atbxShowAll,
243 atbxShowActive,
244 atbxShowMouseOver,
245 atbxShowActiveAndMouseOver
246 );
247
248 TATTabMouseWheelMode = (
249 amwIgnoreWheel,
250 amwNormalScroll,
251 amwNormalScrollAndShiftSwitch,
252 amwNormalSwitch,
253 amwNormalSwitchAndShiftScroll
254 );
255
256 TATTabTheme = record
257 FileName_Left: string;
258 FileName_Right: string;
259 FileName_Center: string;
260 FileName_LeftActive: string;
261 FileName_RightActive: string;
262 FileName_CenterActive: string;
263 FileName_X: string;
264 FileName_XActive: string;
265 FileName_Plus: string;
266 FileName_PlusActive: string;
267 FileName_ArrowLeft: string;
268 FileName_ArrowLeftActive: string;
269 FileName_ArrowRight: string;
270 FileName_ArrowRightActive: string;
271 FileName_ArrowDown: string;
272 FileName_ArrowDownActive: string;
273 SpaceBetweenInPercentsOfSide: integer;
274 IndentOfX: integer;
275 end;
276
277 //int constants for GetTabAt
278 const
279 cTabIndexNone = -1; //none tab
280 cTabIndexPlus = -2;
281 cTabIndexPlusBtn = -3;
282 cTabIndexCloseBtn = -4;
283 cTabIndexArrowMenu = -5;
284 cTabIndexArrowScrollLeft = -6;
285 cTabIndexArrowScrollRight = -7;
286 cTabIndexUser0 = -10;
287 cTabIndexUser1 = -11;
288 cTabIndexUser2 = -12;
289 cTabIndexUser3 = -13;
290 cTabIndexUser4 = -14;
291 cTabIndexEmptyArea = -20;
292
293 const
294 _InitTabColorBg = $585858;
295 _InitTabColorTabActive = $808080;
296 _InitTabColorTabPassive = $786868;
297 _InitTabColorTabOver = $A08080;
298 _InitTabColorActiveMark = $C04040;
299 _InitTabColorFont = $D0D0D0;
300 _InitTabColorFontModified = $A00000;
301 _InitTabColorFontActive = clNone;
302 _InitTabColorFontHot = clNone;
303 _InitTabColorBorderActive = $A0A0A0;
304 _InitTabColorBorderPassive = $A07070;
305 _InitTabColorCloseBg = clNone;
306 _InitTabColorCloseBgOver = $6060E0;
307 _InitTabColorCloseBorderOver = _InitTabColorCloseBgOver;
308 _InitTabColorCloseX = clLtGray;
309 _InitTabColorCloseXOver = clWhite;
310 _InitTabColorArrow = $999999;
311 _InitTabColorArrowOver = $E0E0E0;
312 _InitTabColorDropMark = $6060E0;
313 _InitTabColorScrollMark = _InitTabColorDropMark;
314
315 const
316 _InitOptTruncateCaption = acsmMiddle;
317 _InitOptButtonLayout = '<>,v';
318 _InitOptButtonSize = 16;
319 _InitOptButtonSizeSpace = 10;
320 _InitOptButtonSizeSeparator = 5;
321 _InitOptTabHeight = 24;
322 _InitOptTabWidthMinimal = 40;
323 _InitOptTabWidthMaximal = 300;
324 _InitOptTabWidthNormal = 130;
325 _InitOptTabWidthMinimalHidesX = 55;
326 _InitOptTabRounded = true;
327 _InitOptMinimalWidthForSides = 140;
328 _InitOptSpaceSide = 10;
329 _InitOptSpaceInitial = 5;
330 _InitOptSpaceBeforeText = 6;
331 _InitOptSpaceBeforeTextForMinWidth = 30;
332 _InitOptSpaceAfterText = 6;
333 _InitOptSpaceBetweenTabs = 0;
334 _InitOptSpaceBetweenLines = 4;
335 _InitOptSpaceBetweenIconCaption = 0;
336 _InitOptSpaceSeparator = 2;
337 _InitOptSpacer = 4;
338 _InitOptSpacer2 = 10;
339 _InitOptSpaceXRight = 10;
340 _InitOptSpaceXInner = 3;
341 _InitOptSpaceXSize = 12;
342 _InitOptSpaceXIncrementRound = 1;
343 _InitOptArrowSize = 4;
344 _InitOptArrowSpaceLeft = 4;
345 _InitOptColoredBandSize = 4;
346 _InitOptActiveMarkSize = 4;
347 _InitOptScrollMarkSizeX = 20;
348 _InitOptScrollMarkSizeY = 3;
349 _InitOptScrollPagesizePercents = 20;
350 _InitOptDropMarkSize = 6;
351 _InitOptActiveFontStyle = [fsUnderline];
352 _InitOptActiveFontStyleUsed = false;
353 _InitOptHotFontStyle = [fsUnderline];
354 _InitOptHotFontStyleUsed = false;
355
356 _InitOptShowFlat = false;
357 _InitOptShowFlatMouseOver = true;
358 _InitOptShowFlatSep = true;
359 _InitOptPosition = atpTop;
360 _InitOptFillWidth = true;
361 _InitOptFillWidthLastToo = false;
362 _InitOptShowNumberPrefix = '';
363 _InitOptShowScrollMark = true;
364 _InitOptShowDropMark = true;
365 _InitOptShowArrowsNear = true;
366 _InitOptShowXRounded = true;
367 _InitOptShowXButtons = atbxShowAll;
368 _InitOptShowPlusTab = true;
369 _InitOptShowModifiedText = '*';
370 _InitOptShowPinnedText = '!';
371 _InitOptShowEntireColor = false;
372 _InitOptShowActiveMarkInverted = true;
373 _InitRoundedBitmapSize = 60;
374
375 _InitOptMouseWheelMode = amwNormalScrollAndShiftSwitch;
376 _InitOptMouseMiddleClickClose = false;
377 _InitOptMouseDoubleClickClose = false;
378 _InitOptMouseDoubleClickPlus = false;
379 _InitOptMouseDragEnabled = true;
380 _InitOptMouseDragOutEnabled = true;
381 _InitOptMouseDragFromNotATTabs = false;
382
383 type
384 { TATTabs }
385
386 TATTabs = class(TCustomControl)
387 private
388 //drag-drop
389 FMouseDown: boolean;
390 FMouseDownPnt: TPoint;
391 FMouseDownDbl: boolean;
392 FMouseDownButton: TMouseButton;
393 FMouseDownShift: TShiftState;
394 FMouseDownRightBtn: boolean;
395 FMouseDragBegins: boolean;
396
397 //colors
398 FColorBg: TColor; //color of background (visible at top and between tabs)
399 FColorBorderActive: TColor; //color of 1px border of active tab
400 FColorBorderPassive: TColor; //color of 1px border of inactive tabs
401 FColorSeparator: TColor; //vertical lines between tabs in Flat mode
402 FColorTabActive: TColor; //color of active tab
403 FColorTabPassive: TColor; //color of inactive tabs
404 FColorTabOver: TColor; //color of inactive tabs, mouse-over
405 FColorActiveMark: TColor;
406 FColorFont: TColor;
407 FColorFontModified: TColor;
408 FColorFontActive: TColor;
409 FColorFontHot: TColor;
410 FColorCloseBg: TColor; //color of small square with "x" mark, inactive
411 FColorCloseBgOver: TColor; //color of small square with "x" mark, mouse-over
412 FColorCloseBorderOver: TColor; //color of 1px border of "x" mark, mouse-over
413 FColorCloseX: TColor; //color of "x" mark
414 FColorCloseXOver: TColor; //"color of "x" mark, mouseover
415 FColorArrow: TColor; //color of "down" arrow (tab menu), inactive
416 FColorArrowOver: TColor; //color of "down" arrow, mouse-over
417 FColorDropMark: TColor;
418 FColorScrollMark: TColor;
419
420 //opts
421 FButtonsLeft: TATTabButtons;
422 FButtonsRight: TATTabButtons;
423 FOptButtonSize: integer;
424 FOptButtonSizeSpace: integer;
425 FOptButtonSizeSeparator: integer;
426 FOptButtonLayout: string;
427
428 FOptScalePercents: integer;
429 FOptVarWidth: boolean;
430 FOptMultiline: boolean;
431 FOptTruncateCaption: TATCollapseStringMode;
432 FOptFillWidth: boolean;
433 FOptFillWidthLastToo: boolean;
434 FOptTabHeight: integer;
435 FOptTabWidthMinimal: integer; //tab minimal width (used when lot of tabs)
436 FOptTabWidthMaximal: integer;
437 FOptTabWidthNormal: integer; //tab maximal width (used when only few tabs)
438 FOptTabWidthMinimalHidesX: integer; //tab minimal width, after which "x" mark hides for inactive tabs
439 FOptTabRounded: boolean;
440 FOptSpaceBetweenTabs: integer; //space between nearest tabs
441 FOptSpaceBetweenLines: integer;
442 FOptSpaceBetweenIconCaption: integer;
443 FOptSpaceInitial: integer; //space between first tab and left control edge
444 FOptSpaceBeforeText: integer; //space between text and tab left edge
445 FOptSpaceBeforeTextForMinWidth: integer;
446 FOptSpaceAfterText: integer; //space between text and [x] icon righter than text
447 FOptSpaceSeparator: integer;
448 FOptSpacer: integer; //height of top empty space (colored with bg)
449 FOptSpacer2: integer;
450 FOptSpaceXRight: integer; //space from "x" btn to right tab edge
451 FOptSpaceXInner: integer; //space from "x" square edge to "x" mark
452 FOptSpaceXSize: integer; //size of "x" mark
453 FOptSpaceXIncrementRound: integer;
454 FOptColoredBandSize: integer; //height of "misc color" line
455 FOptColoredBandForTop: TATTabPosition;
456 FOptColoredBandForBottom: TATTabPosition;
457 FOptColoredBandForLeft: TATTabPosition;
458 FOptColoredBandForRight: TATTabPosition;
459 FOptActiveMarkSize: integer;
460 FOptArrowSize: integer; //half-size of "arrow" mark
461 FOptDropMarkSize: integer;
462 FOptScrollMarkSizeX: integer;
463 FOptScrollMarkSizeY: integer;
464 FOptScrollPagesizePercents: integer;
465 FOptActiveVisibleOnResize: boolean;
466
467 FOptPosition: TATTabPosition;
468 FOptIconPosition: TATTabIconPosition;
469 FOptWhichActivateOnClose: TATTabActionOnClose;
470 FOptCaptionAlignment: TAlignment;
471 FOptShowFlat: boolean;
472 FOptShowFlatMouseOver: boolean;
473 FOptShowFlatSepar: boolean;
474 FOptShowXRounded: boolean;
475 FOptShowXButtons: TATTabShowClose; //show mode for "x" buttons
476 FOptShowArrowsNear: boolean;
477 FOptShowPlusTab: boolean; //show "plus" tab
478 FOptShowModifiedText: TATTabString;
479 FOptShowPinnedText: TATTabString;
480 FOptShowEntireColor: boolean;
481 FOptShowNumberPrefix: TATTabString;
482 FOptShowScrollMark: boolean;
483 FOptShowDropMark: boolean;
484 FOptShowActiveMarkInverted: boolean;
485 FOptActiveFontStyle: TFontStyles;
486 FOptActiveFontStyleUsed: boolean;
487 FOptHotFontStyle: TFontStyles;
488 FOptHotFontStyleUsed: boolean;
489
490 FOptMouseWheelMode: TATTabMouseWheelMode;
491 FOptMouseMiddleClickClose: boolean; //enable close tab by middle-click
492 FOptMouseDoubleClickClose: boolean;
493 FOptMouseDoubleClickPlus: boolean; //enable call "+" tab with dbl-click on empty area
494 FOptMouseDragEnabled: boolean; //enable drag-drop
495 FOptMouseDragOutEnabled: boolean; //also enable drag-drop to another controls
496 FOptMouseDragFromNotATTabs: boolean;
497
498 //others
499 FTabWidth: integer;
500 FTabIndex: integer;
501 FTabIndexLoaded: integer;
502 FTabIndexOver: integer;
503 FTabIndexDrop: integer;
504 FTabIndexHinted: integer;
505 FTabIndexHintedPrev: integer;
506 FTabList: TATTabListCollection;
507 FTabMenu: TPopupMenu;
508 FMultilineActive: boolean;
509
510 FRealIndentLeft: integer;
511 FRealIndentRight: integer;
512 FOptFontScale: integer;
513 FOptMinimalWidthForSides: integer;
514 FOptSpaceSide: integer;
515 FPaintCount: integer;
516 FLastOverIndex: integer;
517 FLastOverX: boolean;
518 FLastSpaceSide: integer;
519 FActualMultiline: boolean;
520 FTabsChanged: boolean;
521 FTabsResized: boolean;
522 FScrollingNeeded: boolean;
523
524 FScrollPos: integer;
525 FImages: TImageList;
526 FBitmap: TBitmap;
527 FBitmapAngleL: TBitmap;
528 FBitmapAngleR: TBitmap;
529 FBitmapRound: TBitmap;
530
531 FRectTabLast_Scrolled: TRect;
532 FRectTabLast_NotScrolled: TRect;
533 FRectTabPlus_Scrolled: TRect; //uses scroll pos
534 FRectTabPlus_NotScrolled: TRect; //ignores scroll pos, not real
535 FRectArrowDown: TRect;
536 FRectArrowLeft: TRect;
537 FRectArrowRight: TRect;
538 FRectButtonPlus: TRect;
539 FRectButtonClose: TRect;
540 FRectButtonUser0: TRect;
541 FRectButtonUser1: TRect;
542 FRectButtonUser2: TRect;
543 FRectButtonUser3: TRect;
544 FRectButtonUser4: TRect;
545
546 FHintForX: string;
547 FHintForPlus: string;
548 FHintForArrowLeft: string;
549 FHintForArrowRight: string;
550 FHintForArrowMenu: string;
551 FHintForUser0: string;
552 FHintForUser1: string;
553 FHintForUser2: string;
554 FHintForUser3: string;
555 FHintForUser4: string;
556
557 FThemed: boolean;
558 FPic_Side_L: TATTabsPicture;
559 FPic_Side_L_a: TATTabsPicture;
560 FPic_Side_R: TATTabsPicture;
561 FPic_Side_R_a: TATTabsPicture;
562 FPic_Side_C: TATTabsPicture;
563 FPic_Side_C_a: TATTabsPicture;
564 FPic_X: TATTabsPicture;
565 FPic_X_a: TATTabsPicture;
566 FPic_Plus: TATTabsPicture;
567 FPic_Plus_a: TATTabsPicture;
568 FPic_Arrow_L: TATTabsPicture;
569 FPic_Arrow_L_a: TATTabsPicture;
570 FPic_Arrow_R: TATTabsPicture;
571 FPic_Arrow_R_a: TATTabsPicture;
572 FPic_Arrow_D: TATTabsPicture;
573 FPic_Arrow_D_a: TATTabsPicture;
574
575 //events
576 FOnTabClick: TNotifyEvent;
577 FOnTabChanged: TNotifyEvent; // aducom
578 FOnTabPlusClick: TNotifyEvent;
579 FOnTabClickUserButton: TATTabClickUserButton;
580 FOnTabClose: TATTabCloseEvent;
581 FOnTabMenu: TATTabMenuEvent;
582 FOnTabDrawBefore: TATTabDrawEvent;
583 FOnTabDrawAfter: TATTabDrawEvent;
584 FOnTabEmpty: TNotifyEvent;
585 FOnTabOver: TATTabOverEvent;
586 FOnTabMove: TATTabMoveEvent;
587 FOnTabChangeQuery: TATTabChangeQueryEvent;
588 FOnTabGetTick: TATTabGetTickEvent;
589 FOnTabGetCloseAction: TATTabGetCloseActionEvent;
590 FOnTabDblClick: TATTabDblClickEvent;
591 FOnTabDropQuery: TATTabDropQueryEvent;
592
ConvertButtonIdToTabIndexnull593 function ConvertButtonIdToTabIndex(Id: TATTabButton): integer; inline;
594 procedure DoClickUser(AIndex: integer);
595 procedure DoHandleClick;
596 procedure DoHandleRightClick;
597 procedure DoPaintArrowDown(C: TCanvas);
598 procedure DoPaintArrowLeft(C: TCanvas);
599 procedure DoPaintArrowRight(C: TCanvas);
600 procedure DoPaintButtonClose(C: TCanvas);
601 procedure DoPaintButtonPlus(C: TCanvas);
602 procedure DoPaintButtonsBG(C: TCanvas);
603 procedure DoPaintColoredBand(C: TCanvas; const ARect: TRect; AColor: TColor;
604 APos: TATTabPosition);
605 procedure DoPaintPlus(C: TCanvas; const ARect: TRect);
606 procedure DoPaintSeparator(C: TCanvas; const R: TRect);
607 procedure DoPaintSpaceInital(C: TCanvas); inline;
608 procedure DoPaintSpacerRect(C: TCanvas);
609 procedure DoPaintTabShape(C: TCanvas; const ATabRect: TRect;
610 ATabActive: boolean; ATabIndex: integer);
611 procedure DoPaintTabShape_C(C: TCanvas; ATabActive: boolean;
612 ATabIndex: integer; const ARect: TRect; const PL1, PL2, PR1, PR2: TPoint);
613 procedure DoPaintTabShape_L(C: TCanvas; const ARect: TRect;
614 ATabActive: boolean; ATabIndex: integer);
615 procedure DoPaintTabShape_R(C: TCanvas; const ARect: TRect;
616 ATabActive: boolean; ATabIndex: integer);
617 procedure DoPaintTo(C: TCanvas);
618 procedure DoTextOut(C: TCanvas; AX, AY: integer; const AClipRect: TRect; const AText: string); inline;
619 procedure DoPaintBgTo(C: TCanvas; const ARect: TRect);
620 procedure DoPaintTabTo(C: TCanvas; const AInfo: TATTabPaintInfo);
621 procedure DoPaintX(C: TCanvas; const AInfo: TATTabPaintInfo);
622 procedure DoPaintXTo(C: TCanvas; const AInfo: TATTabPaintInfo);
623 procedure DoPaintArrowTo(C: TCanvas; ATyp: TATTabTriangle; ARect: TRect; AActive, AEnabled: boolean);
624 procedure DoPaintUserButtons(C: TCanvas; const AButtons: TATTabButtons; AtLeft: boolean);
625 procedure DoPaintDropMark(C: TCanvas);
626 procedure DoPaintScrollMark(C: TCanvas);
627 procedure GetTabFirstCoord(var R: TRect);
GetTabCaptionFinalnull628 function GetTabCaptionFinal(AData: TATTabData; ATabIndex: integer): TATTabString;
GetButtonsEdgeCoordnull629 function GetButtonsEdgeCoord(AtLeft: boolean): integer;
GetButtonsWidthnull630 function GetButtonsWidth(const B: TATTabButtons): integer;
GetPositionInvertednull631 function GetPositionInverted(APos: TATTabPosition): TATTabPosition; inline;
GetIndexOfButtonnull632 function GetIndexOfButton(const AButtons: TATTabButtons; ABtn: TATTabButton): integer;
GetInitialVerticalIndentnull633 function GetInitialVerticalIndent: integer; inline;
GetButtonsEmptynull634 function GetButtonsEmpty: boolean; inline;
GetTabBgColor_Passivenull635 function GetTabBgColor_Passive(AIndex: integer): TColor;
GetTabBgColor_Activenull636 function GetTabBgColor_Active(AIndex: integer): TColor;
GetTabFlatEffectivenull637 function GetTabFlatEffective(AIndex: integer): boolean; inline;
638 procedure GetTabXColors(AIndex: integer; AMouseOverX: boolean; out AColorXBg,
639 AColorXBorder, AColorXMark: TColor);
GetScrollMarkNeedednull640 function GetScrollMarkNeeded: boolean;
GetMaxEdgePosnull641 function GetMaxEdgePos: integer;
GetRectOfButtonnull642 function GetRectOfButton(AButton: TATTabButton): TRect;
GetRectOfButtonIndexnull643 function GetRectOfButtonIndex(AIndex: integer; AtLeft: boolean): TRect;
GetScrollPageSizenull644 function GetScrollPageSize: integer;
645 procedure SetOptButtonLayout(const AValue: string);
646 procedure SetOptScalePercents(AValue: integer);
647 procedure SetOptVarWidth(AValue: boolean);
648 procedure SetScrollPos(AValue: integer);
649 procedure SetTabIndexEx(AIndex: integer; ADisableEvent: boolean);
650 procedure SetTabIndex(AIndex: integer);
651 procedure GetTabXProps(AIndex: integer; const ARect: TRect; out
652 AMouseOverX: boolean; out ARectX: TRect);
IsIndexOknull653 function IsIndexOk(AIndex: integer): boolean; inline;
GetTabVisibleXnull654 function GetTabVisibleX(AIndex: integer; const D: TATTabData): boolean;
IsPaintNeedednull655 function IsPaintNeeded(AElemType: TATTabElemType;
656 AIndex: integer; ACanvas: TCanvas; const ARect: TRect): boolean;
DoPaintAfternull657 function DoPaintAfter(AElemType: TATTabElemType;
658 AIndex: integer; ACanvas: TCanvas; const ARect: TRect): boolean;
659 procedure TabMenuClick(Sender: TObject);
GetTabWidth_Plus_Rawnull660 function GetTabWidth_Plus_Raw: integer; inline;
661 procedure UpdateTabWidths;
662 procedure UpdateTabRects(C: TCanvas);
663 procedure UpdateTabRectsSpecial;
664 procedure UpdateTabPropsX;
665 procedure UpdateTabRectsToFillLine(AIndexFrom, AIndexTo: integer; ALastLine: boolean);
666 procedure UpdateCanvasAntialiasMode(C: TCanvas); inline;
667 procedure UpdateCaptionProps(C: TCanvas; const ACaption: TATTabString;
668 out ALineHeight: integer; out ATextSize: TSize);
669 procedure DoTabDrop;
GetTabTicknull670 function GetTabTick(AIndex: integer): Int64;
_IsDragnull671 function _IsDrag: boolean; inline;
672 procedure SetOptShowPlusTab(const Value: boolean);
673
674 public
675 TabMenuExternal: TPopupMenu;
676
677 constructor Create(AOwner: TComponent); override;
CanFocusnull678 function CanFocus: boolean; override;
679 destructor Destroy; override;
680 procedure DragDrop(Source: TObject; X, Y: integer); override;
681
682 procedure ApplyButtonLayout;
GetTabRectWidthnull683 function GetTabRectWidth(APlusBtn: boolean): integer;
684 procedure UpdateRectPlus(var R: TRect);
GetTabRect_Xnull685 function GetTabRect_X(const ARect: TRect): TRect;
GetRectScrollednull686 function GetRectScrolled(const R: TRect): TRect;
GetTabAtnull687 function GetTabAt(AX, AY: integer; out APressedX: boolean): integer;
GetTabDatanull688 function GetTabData(AIndex: integer): TATTabData;
GetTabLastVisibleIndexnull689 function GetTabLastVisibleIndex: integer;
TabCountnull690 function TabCount: integer;
AddTabnull691 function AddTab(
692 AIndex: integer;
693 const ACaption: TATTabString;
694 AObject: TObject = nil;
695 AModified: boolean = false;
696 AColor: TColor = clNone;
697 AImageIndex: TImageIndex = -1): TATTabData; overload;
698 procedure AddTab(AIndex: integer; AData: TATTabData); overload;
699 procedure Clear;
DeleteTabnull700 function DeleteTab(AIndex: integer; AAllowEvent, AWithCancelBtn: boolean;
701 AAction: TATTabActionOnClose=aocDefault): boolean;
HideTabnull702 function HideTab(AIndex: integer): boolean;
ShowTabnull703 function ShowTab(AIndex: integer): boolean;
704 procedure MakeVisible(AIndex: integer);
IsTabVisiblenull705 function IsTabVisible(AIndex: integer): boolean;
706 procedure ShowTabMenu;
707 procedure SwitchTab(ANext: boolean; ALoopAtEdge: boolean= true);
708 procedure MoveTab(AFrom, ATo: integer; AActivateThen: boolean);
FindTabByObjectnull709 function FindTabByObject(AObject: TObject): integer;
710 procedure DoScrollLeft;
711 procedure DoScrollRight;
GetMaxScrollPosnull712 function GetMaxScrollPos: integer;
713 property ScrollPos: integer read FScrollPos write SetScrollPos;
714 procedure SetTheme(const Data: TATTabTheme);
715 property IsThemed: boolean read FThemed write FThemed;
DoScalenull716 function DoScale(AValue: integer): integer;
DoScaleFontnull717 function DoScaleFont(AValue: integer): integer;
718 procedure DoTabDropToOtherControl(ATarget: TControl; const APnt: TPoint);
719
720 protected
721 procedure Paint; override;
722 procedure Resize; override;
723 procedure DblClick; override;
724 procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
725 procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer); override;
726 procedure MouseMove(Shift: TShiftState; X, Y: integer); override;
DoMouseWheelnull727 function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
728 procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
729 {$ifdef windows}
730 procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
731 {$endif}
732 procedure DragOver(Source: TObject; X, Y: integer; State: TDragState; var Accept: Boolean); override;
733 procedure Loaded; override;
734 procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
735
736 published
737 //inherited
738 property Align;
739 property Anchors;
740 {$ifdef fpc}
741 property BorderSpacing;
742 {$endif}
743 property Constraints;
744 property DragCursor;
745 property DragKind;
746 property DragMode;
747 property Enabled;
748 property Font;
749 property ParentColor;
750 property ParentFont;
751 property ParentShowHint;
752 property PopupMenu;
753 property ShowHint;
754 property Visible;
755 //property Tabs: TCollection read FTabList write FTabList;
756 property Tabs: TATTabListCollection read FTabList write FTabList;
757
758 property OnClick;
759 property OnDblClick;
760 property OnDragDrop;
761 property OnDragOver;
762 property OnEndDrag;
763 property OnContextPopup;
764 //these 2 lines don't compile under Delphi 7
765 {$ifndef VER150}
766 property OnMouseEnter;
767 property OnMouseLeave;
768 {$endif}
769 //
770 property OnMouseMove;
771 property OnMouseDown;
772 property OnMouseUp;
773 property OnMouseWheel;
774 property OnMouseWheelDown;
775 property OnMouseWheelUp;
776 property OnResize;
777 property OnStartDrag;
778
779 //new
780 property DoubleBuffered;
781 property Images: TImageList read FImages write FImages;
782 property TabIndex: integer read FTabIndex write SetTabIndex default 0;
783
784 //colors
785 property ColorBg: TColor read FColorBg write FColorBg default _InitTabColorBg;
786 property ColorBorderActive: TColor read FColorBorderActive write FColorBorderActive default _InitTabColorBorderActive;
787 property ColorBorderPassive: TColor read FColorBorderPassive write FColorBorderPassive default _InitTabColorBorderPassive;
788 property ColorSeparator: TColor read FColorSeparator write FColorSeparator default _InitTabColorArrow;
789 property ColorTabActive: TColor read FColorTabActive write FColorTabActive default _InitTabColorTabActive;
790 property ColorTabPassive: TColor read FColorTabPassive write FColorTabPassive default _InitTabColorTabPassive;
791 property ColorTabOver: TColor read FColorTabOver write FColorTabOver default _InitTabColorTabOver;
792 property ColorActiveMark: TColor read FColorActiveMark write FColorActiveMark default _InitTabColorActiveMark;
793 property ColorFont: TColor read FColorFont write FColorFont default _InitTabColorFont;
794 property ColorFontModified: TColor read FColorFontModified write FColorFontModified default _InitTabColorFontModified;
795 property ColorFontActive: TColor read FColorFontActive write FColorFontActive default _InitTabColorFontActive;
796 property ColorFontHot: TColor read FColorFontHot write FColorFontHot default _InitTabColorFontHot;
797 property ColorCloseBg: TColor read FColorCloseBg write FColorCloseBg default _InitTabColorCloseBg;
798 property ColorCloseBgOver: TColor read FColorCloseBgOver write FColorCloseBgOver default _InitTabColorCloseBgOver;
799 property ColorCloseBorderOver: TColor read FColorCloseBorderOver write FColorCloseBorderOver default _InitTabColorCloseBorderOver;
800 property ColorCloseX: TColor read FColorCloseX write FColorCloseX default _InitTabColorCloseX;
801 property ColorCloseXOver: TColor read FColorCloseXOver write FColorCloseXOver default _InitTabColorCloseXOver;
802 property ColorArrow: TColor read FColorArrow write FColorArrow default _InitTabColorArrow;
803 property ColorArrowOver: TColor read FColorArrowOver write FColorArrowOver default _InitTabColorArrowOver;
804 property ColorDropMark: TColor read FColorDropMark write FColorDropMark default _InitTabColorDropMark;
805 property ColorScrollMark: TColor read FColorScrollMark write FColorScrollMark default _InitTabColorScrollMark;
806
807 //options
808 property OptButtonLayout: string read FOptButtonLayout write SetOptButtonLayout;
809 property OptButtonSize: integer read FOptButtonSize write FOptButtonSize default _InitOptButtonSize;
810 property OptButtonSizeSpace: integer read FOptButtonSizeSpace write FOptButtonSizeSpace default _InitOptButtonSizeSpace;
811 property OptButtonSizeSeparator: integer read FOptButtonSizeSeparator write FOptButtonSizeSeparator default _InitOptButtonSizeSeparator;
812 property OptScalePercents: integer read FOptScalePercents write SetOptScalePercents default 100;
813 property OptVarWidth: boolean read FOptVarWidth write SetOptVarWidth default false;
814 property OptMultiline: boolean read FOptMultiline write FOptMultiline default false;
815 property OptFillWidth: boolean read FOptFillWidth write FOptFillWidth default _InitOptFillWidth;
816 property OptFillWidthLastToo: boolean read FOptFillWidthLastToo write FOptFillWidthLastToo default _InitOptFillWidthLastToo;
817 property OptTruncateCaption: TATCollapseStringMode read FOptTruncateCaption write FOptTruncateCaption default _InitOptTruncateCaption;
818 property OptTabHeight: integer read FOptTabHeight write FOptTabHeight default _InitOptTabHeight;
819 property OptTabWidthNormal: integer read FOptTabWidthNormal write FOptTabWidthNormal default _InitOptTabWidthNormal;
820 property OptTabWidthMinimal: integer read FOptTabWidthMinimal write FOptTabWidthMinimal default _InitOptTabWidthMinimal;
821 property OptTabWidthMaximal: integer read FOptTabWidthMaximal write FOptTabWidthMaximal default _InitOptTabWidthMaximal;
822 property OptTabWidthMinimalHidesX: integer read FOptTabWidthMinimalHidesX write FOptTabWidthMinimalHidesX default _InitOptTabWidthMinimalHidesX;
823 property OptTabRounded: boolean read FOptTabRounded write FOptTabRounded default _InitOptTabRounded;
824 property OptFontScale: integer read FOptFontScale write FOptFontScale default 100;
825 property OptMinimalWidthForSides: integer read FOptMinimalWidthForSides write FOptMinimalWidthForSides default _InitOptMinimalWidthForSides;
826 property OptSpaceSide: integer read FOptSpaceSide write FOptSpaceSide default _InitOptSpaceSide;
827 property OptSpaceBetweenTabs: integer read FOptSpaceBetweenTabs write FOptSpaceBetweenTabs default _InitOptSpaceBetweenTabs;
828 property OptSpaceBetweenLines: integer read FOptSpaceBetweenLines write FOptSpaceBetweenLines default _InitOptSpaceBetweenLines;
829 property OptSpaceBetweenIconCaption: integer read FOptSpaceBetweenIconCaption write FOptSpaceBetweenIconCaption default _InitOptSpaceBetweenIconCaption;
830 property OptSpaceInitial: integer read FOptSpaceInitial write FOptSpaceInitial default _InitOptSpaceInitial;
831 property OptSpaceBeforeText: integer read FOptSpaceBeforeText write FOptSpaceBeforeText default _InitOptSpaceBeforeText;
832 property OptSpaceBeforeTextForMinWidth: integer read FOptSpaceBeforeTextForMinWidth write FOptSpaceBeforeTextForMinWidth default _InitOptSpaceBeforeTextForMinWidth;
833 property OptSpaceAfterText: integer read FOptSpaceAfterText write FOptSpaceAfterText default _InitOptSpaceAfterText;
834 property OptSpaceSeparator: integer read FOptSpaceSeparator write FOptSpaceSeparator default _InitOptSpaceSeparator;
835 property OptSpacer: integer read FOptSpacer write FOptSpacer default _InitOptSpacer;
836 property OptSpacer2: integer read FOptSpacer2 write FOptSpacer2 default _InitOptSpacer2;
837 property OptSpaceXRight: integer read FOptSpaceXRight write FOptSpaceXRight default _InitOptSpaceXRight;
838 property OptSpaceXInner: integer read FOptSpaceXInner write FOptSpaceXInner default _InitOptSpaceXInner;
839 property OptSpaceXSize: integer read FOptSpaceXSize write FOptSpaceXSize default _InitOptSpaceXSize;
840 property OptSpaceXIncrementRound: integer read FOptSpaceXIncrementRound write FOptSpaceXIncrementRound default _InitOptSpaceXIncrementRound;
841 property OptColoredBandSize: integer read FOptColoredBandSize write FOptColoredBandSize default _InitOptColoredBandSize;
842 property OptColoredBandForTop: TATTabPosition read FOptColoredBandForTop write FOptColoredBandForTop default atpTop;
843 property OptColoredBandForBottom: TATTabPosition read FOptColoredBandForBottom write FOptColoredBandForBottom default atpBottom;
844 property OptColoredBandForLeft: TATTabPosition read FOptColoredBandForLeft write FOptColoredBandForLeft default atpLeft;
845 property OptColoredBandForRight: TATTabPosition read FOptColoredBandForRight write FOptColoredBandForRight default atpRight;
846 property OptActiveMarkSize: integer read FOptActiveMarkSize write FOptActiveMarkSize default _InitOptActiveMarkSize;
847 property OptArrowSize: integer read FOptArrowSize write FOptArrowSize default _InitOptArrowSize;
848 property OptScrollMarkSizeX: integer read FOptScrollMarkSizeX write FOptScrollMarkSizeX default _InitOptScrollMarkSizeX;
849 property OptScrollMarkSizeY: integer read FOptScrollMarkSizeY write FOptScrollMarkSizeY default _InitOptScrollMarkSizeY;
850 property OptScrollPagesizePercents: integer read FOptScrollPagesizePercents write FOptScrollPagesizePercents default _InitOptScrollPagesizePercents;
851 property OptDropMarkSize: integer read FOptDropMarkSize write FOptDropMarkSize default _InitOptDropMarkSize;
852 property OptActiveVisibleOnResize: boolean read FOptActiveVisibleOnResize write FOptActiveVisibleOnResize default true;
853
854 property OptPosition: TATTabPosition read FOptPosition write FOptPosition default _InitOptPosition;
855 property OptIconPosition: TATTabIconPosition read FOptIconPosition write FOptIconPosition default aipIconLefterThanText;
856 property OptWhichActivateOnClose: TATTabActionOnClose read FOptWhichActivateOnClose write FOptWhichActivateOnClose default aocRight;
857 property OptCaptionAlignment: TAlignment read FOptCaptionAlignment write FOptCaptionAlignment default taLeftJustify;
858 property OptShowFlat: boolean read FOptShowFlat write FOptShowFlat default _InitOptShowFlat;
859 property OptShowFlatMouseOver: boolean read FOptShowFlatMouseOver write FOptShowFlatMouseOver default _InitOptShowFlatMouseOver;
860 property OptShowFlatSepar: boolean read FOptShowFlatSepar write FOptShowFlatSepar default _InitOptShowFlatSep;
861 property OptShowScrollMark: boolean read FOptShowScrollMark write FOptShowScrollMark default _InitOptShowScrollMark;
862 property OptShowDropMark: boolean read FOptShowDropMark write FOptShowDropMark default _InitOptShowDropMark;
863 property OptShowXRounded: boolean read FOptShowXRounded write FOptShowXRounded default _InitOptShowXRounded;
864 property OptShowXButtons: TATTabShowClose read FOptShowXButtons write FOptShowXButtons default _InitOptShowXButtons;
865 property OptShowPlusTab: boolean read FOptShowPlusTab write SetOptShowPlusTab default _InitOptShowPlusTab;
866 property OptShowArrowsNear: boolean read FOptShowArrowsNear write FOptShowArrowsNear default _InitOptShowArrowsNear;
867 property OptShowModifiedText: TATTabString read FOptShowModifiedText write FOptShowModifiedText;
868 property OptShowPinnedText: TATTabString read FOptShowPinnedText write FOptShowPinnedText;
869 property OptShowEntireColor: boolean read FOptShowEntireColor write FOptShowEntireColor default _InitOptShowEntireColor;
870 property OptShowNumberPrefix: TATTabString read FOptShowNumberPrefix write FOptShowNumberPrefix;
871 property OptShowActiveMarkInverted: boolean read FOptShowActiveMarkInverted write FOptShowActiveMarkInverted default _InitOptShowActiveMarkInverted;
872 property OptActiveFontStyle: TFontStyles read FOptActiveFontStyle write FOptActiveFontStyle default _InitOptActiveFontStyle;
873 property OptActiveFontStyleUsed: boolean read FOptActiveFontStyleUsed write FOptActiveFontStyleUsed default _InitOptActiveFontStyleUsed;
874 property OptHotFontStyle: TFontStyles read FOptHotFontStyle write FOptHotFontStyle default _InitOptHotFontStyle;
875 property OptHotFontStyleUsed: boolean read FOptHotFontStyleUsed write FOptHotFontStyleUsed default _InitOptHotFontStyleUsed;
876
877 property OptMouseWheelMode: TATTabMouseWheelMode read FOptMouseWheelMode write FOptMouseWheelMode default _InitOptMouseWheelMode;
878 property OptMouseMiddleClickClose: boolean read FOptMouseMiddleClickClose write FOptMouseMiddleClickClose default _InitOptMouseMiddleClickClose;
879 property OptMouseDoubleClickClose: boolean read FOptMouseDoubleClickClose write FOptMouseDoubleClickClose default _InitOptMouseDoubleClickClose;
880 property OptMouseDoubleClickPlus: boolean read FOptMouseDoubleClickPlus write FOptMouseDoubleClickPlus default _InitOptMouseDoubleClickPlus;
881 property OptMouseDragEnabled: boolean read FOptMouseDragEnabled write FOptMouseDragEnabled default _InitOptMouseDragEnabled;
882 property OptMouseDragOutEnabled: boolean read FOptMouseDragOutEnabled write FOptMouseDragOutEnabled default _InitOptMouseDragOutEnabled;
883 property OptMouseDragFromNotATTabs: boolean read FOptMouseDragFromNotATTabs write FOptMouseDragFromNotATTabs default _InitOptMouseDragFromNotATTabs;
884
885 property OptHintForX: string read FHintForX write FHintForX;
886 property OptHintForPlus: string read FHintForPlus write FHintForPlus;
887 property OptHintForArrowLeft: string read FHintForArrowLeft write FHintForArrowLeft;
888 property OptHintForArrowRight: string read FHintForArrowRight write FHintForArrowRight;
889 property OptHintForArrowMenu: string read FHintForArrowMenu write FHintForArrowMenu;
890 property OptHintForUser0: string read FHintForUser0 write FHintForUser0;
891 property OptHintForUser1: string read FHintForUser1 write FHintForUser1;
892 property OptHintForUser2: string read FHintForUser2 write FHintForUser2;
893 property OptHintForUser3: string read FHintForUser3 write FHintForUser3;
894 property OptHintForUser4: string read FHintForUser4 write FHintForUser4;
895
896 //events
897 property OnTabClick: TNotifyEvent read FOnTabClick write FOnTabClick;
898 property OnTabChanged: TNotifyEvent read FOnTabChanged write FOnTabChanged; // aducom
899 property OnTabPlusClick: TNotifyEvent read FOnTabPlusClick write FOnTabPlusClick;
900 property OnTabClickUserButton: TATTabClickUserButton read FOnTabClickUserButton write FOnTabClickUserButton;
901 property OnTabClose: TATTabCloseEvent read FOnTabClose write FOnTabClose;
902 property OnTabMenu: TATTabMenuEvent read FOnTabMenu write FOnTabMenu;
903 property OnTabDrawBefore: TATTabDrawEvent read FOnTabDrawBefore write FOnTabDrawBefore;
904 property OnTabDrawAfter: TATTabDrawEvent read FOnTabDrawAfter write FOnTabDrawAfter;
905 property OnTabEmpty: TNotifyEvent read FOnTabEmpty write FOnTabEmpty;
906 property OnTabOver: TATTabOverEvent read FOnTabOver write FOnTabOver;
907 property OnTabMove: TATTabMoveEvent read FOnTabMove write FOnTabMove;
908 property OnTabChangeQuery: TATTabChangeQueryEvent read FOnTabChangeQuery write FOnTabChangeQuery;
909 property OnTabGetTick: TATTabGetTickEvent read FOnTabGetTick write FOnTabGetTick;
910 property OnTabGetCloseAction: TATTabGetCloseActionEvent read FOnTabGetCloseAction write FOnTabGetCloseAction;
911 property OnTabDblClick: TATTabDblClickEvent read FOnTabDblClick write FOnTabDblClick;
912 property OnTabDropQuery: TATTabDropQueryEvent read FOnTabDropQuery write FOnTabDropQuery;
913 end;
914
915 var
916 cTabsMouseMinDistanceToDrag: integer = 10; //mouse must move >=N pixels to start drag-drop
917 cTabsMouseMaxDistanceToClick: integer = 4; //if mouse moves during mouse-down >=N pixels, dont click
918 cTabsMinWidthForCaption: integer = 8; //don't draw caption if width of tab is less
919
920 implementation
921
922 uses
923 SysUtils,
924 StrUtils,
925 Dialogs,
926 Forms,
927 Math;
928
929 const
930 cSmoothScale = 5;
931 var
932 cRect0: TRect;
933
934 procedure AddTabButton(var Buttons: TATTabButtons; Id: TATTabButton; Size: integer);
935 begin
936 SetLength(Buttons, Length(Buttons)+1);
937 Buttons[Length(Buttons)-1].Id:= Id;
938 Buttons[Length(Buttons)-1].Size:= Size;
939 end;
940
941 { TATTabPaintInfo }
942
943 procedure TATTabPaintInfo.Clear;
944 begin
945 Self.Caption:= '';
946 FillChar(Self, SizeOf(Self), 0);
947 end;
948
949 { TATTabListCollection }
950
951 destructor TATTabListCollection.Destroy;
952 begin
953 Clear;
954 inherited Destroy;
955 end;
956
957 procedure TATTabListCollection.Clear;
958 var
959 Item: TObject;
960 i: integer;
961 begin
962 for i:= Count-1 downto 0 do
963 begin
964 Item:= Items[i];
965 if Assigned(Item) then
966 Item.Free;
967 end;
968 inherited Clear;
969 end;
970
971 procedure TATTabData.UpdateTabSet;
972 begin
973 if Collection is TATTabListCollection then
974 if TATTabListCollection(Collection).AOwner is TATTabs then
975 TATTabListCollection(Collection).AOwner.Invalidate;
976 end;
977
GetTabCaptionFullnull978 function TATTabData.GetTabCaptionFull: TATTabString;
979 begin
980 Result:= FTabCaption;
981 if FTabCaptionAddon<>'' then
982 Result:= Result+ATTabsAddonSeparator+FTabCaptionAddon;
983 end;
984
985 procedure TATTabData.SetTabImageIndex(const Value: TImageIndex);
986 begin
987 if FTabImageIndex<>Value then
988 begin
989 FTabImageIndex:= Value;
990 UpdateTabSet;
991 end;
992 end;
993
994 procedure TATTabData.SetTabCaption(const Value: TATTabString);
995 begin
996 if FTabCaption<>Value then
997 begin
998 FTabCaption:= Value;
999 UpdateTabSet;
1000 end;
1001 end;
1002
1003 procedure TATTabData.SetTabColor(const Value: TColor);
1004 begin
1005 if FTabColor<>Value then
1006 begin
1007 FTabColor:= Value;
1008 UpdateTabSet;
1009 end;
1010 end;
1011
1012 procedure TATTabData.SetTabColorActive(const Value: TColor);
1013 begin
1014 if FTabColorActive<>Value then
1015 begin
1016 FTabColorActive:= Value;
1017 UpdateTabSet;
1018 end;
1019 end;
1020
1021 procedure TATTabData.SetTabColorOver(const Value: TColor);
1022 begin
1023 if FTabColorOver<>Value then
1024 begin
1025 FTabColorOver:= Value;
1026 UpdateTabSet;
1027 end;
1028 end;
1029
1030 procedure TATTabData.SetTabHideXButton(const Value: boolean);
1031 begin
1032 if FTabHideXButton<>Value then
1033 begin
1034 FTabHideXButton:= Value;
1035 UpdateTabSet;
1036 end;
1037 end;
1038
1039 procedure TATTabData.SetTabVisible(const Value: boolean);
1040 begin
1041 if FTabVisible<>Value then
1042 begin
1043 FTabVisible:= Value;
1044 UpdateTabSet;
1045 end;
1046 end;
1047
1048 procedure TATTabs.SetOptShowPlusTab(const Value: boolean);
1049 begin
1050 FOptShowPlusTab:= Value;
1051 Invalidate;
1052 end;
1053
IsDoubleBufferedNeedednull1054 function IsDoubleBufferedNeeded: boolean;
1055 begin
1056 {$ifdef FPC}
1057 Result:= WidgetSet.GetLCLCapability(lcCanDrawOutsideOnPaint) = LCL_CAPABILITY_YES;
1058 {$else}
1059 Result:= true;
1060 {$endif}
1061 end;
1062
_FindControlnull1063 function _FindControl(Pnt: TPoint): TControl;
1064 begin
1065 {$ifdef FPC}
1066 Result:= FindControlAtPosition(Pnt, false);
1067 {$else}
1068 Result:= FindVCLWindow(Pnt);
1069 {$endif}
1070 end;
1071
PtInControlnull1072 function PtInControl(Control: TControl; const ScreenPnt: TPoint): boolean;
1073 begin
1074 Result:= PtInRect(Control.ClientRect, Control.ScreenToClient(ScreenPnt));
1075 end;
1076
1077 procedure DrawLine(C: TCanvas; X1, Y1, X2, Y2: integer; AColor: TColor);
1078 begin
1079 if Y1=Y2 then
1080 if X2>X1 then Inc(X2) else Dec(X2);
1081 if X1=X2 then
1082 if Y2>Y1 then Inc(Y2) else Dec(Y2);
1083
1084 C.Pen.Color:= AColor;
1085 C.MoveTo(X1, Y1);
1086 C.LineTo(X2, Y2);
1087 end;
1088
1089 procedure DrawTriangleType(C: TCanvas; AType: TATTabTriangle; const ARect: TRect; AColor: TColor; ASize: integer);
1090 begin
1091 case AType of
1092 atriDown:
1093 CanvasPaintTriangleDown(C, AColor, CenterPoint(ARect), ASize);
1094 atriRight:
1095 CanvasPaintTriangleRight(C, AColor, CenterPoint(ARect), ASize);
1096 atriLeft:
1097 CanvasPaintTriangleLeft(C, AColor, CenterPoint(ARect), ASize);
1098 end;
1099 end;
1100
1101
1102 procedure DrawPlusSign(C: TCanvas; const R: TRect; ASize, ALineWidth: integer; AColor: TColor);
1103 var
1104 CX, CY: integer;
1105 begin
1106 CX:= (R.Left+R.Right) div 2;
1107 CY:= (R.Top+R.Bottom) div 2;
1108 C.Pen.Width:= ALineWidth;
1109 {$ifdef FPC}
1110 C.Pen.EndCap:= pecSquare;
1111 {$endif}
1112 DrawLine(C, CX-ASize, CY, CX+ASize, CY, AColor);
1113 DrawLine(C, CX, CY-ASize, CX, CY+ASize, AColor);
1114 C.Pen.Width:= 1;
1115 end;
1116
1117
1118 procedure CanvasStretchDraw(C: TCanvas; const R: TRect; Bmp: TBitmap); {$ifdef fpc}inline;{$endif}
1119 begin
1120 {$ifdef fpc}
1121 C.StretchDraw(R, Bmp);
1122 {$else}
1123 //Delphi: StretchDraw cannot draw smooth
1124 StretchBlt(
1125 C.Handle, R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top,
1126 Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height,
1127 C.CopyMode);
1128 {$endif}
1129 end;
1130
1131 type
1132 TATMissedPoint = (
1133 ampnTopLeft,
1134 ampnTopRight,
1135 ampnBottomLeft,
1136 ampnBottomRight
1137 );
1138
1139 procedure DrawTriangleRectFramed(C: TCanvas;
1140 AX, AY, ASizeX, ASizeY, AScale: integer;
1141 ATriKind: TATMissedPoint;
1142 AColorFill, AColorLine: TColor;
1143 b: TBitmap);
1144 var
1145 p0, p1, p2, p3: TPoint;
1146 line1, line2: TPoint;
1147 ar: array[0..2] of TPoint;
1148 begin
1149 BitmapResize(b, ASizeX*AScale, ASizeY*AScale);
1150
1151 //b.Canvas.Brush.Color:= AColorBG;
1152 //b.Canvas.FillRect(0, 0, b.Width, b.Height);
1153 b.Canvas.CopyRect(
1154 Rect(0, 0, b.Width, b.Height),
1155 C,
1156 Rect(AX, AY, AX+ASizeX, AY+ASizeY)
1157 );
1158
1159 p0:= Point(0, 0);
1160 p1:= Point(b.Width, 0);
1161 p2:= Point(0, b.Height);
1162 p3:= Point(b.Width, b.Height);
1163
1164 case ATriKind of
1165 ampnTopLeft: begin ar[0]:= p1; ar[1]:= p2; ar[2]:= p3; line1:= p1; line2:= p2; end;
1166 ampnTopRight: begin ar[0]:= p0; ar[1]:= p2; ar[2]:= p3; line1:= p0; line2:= p3; end;
1167 ampnBottomLeft: begin ar[0]:= p0; ar[1]:= p1; ar[2]:= p3; line1:= p0; line2:= p3; end;
1168 ampnBottomRight: begin ar[0]:= p0; ar[1]:= p1; ar[2]:= p2; line1:= p1; line2:= p2; end;
1169 end;
1170
1171 b.Canvas.Pen.Style:= psClear;
1172 b.Canvas.Brush.Color:= AColorFill;
1173 b.Canvas.Polygon(ar);
1174 b.Canvas.Pen.Style:= psSolid;
1175
1176 b.Canvas.Pen.Color:= AColorLine;
1177 b.Canvas.Pen.Width:= AScale;
1178 b.Canvas.MoveTo(line1.X, line1.Y);
1179 b.Canvas.LineTo(line2.X, line2.Y);
1180 b.Canvas.Pen.Width:= 1;
1181
1182 CanvasStretchDraw(C, Rect(AX, AY, AX+ASizeX, AY+ASizeY), b);
1183 end;
1184
1185 { TATTabData }
1186
1187 constructor TATTabData.Create(ACollection: TCollection);
1188 begin
1189 inherited;
1190 Clear;
1191 TabVisible:= true;
1192 TabColor:= clNone;
1193 TabColorActive:= clNone;
1194 TabColorOver:= clNone;
1195 TabImageIndex:= -1;
1196 TabFontStyle:= [];
1197 end;
1198
1199 destructor TATTabData.Destroy;
1200 begin
1201 Clear;
1202 inherited Destroy;
1203 end;
1204
1205 procedure TATTabData.Clear;
1206 begin
1207 FTabCaption:= '';
1208 FTabCaptionAddon:= '';
1209 FTabHint:= '';
1210 end;
1211
1212 procedure TATTabData.Assign(Source: TPersistent);
1213 var
1214 D: TATTabData;
1215 begin
1216 if Source is TATTabData then
1217 begin
1218 D:= TATTabData(Source);
1219 TabCaption:= D.TabCaption;
1220 TabCaptionAddon:= D.TabCaptionAddon;
1221 TabObject:= D.TabObject;
1222 TabHint:= D.TabHint;
1223 TabColor:= D.TabColor;
1224 TabColorActive:= D.TabColorActive;
1225 TabColorOver:= D.TabColorOver;
1226 TabModified:= D.TabModified;
1227 TabImageIndex:= D.TabImageIndex;
1228 TabFontStyle:= D.TabFontStyle;
1229 TabPopupMenu:= D.TabPopupMenu;
1230 TabSpecialWidth:= D.TabSpecialWidth;
1231 TabSpecialHeight:= D.TabSpecialHeight;
1232 TabHideXButton:= D.TabHideXButton;
1233 TabVisible:= D.TabVisible;
1234 TabSpecial:= D.TabSpecial;
1235 TabPinned:= D.TabPinned;
1236 end
1237 else
1238 inherited Assign(Source);
1239 end;
1240
1241 { TATTabs }
1242
IsIndexOknull1243 function TATTabs.IsIndexOk(AIndex: integer): boolean;
1244 begin
1245 Result:= (AIndex>=0) and (AIndex<FTabList.Count);
1246 end;
1247
TabCountnull1248 function TATTabs.TabCount: integer;
1249 begin
1250 if Assigned(FTabList) then
1251 Result:= FTabList.Count
1252 else
1253 Result:= 0;
1254 end;
1255
1256 constructor TATTabs.Create(AOwner: TComponent);
1257 begin
1258 inherited;
1259
1260 Caption:= '';
1261 ControlStyle:= ControlStyle+[csOpaque];
1262 DoubleBuffered:= IsDoubleBufferedNeeded;
1263 DragMode:= dmManual; //required Manual
1264 ParentColor:= false; //better don't support ParentColor, it's mess in code
1265 Width:= 400;
1266 Height:= 35;
1267
1268 FMouseDown:= false;
1269 FMouseDownPnt:= Point(0, 0);
1270 FMouseDownDbl:= false;
1271 FMouseDownRightBtn:= false;
1272
1273 FPaintCount:= 0;
1274 FLastOverIndex:= -100;
1275 FLastOverX:= false;
1276
1277 FColorBg:= _InitTabColorBg;
1278 FColorSeparator:= _InitTabColorArrow;
1279 FColorTabActive:= _InitTabColorTabActive;
1280 FColorTabPassive:= _InitTabColorTabPassive;
1281 FColorTabOver:= _InitTabColorTabOver;
1282 FColorActiveMark:= _InitTabColorActiveMark;
1283 FColorFont:= _InitTabColorFont;
1284 FColorFontModified:= _InitTabColorFontModified;
1285 FColorFontActive:= _InitTabColorFontActive;
1286 FColorFontHot:= _InitTabColorFontHot;
1287 FColorBorderActive:= _InitTabColorBorderActive;
1288 FColorBorderPassive:= _InitTabColorBorderPassive;
1289 FColorCloseBg:= _InitTabColorCloseBg;
1290 FColorCloseBgOver:= _InitTabColorCloseBgOver;
1291 FColorCloseBorderOver:= _InitTabColorCloseBorderOver;
1292 FColorCloseX:= _InitTabColorCloseX;
1293 FColorCloseXOver:= _InitTabColorCloseXOver;
1294 FColorArrow:= _InitTabColorArrow;
1295 FColorArrowOver:= _InitTabColorArrowOver;
1296 FColorDropMark:= _InitTabColorDropMark;
1297 FColorScrollMark:= _InitTabColorScrollMark;
1298
1299 FOptScalePercents:= 100;
1300 FOptButtonSize:= _InitOptButtonSize;
1301 FOptButtonSizeSpace:= _InitOptButtonSizeSpace;
1302 FOptButtonSizeSeparator:= _InitOptButtonSizeSeparator;
1303
1304 FOptButtonLayout:= _InitOptButtonLayout;
1305 ApplyButtonLayout;
1306
1307 FOptCaptionAlignment:= taLeftJustify;
1308 FOptIconPosition:= aipIconLefterThanText;
1309 FOptWhichActivateOnClose:= aocRight;
1310 FOptFillWidth:= _InitOptFillWidth;
1311 FOptFillWidthLastToo:= _InitOptFillWidthLastToo;
1312 FOptTruncateCaption:= _InitOptTruncateCaption;
1313 FOptTabHeight:= _InitOptTabHeight;
1314 FOptTabWidthMinimal:= _InitOptTabWidthMinimal;
1315 FOptTabWidthMaximal:= _InitOptTabWidthMaximal;
1316 FOptTabWidthNormal:= _InitOptTabWidthNormal;
1317 FOptTabWidthMinimalHidesX:= _InitOptTabWidthMinimalHidesX;
1318 FOptTabRounded:= _InitOptTabRounded;
1319 FOptFontScale:= 100;
1320 FOptMinimalWidthForSides:= _InitOptMinimalWidthForSides;
1321 FOptSpaceSide:= _InitOptSpaceSide;
1322 FOptSpaceInitial:= _InitOptSpaceInitial;
1323 FOptSpaceBeforeText:= _InitOptSpaceBeforeText;
1324 FOptSpaceBeforeTextForMinWidth:= _InitOptSpaceBeforeTextForMinWidth;
1325 FOptSpaceAfterText:= _InitOptSpaceAfterText;
1326 FOptSpaceBetweenTabs:= _InitOptSpaceBetweenTabs;
1327 FOptSpaceBetweenLines:= _InitOptSpaceBetweenLines;
1328 FOptSpaceBetweenIconCaption:= _InitOptSpaceBetweenIconCaption;
1329 FOptSpaceSeparator:= _InitOptSpaceSeparator;
1330 FOptSpacer:= _InitOptSpacer;
1331 FOptSpacer2:= _InitOptSpacer2;
1332 FOptSpaceXRight:= _InitOptSpaceXRight;
1333 FOptSpaceXInner:= _InitOptSpaceXInner;
1334 FOptSpaceXSize:= _InitOptSpaceXSize;
1335 FOptSpaceXIncrementRound:= _InitOptSpaceXIncrementRound;
1336 FOptArrowSize:= _InitOptArrowSize;
1337 FOptColoredBandSize:= _InitOptColoredBandSize;
1338 FOptColoredBandForTop:= atpTop;
1339 FOptColoredBandForBottom:= atpBottom;
1340 FOptColoredBandForLeft:= atpLeft;
1341 FOptColoredBandForRight:= atpRight;
1342 FOptActiveMarkSize:= _InitOptActiveMarkSize;
1343 FOptScrollMarkSizeX:= _InitOptScrollMarkSizeX;
1344 FOptScrollMarkSizeY:= _InitOptScrollMarkSizeY;
1345 FOptScrollPagesizePercents:= _InitOptScrollPagesizePercents;
1346 FOptActiveVisibleOnResize:= true;
1347 FOptDropMarkSize:= _InitOptDropMarkSize;
1348 FOptActiveFontStyle:= _InitOptActiveFontStyle;
1349 FOptActiveFontStyleUsed:= _InitOptActiveFontStyleUsed;
1350 FOptHotFontStyle:= _InitOptHotFontStyle;
1351 FOptHotFontStyleUsed:= _InitOptHotFontStyleUsed;
1352
1353 FOptShowFlat:= _InitOptShowFlat;
1354 FOptShowFlatMouseOver:= _InitOptShowFlatMouseOver;
1355 FOptShowFlatSepar:= _InitOptShowFlatSep;
1356 FOptPosition:= _InitOptPosition;
1357 FOptShowNumberPrefix:= _InitOptShowNumberPrefix;
1358 FOptShowScrollMark:= _InitOptShowScrollMark;
1359 FOptShowDropMark:= _InitOptShowDropMark;
1360 FOptShowXRounded:= _InitOptShowXRounded;
1361 FOptShowXButtons:= _InitOptShowXButtons;
1362 FOptShowPlusTab:= _InitOptShowPlusTab;
1363 FOptShowArrowsNear:= _InitOptShowArrowsNear;
1364 FOptShowModifiedText:= _InitOptShowModifiedText;
1365 FOptShowPinnedText:= _InitOptShowPinnedText;
1366 FOptShowEntireColor:= _InitOptShowEntireColor;
1367 FOptShowActiveMarkInverted:= _InitOptShowActiveMarkInverted;
1368
1369 FOptMouseWheelMode:= _InitOptMouseWheelMode;
1370 FOptMouseMiddleClickClose:= _InitOptMouseMiddleClickClose;
1371 FOptMouseDoubleClickClose:= _InitOptMouseDoubleClickClose;
1372 FOptMouseDoubleClickPlus:= _InitOptMouseDoubleClickPlus;
1373 FOptMouseDragEnabled:= _InitOptMouseDragEnabled;
1374 FOptMouseDragOutEnabled:= _InitOptMouseDragOutEnabled;
1375 FOptMouseDragFromNotATTabs:= _InitOptMouseDragFromNotATTabs;
1376
1377 FHintForX:= 'Close tab';
1378 FHintForPlus:= 'Add tab';
1379 FHintForArrowLeft:= 'Scroll tabs left';
1380 FHintForArrowRight:= 'Scroll tabs right';
1381 FHintForArrowMenu:= 'Show tabs list';
1382 FHintForUser0:= '0';
1383 FHintForUser1:= '1';
1384 FHintForUser2:= '2';
1385 FHintForUser3:= '3';
1386 FHintForUser4:= '4';
1387
1388 FBitmap:= TBitmap.Create;
1389 FBitmap.PixelFormat:= pf24bit;
1390 BitmapResize(FBitmap, 1600, 60);
1391
1392 FBitmapAngleL:= TBitmap.Create;
1393 FBitmapAngleL.PixelFormat:= pf24bit;
1394 FBitmapAngleR:= TBitmap.Create;
1395 FBitmapAngleR.PixelFormat:= pf24bit;
1396
1397 FBitmapRound:= TBitmap.Create;
1398 FBitmapRound.PixelFormat:= pf24bit;
1399 BitmapResize(FBitmapRound, _InitRoundedBitmapSize, _InitRoundedBitmapSize);
1400
1401 FTabIndex:= 0;
1402 FTabIndexOver:= -1;
1403 FTabIndexHinted:= -1;
1404 FTabIndexHintedPrev:= -1;
1405 //FTabList:= TCollection.Create(TATTabData);
1406 FTabList:= TATTabListCollection.Create(TATTabData);
1407 FTabList.AOwner:= Self;
1408 FTabMenu:= nil;
1409 FScrollPos:= 0;
1410 end;
1411
CanFocusnull1412 function TATTabs.CanFocus: boolean;
1413 begin
1414 Result:= false;
1415 end;
1416
1417 procedure TATTabs.Clear;
1418 begin
1419 FTabList.Clear;
1420 FTabIndex:= 0;
1421 end;
1422
1423 destructor TATTabs.Destroy;
1424 begin
1425 if FThemed then
1426 begin
1427 FThemed:= false;
1428 FreeAndNil(FPic_Side_L);
1429 FreeAndNil(FPic_Side_L_a);
1430 FreeAndNil(FPic_Side_R);
1431 FreeAndNil(FPic_Side_R_a);
1432 FreeAndNil(FPic_Side_C);
1433 FreeAndNil(FPic_Side_C_a);
1434 FreeAndNil(FPic_X);
1435 FreeAndNil(FPic_X_a);
1436 FreeAndNil(FPic_Plus);
1437 FreeAndNil(FPic_Plus_a);
1438 FreeAndNil(FPic_Arrow_L);
1439 FreeAndNil(FPic_Arrow_L_a);
1440 FreeAndNil(FPic_Arrow_R);
1441 FreeAndNil(FPic_Arrow_R_a);
1442 FreeAndNil(FPic_Arrow_D);
1443 FreeAndNil(FPic_Arrow_D_a);
1444 end;
1445
1446 Clear;
1447 FreeAndNil(FTabList);
1448 FreeAndNil(FBitmapRound);
1449 FreeAndNil(FBitmapAngleL);
1450 FreeAndNil(FBitmapAngleR);
1451 FreeAndNil(FBitmap);
1452 inherited;
1453 end;
1454
1455 procedure TATTabs.Paint;
1456 begin
1457 if DoubleBuffered then
1458 begin
1459 if Assigned(FBitmap) then
1460 begin
1461 DoPaintTo(FBitmap.Canvas);
1462 Canvas.CopyRect(ClientRect, FBitmap.Canvas, ClientRect);
1463 end;
1464 end
1465 else
1466 begin
1467 DoPaintTo(Canvas);
1468 end;
1469
1470 {$ifdef tabs_paint_counter}
1471 Inc(FPaintCount);
1472 Canvas.Font.Color:= clRed;
1473 Canvas.TextOut(0, 0, IntToStr(FPaintCount));;
1474 {$endif}
1475 end;
1476
1477 procedure TATTabs.DoPaintTabTo(C: TCanvas; const AInfo: TATTabPaintInfo);
1478 const
1479 cIndentSepTop = 0;
1480 cIndentSepBottom = 1;
1481 var
1482 RectText: TRect;
1483 NIndentL, NIndentR, NIndentTop, NLeft,
1484 NLineHeight, NLineWidth, NLineIndex: integer;
1485 AImageIndex: integer;
1486 ATabModified: boolean;
1487 TempCaption: TATTabString;
1488 Extent: TSize;
1489 bNeedMoreSpace: boolean;
1490 NColor: TColor;
1491 ColorPos: TATTabPosition;
1492 Data: TATTabData;
1493 Sep: TATStringSeparator;
1494 SepItem: string;
1495 bOneLiner: boolean;
1496 begin
1497 //optimize for 200 tabs
1498 if AInfo.Rect.Left>=Width then exit;
1499 if AInfo.Rect.Top>=Height then exit;
1500 if AInfo.Rect.Right<=0 then exit;
1501 if AInfo.Rect.Bottom<=0 then exit;
1502
1503 Data:= GetTabData(AInfo.TabIndex);
1504 if Assigned(Data) then
1505 begin
1506 AImageIndex:= Data.TabImageIndex;
1507 ATabModified:= Data.TabModified;
1508 // if tab is not visible then don't draw
1509 if not Data.TabVisible then
1510 exit;
1511 end
1512 else
1513 begin
1514 AImageIndex:= -1;
1515 ATabModified:= false;
1516 end;
1517
1518 UpdateCanvasAntialiasMode(C);
1519
1520 DoPaintTabShape(C,
1521 Rect(
1522 AInfo.Rect.Left-DoScale(FLastSpaceSide),
1523 AInfo.Rect.Top,
1524 AInfo.Rect.Right+DoScale(FLastSpaceSide),
1525 AInfo.Rect.Bottom),
1526 AInfo.TabActive,
1527 AInfo.TabIndex
1528 );
1529
1530 RectText:= AInfo.Rect;
1531 bNeedMoreSpace:= (RectText.Right-RectText.Left<=DoScale(FOptSpaceBeforeTextForMinWidth)) and (AInfo.Caption<>'');
1532 NIndentL:= IfThen(not bNeedMoreSpace, DoScale(FOptSpaceBeforeText), 2);
1533 NIndentR:= IfThen(not bNeedMoreSpace, DoScale(FOptSpaceAfterText), 2) + IfThen(Assigned(Data) and Data.TabVisibleX, DoScale(FOptSpaceXRight));
1534 RectText:= Rect(AInfo.Rect.Left+NIndentL, AInfo.Rect.Top, AInfo.Rect.Right-NIndentR, AInfo.Rect.Bottom);
1535 if Assigned(Data) then
1536 Data.TabCaptionRect:= RectText;
1537
1538 if not FThemed then
1539 if FOptShowFlat and FOptShowFlatSepar then
1540 begin
1541 NLeft:= AInfo.Rect.Left - DoScale(FOptSpaceBetweenTabs) div 2;
1542 DrawLine(C, NLeft, AInfo.Rect.Top+cIndentSepTop, NLeft, AInfo.Rect.Bottom-cIndentSepBottom, FColorSeparator);
1543 end;
1544
1545 //imagelist
1546 if Assigned(FImages) then
1547 if (AImageIndex>=0) and (AImageIndex<FImages.Count) then
1548 begin
1549 NIndentTop:=
1550 (RectText.Top + RectText.Bottom - FImages.Height + DoScale(FOptColoredBandSize)) div 2;
1551 case FOptIconPosition of
1552 aipIconLefterThanText:
1553 begin
1554 FImages.Draw(C,
1555 RectText.Left - 2,
1556 NIndentTop,
1557 AImageIndex);
1558 Inc(RectText.Left, FImages.Width+DoScale(FOptSpaceBetweenIconCaption));
1559 end;
1560 aipIconRighterThanText:
1561 begin
1562 FImages.Draw(C,
1563 RectText.Right - FImages.Width + 2,
1564 NIndentTop,
1565 AImageIndex);
1566 Dec(RectText.Right, FImages.Width+DoScale(FOptSpaceBetweenIconCaption));
1567 end;
1568 aipIconCentered:
1569 begin
1570 FImages.Draw(C,
1571 (RectText.Left + RectText.Right - FImages.Width) div 2,
1572 NIndentTop,
1573 AImageIndex);
1574 end;
1575 aipIconAboveTextCentered:
1576 begin
1577 FImages.Draw(C,
1578 (RectText.Left + RectText.Right - FImages.Width) div 2,
1579 RectText.Top + DoScale(FOptColoredBandSize),
1580 AImageIndex);
1581 Inc(RectText.Top, FImages.Height+DoScale(FOptSpaceBetweenIconCaption));
1582 end;
1583 aipIconBelowTextCentered:
1584 begin
1585 FImages.Draw(C,
1586 (RectText.Left + RectText.Right - FImages.Width) div 2,
1587 RectText.Bottom - FImages.Height,
1588 AImageIndex);
1589 Dec(RectText.Bottom, FImages.Height+DoScale(FOptSpaceBetweenIconCaption));
1590 end;
1591 end;
1592 end;
1593
1594 //caption
1595 C.Brush.Style:= bsClear;
1596 if RectText.Right-RectText.Left>=cTabsMinWidthForCaption then
1597 begin
1598 C.Font.Assign(Self.Font);
1599 C.Font.Style:= AInfo.FontStyle;
1600 C.Font.Color:= AInfo.ColorFont;
1601 C.Font.Size:= DoScaleFont(C.Font.Size);
1602
1603 TempCaption:= AInfo.Caption;
1604 UpdateCaptionProps(C, TempCaption, NLineHeight, Extent);
1605
1606 NIndentTop:= (RectText.Bottom-RectText.Top-Extent.cy) div 2 + 1;
1607
1608 bOneLiner:= Pos(#10, TempCaption)=0;
1609 Sep.Init(TempCaption, #10);
1610 NLineIndex:= -1;
1611
1612 while Sep.GetItemStr(SepItem) do
1613 begin
1614 Inc(NLineIndex);
1615
1616 //calculate center pos for each SepItem
1617 case FOptCaptionAlignment of
1618 taLeftJustify:
1619 NIndentL:= RectText.Left;
1620
1621 taCenter:
1622 begin
1623 if bOneLiner then
1624 NLineWidth:= Extent.cx
1625 else
1626 NLineWidth:= C.TextWidth(SepItem);
1627 NIndentL:= Max(
1628 RectText.Left,
1629 (RectText.Left+RectText.Right-NLineWidth) div 2
1630 );
1631 end;
1632
1633 taRightJustify:
1634 begin
1635 if bOneLiner then
1636 NLineWidth:= Extent.cx
1637 else
1638 NLineWidth:= C.TextWidth(SepItem);
1639 NIndentL:= Max(
1640 RectText.Left,
1641 RectText.Right-NLineWidth
1642 );
1643 end;
1644 end;
1645
1646 SepItem:= CanvasCollapseStringByDots(C,
1647 SepItem,
1648 FOptTruncateCaption,
1649 RectText.Right-RectText.Left
1650 );
1651 DoTextOut(C,
1652 NIndentL,
1653 RectText.Top+NIndentTop+NLineIndex*NLineHeight,
1654 RectText,
1655 SepItem
1656 );
1657 end;
1658 end;
1659
1660 NColor:= clNone;
1661 if AInfo.TabMouseOver and not AInfo.TabActive and Assigned(Data) and (Data.TabColorOver<>clNone) then
1662 NColor:= Data.TabColorOver
1663 else
1664 if AInfo.TabActive and Assigned(Data) and (Data.TabColorActive<>clNone) then
1665 NColor:= Data.TabColorActive
1666 else
1667 if Assigned(Data) and (Data.TabColor<>clNone) then
1668 NColor:= Data.TabColor;
1669
1670 //colored band
1671 if not FOptShowEntireColor then
1672 begin
1673 if NColor<>clNone then
1674 begin
1675 case FOptPosition of
1676 atpTop:
1677 ColorPos:= FOptColoredBandForTop;
1678 atpBottom:
1679 ColorPos:= FOptColoredBandForBottom;
1680 atpLeft:
1681 ColorPos:= FOptColoredBandForLeft;
1682 atpRight:
1683 ColorPos:= FOptColoredBandForRight;
1684 else
1685 raise Exception.Create('Unknown tab pos');
1686 end;
1687 DoPaintColoredBand(C, AInfo.Rect, NColor, ColorPos);
1688 end;
1689 end;
1690 end;
1691
1692 procedure TATTabs.DoPaintPlus(C: TCanvas; const ARect: TRect);
1693 var
1694 NColorFont: TColor;
1695 ElemType: TATTabElemType;
1696 Pic: TATTabsPicture;
1697 bActive: boolean;
1698 Info: TATTabPaintInfo;
1699 begin
1700 bActive:= FTabIndexOver=cTabIndexPlus;
1701 if bActive then
1702 ElemType:= aeTabPlusOver
1703 else
1704 ElemType:= aeTabPlus;
1705
1706 if IsPaintNeeded(ElemType, -1, C, ARect) then
1707 begin
1708 NColorFont:= FColorFont;
1709
1710 Info.Clear;
1711 Info.Rect:= ARect;
1712 Info.TabIndex:= cTabIndexPlus;
1713 Info.ColorFont:= NColorFont;
1714 DoPaintTabTo(C, Info);
1715
1716 if FThemed then
1717 begin
1718 if bActive then
1719 Pic:= FPic_Plus_a
1720 else
1721 Pic:= FPic_Plus;
1722 Pic.Draw(C,
1723 (ARect.Left+ARect.Right-Pic.Width) div 2,
1724 (ARect.Top+ARect.Bottom-Pic.Height) div 2
1725 );
1726 exit;
1727 end
1728 else
1729 DrawPlusSign(C, ARect, DoScale(FOptArrowSize), DoScale(1), FColorFont);
1730
1731 DoPaintAfter(ElemType, -1, C, ARect);
1732 end;
1733 end;
1734
1735
1736 procedure TATTabs.DoPaintTabShape(C: TCanvas; const ATabRect: TRect;
1737 ATabActive: boolean; ATabIndex: integer);
1738 var
1739 NColorBg, NColorEmpty, NColorBorder: TColor;
1740 PL1, PL2, PR1, PR2: TPoint;
1741 R: TRect;
1742 begin
1743 R.Top:= ATabRect.Top;
1744 R.Bottom:= ATabRect.Bottom;
1745 R.Left:= ATabRect.Left+DoScale(FLastSpaceSide);
1746 R.Right:= ATabRect.Right-DoScale(FLastSpaceSide);
1747
1748 if not FThemed then
1749 begin
1750 if ATabActive then
1751 NColorBg:= GetTabBgColor_Active(ATabIndex)
1752 else
1753 NColorBg:= GetTabBgColor_Passive(ATabIndex);
1754
1755 C.Pen.Color:= NColorBg;
1756 C.Brush.Color:= NColorBg;
1757 C.FillRect(R);
1758 end;
1759
1760 PL1:= Point(R.Left, R.Top);
1761 PL2:= Point(R.Left, R.Bottom-1);
1762 PR1:= Point(R.Right-1, R.Top);
1763 PR2:= Point(R.Right-1, R.Bottom-1);
1764
1765 //center shape
1766 DoPaintTabShape_C(C, ATabActive, ATabIndex, R, PL1, PL2, PR1, PR2);
1767
1768 //left/right edges
1769 if (FLastSpaceSide>0) and not FOptShowFlat then
1770 begin
1771 DoPaintTabShape_L(C, R, ATabActive, ATabIndex);
1772 DoPaintTabShape_R(C, R, ATabActive, ATabIndex);
1773 end
1774 else
1775 if FOptTabRounded and not FOptShowFlat and ATTabsPixelsDrawEnabled then
1776 begin
1777 NColorEmpty:= ColorBg;
1778 if ATabActive then
1779 NColorBorder:= ColorBorderActive
1780 else
1781 NColorBorder:= ColorBorderPassive;
1782
1783 //paint rounded corners
1784 case FOptPosition of
1785 atpTop:
1786 begin
1787 CanvasPaintRoundedCorners(C, R, [acckLeftTop, acckRightTop], NColorEmpty, NColorBorder, NColorBg);
1788 end;
1789 atpBottom:
1790 begin
1791 Inc(R.Bottom, 1);
1792 CanvasPaintRoundedCorners(C, R, [acckLeftBottom, acckRightBottom], NColorEmpty, NColorBorder, NColorBg);
1793 end;
1794 atpLeft:
1795 begin
1796 CanvasPaintRoundedCorners(C, R, [acckLeftTop, acckLeftBottom], NColorEmpty, NColorBorder, NColorBg);
1797 end;
1798 atpRight:
1799 begin
1800 CanvasPaintRoundedCorners(C, R, [acckRightTop, acckRightBottom], NColorEmpty, NColorBorder, NColorBg);
1801 end;
1802 end;
1803 end;
1804 end;
1805
1806 procedure TATTabs.DoPaintTabShape_C(C: TCanvas;
1807 ATabActive: boolean;
1808 ATabIndex: integer;
1809 const ARect: TRect;
1810 const PL1, PL2, PR1, PR2: TPoint);
1811 var
1812 ColorPos: TATTabPosition;
1813 Pic: TATTabsPicture;
1814 AColorBg, AColorBorder, AColorBorderLow: TColor;
1815 begin
1816 if FThemed then
1817 begin
1818 if ATabActive then
1819 Pic:= FPic_Side_C_a
1820 else
1821 Pic:= FPic_Side_C;
1822 Pic.DrawSized(C, PL1.X, PL1.Y, PR1.X-PL1.X);
1823 exit;
1824 end;
1825
1826 if ATabActive then
1827 begin
1828 AColorBg:= GetTabBgColor_Active(ATabIndex);
1829 AColorBorder:= FColorBorderActive;
1830 AColorBorderLow:= clNone;
1831 end
1832 else
1833 begin
1834 AColorBg:= GetTabBgColor_Passive(ATabIndex);
1835 AColorBorder:= FColorBorderPassive;
1836 AColorBorderLow:= FColorBorderActive;
1837 end;
1838
1839 if FOptShowFlat then
1840 begin
1841 if ATabActive then
1842 begin
1843 ColorPos:= FOptPosition;
1844 if FOptShowActiveMarkInverted then
1845 ColorPos:= GetPositionInverted(ColorPos);
1846 DoPaintColoredBand(C, ARect, FColorActiveMark, ColorPos);
1847 end;
1848 end
1849 else
1850 case FOptPosition of
1851 atpTop:
1852 begin
1853 if FLastSpaceSide=0 then
1854 DrawLine(C, PL1.X, PL1.Y, PL2.X, PL2.Y+1, AColorBorder);
1855 if FLastSpaceSide=0 then
1856 DrawLine(C, PR1.X, PR1.Y, PR2.X, PR2.Y+1, AColorBorder);
1857 DrawLine(C, PL1.X, PL1.Y, PR1.X, PL1.Y, AColorBorder);
1858 if AColorBorderLow<>clNone then
1859 DrawLine(C, PL2.X-DoScale(FLastSpaceSide), ARect.Bottom,
1860 PR2.X+DoScale(FLastSpaceSide), ARect.Bottom, AColorBorderLow)
1861 else
1862 DrawLine(C, PL2.X+1, ARect.Bottom, PR2.X-1, ARect.Bottom, AColorBg);
1863 end;
1864 atpBottom:
1865 begin
1866 DrawLine(C, PL1.X, PL1.Y, PL2.X, PL2.Y+1, AColorBorder);
1867 DrawLine(C, PR1.X, PR1.Y, PR2.X, PR2.Y+1, AColorBorder);
1868 DrawLine(C, PL2.X, PL2.Y+1, PR2.X, PL2.Y+1, AColorBorder);
1869 if AColorBorderLow<>clNone then
1870 DrawLine(C, PL1.X-DoScale(FLastSpaceSide), ARect.Top,
1871 PR1.X+DoScale(FLastSpaceSide), ARect.Top, AColorBorderLow)
1872 end;
1873 atpLeft:
1874 begin
1875 DrawLine(C, PL1.X, PL1.Y, PR1.X, PR1.Y, AColorBorder);
1876 DrawLine(C, PL2.X, PL2.Y, PR2.X, PR2.Y, AColorBorder);
1877 DrawLine(C, PL1.X, PL1.Y, PL2.X, PL2.Y, AColorBorder);
1878 DrawLine(C, PR1.X+1, PR1.Y+1, PR1.X+1, PR2.Y-1, IfThen(AColorBorderLow<>clNone, AColorBorderLow, AColorBg));
1879 end;
1880 atpRight:
1881 begin
1882 DrawLine(C, PL1.X, PL1.Y, PR1.X, PR1.Y, AColorBorder);
1883 DrawLine(C, PL2.X, PL2.Y, PR2.X, PR2.Y, AColorBorder);
1884 DrawLine(C, PL1.X-1, PL1.Y+1, PL1.X-1, PL2.Y-1, IfThen(AColorBorderLow<>clNone, AColorBorderLow, AColorBg));
1885 DrawLine(C, PR1.X, PR1.Y, PR2.X, PR2.Y, AColorBorder);
1886 end;
1887 end;
1888 end;
1889
1890 procedure TATTabs.DoPaintTabShape_L(C: TCanvas; const ARect: TRect;
1891 ATabActive: boolean; ATabIndex: integer);
1892 var
1893 Pic: TATTabsPicture;
1894 AColorBg, AColorBorder: TColor;
1895 begin
1896 if FThemed then
1897 begin
1898 if ATabActive then
1899 Pic:= FPic_Side_L_a
1900 else
1901 Pic:= FPic_Side_L;
1902 Pic.Draw(C, ARect.Left-DoScale(FLastSpaceSide), ARect.Top);
1903 exit;
1904 end;
1905
1906 if ATabActive then
1907 begin
1908 AColorBg:= GetTabBgColor_Active(ATabIndex);
1909 AColorBorder:= FColorBorderActive
1910 end
1911 else
1912 begin
1913 AColorBg:= GetTabBgColor_Passive(ATabIndex);
1914 AColorBorder:= FColorBorderPassive;
1915 end;
1916
1917 if not FOptShowFlat then
1918 case FOptPosition of
1919 atpTop:
1920 begin
1921 DrawTriangleRectFramed(C,
1922 ARect.Left-DoScale(FLastSpaceSide)+1,
1923 ARect.Top,
1924 DoScale(FLastSpaceSide),
1925 DoScale(FOptTabHeight)+IfThen(ATabActive, 1),
1926 cSmoothScale,
1927 ampnTopLeft,
1928 AColorBg,
1929 AColorBorder,
1930 FBitmapAngleL);
1931 end;
1932 atpBottom:
1933 begin
1934 DrawTriangleRectFramed(C,
1935 ARect.Left-DoScale(FLastSpaceSide)+1,
1936 ARect.Top+IfThen(not ATabActive, 1),
1937 DoScale(FLastSpaceSide),
1938 DoScale(FOptTabHeight),
1939 cSmoothScale,
1940 ampnBottomLeft,
1941 AColorBg,
1942 AColorBorder,
1943 FBitmapAngleL);
1944 end;
1945 end;
1946 end;
1947
1948 procedure TATTabs.DoPaintTabShape_R(C: TCanvas; const ARect: TRect;
1949 ATabActive: boolean; ATabIndex: integer);
1950 var
1951 Pic: TATTabsPicture;
1952 AColorBg, AColorBorder: TColor;
1953 begin
1954 if FThemed then
1955 begin
1956 if ATabActive then
1957 Pic:= FPic_Side_R_a
1958 else
1959 Pic:= FPic_Side_R;
1960 Pic.Draw(C, ARect.Right-1, ARect.Top);
1961 exit;
1962 end;
1963
1964 if ATabActive then
1965 begin
1966 AColorBg:= GetTabBgColor_Active(ATabIndex);
1967 AColorBorder:= FColorBorderActive
1968 end
1969 else
1970 begin
1971 AColorBg:= GetTabBgColor_Passive(ATabIndex);
1972 AColorBorder:= FColorBorderPassive;
1973 end;
1974
1975 if not FOptShowFlat then
1976 case FOptPosition of
1977 atpTop:
1978 begin
1979 DrawTriangleRectFramed(C,
1980 ARect.Right-1,
1981 ARect.Top,
1982 DoScale(FLastSpaceSide),
1983 DoScale(FOptTabHeight)+IfThen(ATabActive, 1),
1984 cSmoothScale,
1985 ampnTopRight,
1986 AColorBg,
1987 AColorBorder,
1988 FBitmapAngleR);
1989 end;
1990 atpBottom:
1991 begin
1992 DrawTriangleRectFramed(C,
1993 ARect.Right-1,
1994 ARect.Top+IfThen(not ATabActive, 1),
1995 DoScale(FLastSpaceSide),
1996 DoScale(FOptTabHeight),
1997 cSmoothScale,
1998 ampnBottomRight,
1999 AColorBg,
2000 AColorBorder,
2001 FBitmapAngleR);
2002 end;
2003 end;
2004 end;
2005
2006
2007 procedure TATTabs.DoPaintX(C: TCanvas; const AInfo: TATTabPaintInfo);
2008 var
2009 ElemType: TATTabElemType;
2010 begin
2011 if AInfo.TabMouseOverX then
2012 ElemType:= aeTabIconXOver
2013 else
2014 ElemType:= aeTabIconX;
2015
2016 if IsPaintNeeded(ElemType, -1, C, AInfo.Rect) then
2017 begin
2018 DoPaintXTo(C, AInfo);
2019 DoPaintAfter(ElemType, -1, C, AInfo.Rect);
2020 end;
2021 end;
2022
2023 procedure TATTabs.DoPaintXTo(C: TCanvas; const AInfo: TATTabPaintInfo);
2024 var
2025 Pic: TATTabsPicture;
2026 RectRound, RectBitmap: TRect;
2027 NColorBg, NColorXBg, NColorXBorder, NColorXMark: TColor;
2028 NSize: integer;
2029 begin
2030 if FThemed then
2031 begin
2032 if AInfo.TabMouseOverX then
2033 Pic:= FPic_X_a
2034 else
2035 Pic:= FPic_X;
2036 Pic.Draw(C, AInfo.Rect.Left, AInfo.Rect.Top);
2037 exit;
2038 end;
2039
2040 if AInfo.TabActive then
2041 NColorBg:= GetTabBgColor_Active(AInfo.TabIndex)
2042 else
2043 NColorBg:= GetTabBgColor_Passive(AInfo.TabIndex);
2044 GetTabXColors(AInfo.TabIndex, AInfo.TabMouseOverX, NColorXBg, NColorXBorder, NColorXMark);
2045
2046 if FOptShowXRounded and ATTabsCircleDrawEnabled then
2047 begin
2048 if NColorXBg<>clNone then
2049 begin
2050 RectRound:= AInfo.Rect;
2051 NSize:= DoScale(FOptSpaceXIncrementRound);
2052 InflateRect(RectRound, NSize, NSize);
2053
2054 RectBitmap.Left:= 0;
2055 RectBitmap.Top:= 0;
2056 RectBitmap.Right:= FBitmapRound.Width;
2057 RectBitmap.Bottom:= RectBitmap.Right;
2058
2059 FBitmapRound.Canvas.Brush.Color:= NColorBg;
2060 FBitmapRound.Canvas.FillRect(RectBitmap);
2061
2062 FBitmapRound.Canvas.Brush.Color:= NColorXBg;
2063 FBitmapRound.Canvas.Pen.Color:= NColorXBorder;
2064 FBitmapRound.Canvas.Ellipse(RectBitmap);
2065
2066 CanvasStretchDraw(C, RectRound, FBitmapRound);
2067 end
2068 else
2069 begin
2070 C.Brush.Color:= NColorBg;
2071 C.FillRect(AInfo.Rect);
2072 end;
2073 end
2074 else
2075 begin
2076 C.Brush.Color:= IfThen(NColorXBg<>clNone, NColorXBg, NColorBg);
2077 C.FillRect(AInfo.Rect);
2078 C.Pen.Color:= IfThen(NColorXBorder<>clNone, NColorXBorder, NColorBg);
2079 C.Rectangle(AInfo.Rect);
2080 end;
2081
2082 RectRound:= AInfo.Rect;
2083 Dec(RectRound.Right);
2084 Dec(RectRound.Bottom);
2085 NSize:= DoScale(FOptSpaceXInner);
2086 CanvasPaintXMark(C, RectRound, NColorXMark, NSize, NSize, DoScale(1));
2087 C.Brush.Color:= NColorBg;
2088 end;
2089
GetTabWidth_Plus_Rawnull2090 function TATTabs.GetTabWidth_Plus_Raw: integer;
2091 begin
2092 Result:= DoScale(FOptArrowSize)*4;
2093 end;
2094
GetTabRectWidthnull2095 function TATTabs.GetTabRectWidth(APlusBtn: boolean): integer;
2096 begin
2097 case FOptPosition of
2098 atpLeft,
2099 atpRight:
2100 begin
2101 Result:= Width-DoScale(FOptSpacer);
2102 end;
2103 else
2104 begin
2105 if APlusBtn then
2106 Result:= GetTabWidth_Plus_Raw
2107 else
2108 Result:= DoScale(FOptTabWidthNormal);
2109 Inc(Result, DoScale(FOptSpaceBeforeText+FOptSpaceAfterText));
2110 end;
2111 end;
2112 end;
2113
2114
GetRectScrollednull2115 function TATTabs.GetRectScrolled(const R: TRect): TRect;
2116 begin
2117 Result:= R;
2118 if Result=cRect0 then Exit;
2119 if not FActualMultiline then
2120 begin
2121 Dec(Result.Left, FScrollPos);
2122 Dec(Result.Right, FScrollPos);
2123 end
2124 else
2125 begin
2126 Dec(Result.Top, FScrollPos);
2127 Dec(Result.Bottom, FScrollPos);
2128 end;
2129 end;
2130
2131 procedure TATTabs.GetTabFirstCoord(var R: TRect);
2132 begin
2133 if FOptPosition in [atpLeft, atpRight] then
2134 begin
2135 if FOptPosition=atpLeft then
2136 begin
2137 R.Left:= DoScale(FOptSpacer);
2138 R.Right:= Width-DoScale(FOptSpacer2);
2139 end
2140 else
2141 begin
2142 R.Left:= DoScale(FOptSpacer2)+1;
2143 R.Right:= Width-DoScale(FOptSpacer);
2144 end;
2145 R.Bottom:= GetInitialVerticalIndent;
2146 R.Top:= R.Bottom;
2147 end
2148 else
2149 begin
2150 R.Left:= FRealIndentLeft+DoScale(FLastSpaceSide);
2151 R.Right:= R.Left;
2152 R.Top:= DoScale(FOptSpacer);
2153 R.Bottom:= R.Top+DoScale(FOptTabHeight);
2154 end;
2155 end;
2156
2157 procedure TATTabs.UpdateTabRects(C: TCanvas);
2158 var
2159 TempCaption: TATTabString;
2160 Data: TATTabData;
2161 R: TRect;
2162 Extent: TSize;
2163 NWidthPlus, NIndexLineStart, NLineHeight, NWidthSaved: integer;
2164 NWidthMin, NWidthMax: integer;
2165 NSelfHeight, NFormHeight: integer;
2166 bFitLastRow: boolean;
2167 i: integer;
2168 begin
2169 GetTabFirstCoord(R);
2170
2171 //left/right tabs
2172 if FOptPosition in [atpLeft, atpRight] then
2173 begin
2174 for i:= 0 to TabCount-1 do
2175 begin
2176 Data:= GetTabData(i);
2177 if not Assigned(Data) then Continue;
2178 if not Data.TabVisible then
2179 begin
2180 Data.TabRect:= cRect0;
2181 Continue;
2182 end;
2183
2184 R.Top:= R.Bottom;
2185 if i>0 then
2186 Inc(R.Top, DoScale(FOptSpaceBetweenTabs));
2187
2188 if Data.TabSpecialHeight>0 then
2189 NLineHeight:= Data.TabSpecialHeight
2190 else
2191 if FOptVarWidth then
2192 begin
2193 UpdateCaptionProps(C, GetTabCaptionFinal(Data, i), NLineHeight, Extent);
2194 NLineHeight:= DoScale(FOptSpaceBeforeText+FOptSpaceAfterText) + Extent.CY;
2195 end
2196 else
2197 NLineHeight:= DoScale(FOptTabHeight);
2198
2199 R.Bottom:= R.Top + NLineHeight;
2200 Data.TabRect:= R;
2201 end;
2202
2203 exit;
2204 end;
2205
2206 //top/bottom tabs
2207 FMultilineActive:= false;
2208 NWidthMin:= DoScale(FOptTabWidthMinimal);
2209 NWidthMax:= DoScale(FOptTabWidthMaximal);
2210 NWidthPlus:= 0;
2211 if FOptShowPlusTab then
2212 NWidthPlus:= GetTabRectWidth(true);
2213 if FOptMultiline then
2214 FTabWidth:= DoScale(FOptTabWidthNormal);
2215 NWidthSaved:= FTabWidth;
2216
2217 NIndexLineStart:= 0;
2218
2219 for i:= 0 to TabCount-1 do
2220 begin
2221 Data:= GetTabData(i);
2222 if not Assigned(Data) then Continue;
2223 if not Data.TabVisible then Continue;
2224 Data.TabStartsNewLine:= false;
2225
2226 R.Left:= R.Right;
2227 if i>0 then
2228 Inc(R.Left, DoScale(FOptSpaceBetweenTabs));
2229
2230 if Data.TabSpecialWidth>0 then
2231 FTabWidth:= Data.TabSpecialWidth
2232 else
2233 if FOptVarWidth then
2234 begin
2235 C.Font.Style:= Data.TabFontStyle;
2236
2237 if FOptActiveFontStyleUsed then
2238 if i=FTabIndex then
2239 C.Font.Style:= FOptActiveFontStyle;
2240
2241 TempCaption:= GetTabCaptionFinal(Data, i);
2242
2243 UpdateCaptionProps(C, TempCaption, NLineHeight, Extent);
2244 FTabWidth:= Extent.CX + DoScale(FOptSpaceBeforeText+FOptSpaceAfterText);
2245
2246 if not Assigned(FImages) then //no imagelist
2247 Data.TabImageIndex:= -1;
2248
2249 if Data.TabImageIndex>=0 then
2250 if FOptIconPosition in [aipIconLefterThanText, aipIconRighterThanText] then
2251 Inc(FTabWidth, FImages.Width+FOptSpaceBetweenIconCaption);
2252
2253 if FOptShowXButtons<>atbxShowNone then
2254 if not Data.TabHideXButton then
2255 Inc(FTabWidth, DoScale(FOptSpaceXSize));
2256
2257 if FTabWidth<NWidthMin then
2258 FTabWidth:= NWidthMin;
2259 if FTabWidth>NWidthMax then
2260 FTabWidth:= NWidthMax;
2261 end;
2262
2263 if FOptMultiline and (i>0) then
2264 if R.Left+FTabWidth+FRealIndentRight+NWidthPlus >= Width then
2265 begin
2266 Data.TabStartsNewLine:= true;
2267 FMultilineActive:= true;
2268
2269 R.Left:= FRealIndentLeft;
2270 R.Top:= R.Bottom+DoScale(FOptSpaceBetweenLines);
2271 R.Bottom:= R.Top+DoScale(FOptTabHeight);
2272
2273 if FOptFillWidth then
2274 UpdateTabRectsToFillLine(NIndexLineStart, i-1, false);
2275 NIndexLineStart:= i;
2276 end;
2277
2278 R.Right:= R.Left + FTabWidth;
2279 Data.TabRect:= R;
2280 end;
2281
2282 //fix for the case of many tabs, vertically scrolled, and last tab is not shrinked
2283 bFitLastRow:= FOptFillWidthLastToo or (Width<FOptTabWidthNormal);
2284
2285 if FOptFillWidth and bFitLastRow then
2286 UpdateTabRectsToFillLine(NIndexLineStart, TabCount-1, true);
2287
2288 if FOptMultiline then
2289 begin
2290 NFormHeight:= GetParentForm(Self).Height;
2291 NSelfHeight:= R.Bottom+DoScale(FOptSpacer2);
2292 NSelfHeight:= Min(NSelfHeight, NFormHeight);
2293 if Constraints.MaxHeight>0 then
2294 NSelfHeight:= Min(NSelfHeight, Constraints.MaxHeight);
2295 if Height<>NSelfHeight then
2296 Height:= NSelfHeight;
2297 //Application.MainForm.Caption:='newh '+inttostr(NSelfHeight)+', tabs '+inttostr(TabCount);
2298 end;
2299
2300 //restore FTabWidth for other methods
2301 if not FOptVarWidth then
2302 FTabWidth:= NWidthSaved;
2303 end;
2304
GetTabLastVisibleIndexnull2305 function TATTabs.GetTabLastVisibleIndex: integer;
2306 var
2307 Data: TATTabData;
2308 begin
2309 Result:= TabCount;
2310 repeat
2311 Dec(Result);
2312 if Result<0 then Break;
2313 Data:= GetTabData(Result);
2314 if Assigned(Data) and Data.TabVisible then Break;
2315 until false;
2316 end;
2317
2318 procedure TATTabs.UpdateTabRectsSpecial;
2319 var
2320 Data: TATTabData;
2321 NIndex: integer;
2322 begin
2323 NIndex:= GetTabLastVisibleIndex;
2324 Data:= GetTabData(NIndex);
2325 if Assigned(Data) then
2326 begin
2327 FRectTabLast_NotScrolled:= Data.TabRect;
2328 FRectTabLast_Scrolled:= GetRectScrolled(FRectTabLast_NotScrolled);
2329 end
2330 else
2331 begin
2332 FRectTabLast_NotScrolled:= cRect0;
2333 FRectTabLast_Scrolled:= cRect0;
2334 end;
2335
2336 UpdateRectPlus(FRectTabPlus_NotScrolled);
2337 FRectTabPlus_Scrolled:= GetRectScrolled(FRectTabPlus_NotScrolled);
2338 end;
2339
2340 procedure TATTabs.UpdateTabPropsX;
2341 var
2342 D: TATTabData;
2343 i: integer;
2344 begin
2345 for i:= 0 to TabCount-1 do
2346 begin
2347 D:= GetTabData(i);
2348 if D=nil then Continue;
2349 D.TabVisibleX:= GetTabVisibleX(i, D);
2350 if D.TabVisibleX and (D.TabRect<>cRect0) then
2351 D.TabRectX:= GetTabRect_X(D.TabRect)
2352 else
2353 D.TabRectX:= cRect0;
2354 end;
2355 end;
2356
2357 procedure TATTabs.UpdateRectPlus(var R: TRect);
2358 var
2359 bTabsVisible: boolean;
2360 begin
2361 bTabsVisible:= GetTabLastVisibleIndex>=0;
2362 case FOptPosition of
2363 atpTop,
2364 atpBottom:
2365 begin
2366 if bTabsVisible then
2367 begin
2368 R:= FRectTabLast_NotScrolled;
2369 if R=cRect0 then exit;
2370 R.Left:= R.Right + DoScale(FOptSpaceBetweenTabs);
2371 R.Right:= R.Left + GetTabRectWidth(true);
2372 end
2373 else
2374 begin
2375 R.Top:= DoScale(FOptSpacer);
2376 R.Bottom:= R.Top + DoScale(FOptTabHeight);
2377 R.Left:= FRealIndentLeft + FLastSpaceSide;
2378 R.Right:= R.Left + GetTabRectWidth(true);
2379 end;
2380 end;
2381 else
2382 begin
2383 if bTabsVisible then
2384 begin
2385 R:= FRectTabLast_NotScrolled;
2386 if R=cRect0 then exit;
2387 R.Top:= R.Bottom + DoScale(FOptSpaceBetweenTabs);
2388 R.Bottom:= R.Top + DoScale(FOptTabHeight);
2389 end
2390 else
2391 begin
2392 R.Left:= IfThen(FOptPosition=atpLeft, DoScale(FOptSpacer), DoScale(FOptSpacer2));
2393 R.Right:= IfThen(FOptPosition=atpLeft, Width-DoScale(FOptSpacer2), Width-DoScale(FOptSpacer));
2394 R.Top:= GetInitialVerticalIndent;
2395 R.Bottom:= R.Top + DoScale(FOptTabHeight);
2396 end;
2397 end;
2398 end;
2399 end;
2400
GetTabRect_Xnull2401 function TATTabs.GetTabRect_X(const ARect: TRect): TRect;
2402 var
2403 X, Y, W: integer;
2404 begin
2405 if ARect=cRect0 then
2406 begin
2407 Result:= cRect0;
2408 Exit;
2409 end;
2410 X:= ARect.Right-DoScale(FOptSpaceXRight);
2411 Y:= (ARect.Top+ARect.Bottom) div 2 + 1;
2412 W:= DoScale(FOptSpaceXSize);
2413 Dec(X, W div 2);
2414 Dec(Y, W div 2);
2415 Result:= Rect(X, Y, X+W, Y+W);
2416 end;
2417
_IsDragnull2418 function TATTabs._IsDrag: boolean;
2419 begin
2420 Result:= Dragging and FMouseDragBegins;
2421 end;
2422
2423 procedure TATTabs.GetTabXColors(AIndex: integer;
2424 AMouseOverX: boolean;
2425 out AColorXBg, AColorXBorder, AColorXMark: TColor);
2426 begin
2427 if GetTabFlatEffective(AIndex) then
2428 AColorXBg:= FColorBg
2429 else
2430 AColorXBg:= FColorCloseBg;
2431
2432 AColorXBorder:= AColorXBg;
2433 AColorXMark:= FColorCloseX;
2434
2435 if AMouseOverX then
2436 begin
2437 AColorXBg:= FColorCloseBgOver;
2438 AColorXBorder:= FColorCloseBorderOver;
2439 AColorXMark:= FColorCloseXOver;
2440 end;
2441 end;
2442
2443 procedure TATTabs.GetTabXProps(AIndex: integer; const ARect: TRect;
2444 out AMouseOverX: boolean;
2445 out ARectX: TRect);
2446 var
2447 Data: TATTabData;
2448 begin
2449 AMouseOverX:= false;
2450 ARectX:= cRect0;
2451
2452 Data:= GetTabData(AIndex);
2453 if Data=nil then Exit;
2454 ARectX:= GetRectScrolled(Data.TabRectX);
2455
2456 if _IsDrag then Exit;
2457
2458 if Data.TabVisibleX then
2459 if AIndex=FTabIndexOver then
2460 begin
2461 AMouseOverX:= PtInRect(ARectX, ScreenToClient(Mouse.CursorPos));
2462 end;
2463 end;
2464
IsPaintNeedednull2465 function TATTabs.IsPaintNeeded(AElemType: TATTabElemType;
2466 AIndex: integer; ACanvas: TCanvas; const ARect: TRect): boolean;
2467 begin
2468 Result:= ARect.Right>ARect.Left;
2469 if Result then
2470 if Assigned(FOnTabDrawBefore) then
2471 FOnTabDrawBefore(Self, AElemType, AIndex, ACanvas, ARect, Result);
2472 end;
2473
DoPaintAfternull2474 function TATTabs.DoPaintAfter(AElemType: TATTabElemType;
2475 AIndex: integer; ACanvas: TCanvas; const ARect: TRect): boolean;
2476 begin
2477 Result:= true;
2478 if Assigned(FOnTabDrawAfter) then
2479 FOnTabDrawAfter(Self, AElemType, AIndex, ACanvas, ARect, Result);
2480 end;
2481
2482 procedure TATTabs.DoPaintBgTo(C: TCanvas; const ARect: TRect);
2483 begin
2484 C.Brush.Color:= FColorBg;
2485 C.FillRect(ARect);
2486 end;
2487
2488 procedure TATTabs.DoPaintSpacerRect(C: TCanvas);
2489 var
2490 ElemType: TATTabElemType;
2491 RBottom: TRect;
2492 NLineX1, NLineY1, NLineX2, NLineY2: integer;
2493 begin
2494 if FOptMultiline and FScrollingNeeded then exit;
2495
2496 case FOptPosition of
2497 atpTop:
2498 begin
2499 if FOptMultiline then
2500 RBottom:= Rect(0, Height-DoScale(FOptSpacer2), Width, Height)
2501 else
2502 RBottom:= Rect(0, DoScale(FOptSpacer)+DoScale(FOptTabHeight), Width, Height);
2503 NLineX1:= RBottom.Left;
2504 NLineY1:= RBottom.Top;
2505 NLineX2:= RBottom.Right;
2506 NLineY2:= RBottom.Top;
2507 end;
2508 atpBottom:
2509 begin
2510 RBottom:= Rect(0, 0, Width, DoScale(FOptSpacer));
2511 NLineX1:= RBottom.Left;
2512 NLineY1:= RBottom.Bottom;
2513 NLineX2:= RBottom.Right;
2514 NLineY2:= RBottom.Bottom;
2515 end;
2516 atpLeft:
2517 begin
2518 RBottom:= Rect(Width-DoScale(FOptSpacer2), 0, Width, Height);
2519 NLineX1:= RBottom.Left;
2520 NLineY1:= RBottom.Top;
2521 NLineX2:= RBottom.Left;
2522 NLineY2:= RBottom.Bottom;
2523 end;
2524 atpRight:
2525 begin
2526 RBottom:= Rect(0, 0, DoScale(FOptSpacer2), Height);
2527 NLineX1:= RBottom.Right;
2528 NLineY1:= RBottom.Top;
2529 NLineX2:= RBottom.Right;
2530 NLineY2:= RBottom.Bottom;
2531 end;
2532 else
2533 raise Exception.Create('Unknown tab pos');
2534 end;
2535
2536 ElemType:= aeSpacerRect;
2537 if IsPaintNeeded(ElemType, -1, C, RBottom) then
2538 begin
2539 C.Brush.Color:= FColorTabActive;
2540 C.FillRect(RBottom);
2541 DrawLine(C, NLineX1, NLineY1, NLineX2, NLineY2, FColorBorderActive);
2542 DoPaintAfter(ElemType, -1, C, RBottom);
2543 end;
2544 end;
2545
2546 procedure TATTabs.DoPaintTo(C: TCanvas);
2547 var
2548 RRect, RectX: TRect;
2549 NColorFont: TColor;
2550 ElemType: TATTabElemType;
2551 Data: TATTabData;
2552 NFontStyle: TFontStyles;
2553 bMouseOver, bMouseOverX: boolean;
2554 Info: TATTabPaintInfo;
2555 i: integer;
2556 begin
2557 FActualMultiline:= (FOptPosition in [atpLeft, atpRight]) or FOptMultiline;
2558
2559 ElemType:= aeBackground;
2560 RRect:= ClientRect;
2561
2562 if not ATTabsStretchDrawEnabled then
2563 FLastSpaceSide:= 0
2564 else
2565 if Width>=DoScale(FOptMinimalWidthForSides) then
2566 FLastSpaceSide:= FOptSpaceSide
2567 else
2568 FLastSpaceSide:= 0;
2569
2570 //update index here, because user can add/del tabs by keyboard
2571 with ScreenToClient(Mouse.CursorPos) do
2572 FTabIndexOver:= GetTabAt(X, Y, bMouseOverX);
2573
2574 FLastOverIndex:= FTabIndexOver;
2575 FLastOverX:= bMouseOverX;
2576
2577 FRealIndentLeft:= DoScale(FOptSpaceInitial) + GetButtonsWidth(FButtonsLeft);
2578 FRealIndentRight:= DoScale(FOptSpaceInitial) + GetButtonsWidth(FButtonsRight);
2579
2580 FRectArrowLeft:= GetRectOfButton(atbScrollLeft);
2581 FRectArrowRight:= GetRectOfButton(atbScrollRight);
2582 FRectArrowDown:= GetRectOfButton(atbDropdownMenu);
2583 FRectButtonPlus:= GetRectOfButton(atbPlus);
2584 FRectButtonClose:= GetRectOfButton(atbClose);
2585 FRectButtonUser0:= GetRectOfButton(atbUser0);
2586 FRectButtonUser1:= GetRectOfButton(atbUser1);
2587 FRectButtonUser2:= GetRectOfButton(atbUser2);
2588 FRectButtonUser3:= GetRectOfButton(atbUser3);
2589 FRectButtonUser4:= GetRectOfButton(atbUser4);
2590
2591 //painting of BG is little different then other elements:
2592 //paint fillrect anyway, then maybe paint ownerdraw
2593 DoPaintBgTo(C, RRect);
2594 if IsPaintNeeded(ElemType, -1, C, RRect) then
2595 begin
2596 DoPaintAfter(ElemType, -1, C, RRect);
2597 end;
2598
2599 C.Font.Assign(Self.Font);
2600 UpdateTabWidths;
2601 UpdateTabRects(C);
2602 UpdateTabRectsSpecial;
2603 UpdateTabPropsX;
2604 FScrollingNeeded:= GetScrollMarkNeeded;
2605
2606 //paint spacer rect
2607 if not FOptShowFlat then
2608 DoPaintSpacerRect(C);
2609
2610 //paint "plus" tab
2611 if FOptShowPlusTab then
2612 begin
2613 DoPaintPlus(C, FRectTabPlus_Scrolled);
2614 end;
2615
2616 //paint passive tabs
2617 for i:= TabCount-1 downto 0 do
2618 if i<>FTabIndex then
2619 begin
2620 Data:= GetTabData(i);
2621 if Data=nil then Continue;
2622
2623 RRect:= GetRectScrolled(Data.TabRect);
2624 if RRect=cRect0 then Continue;
2625
2626 GetTabXProps(i, RRect, bMouseOverX, RectX);
2627 bMouseOver:= i=FTabIndexOver;
2628
2629 if bMouseOver then
2630 ElemType:= aeTabPassiveOver
2631 else
2632 ElemType:= aeTabPassive;
2633
2634 if IsPaintNeeded(ElemType, i, C, RRect) then
2635 begin
2636 if not Data.TabVisible then Continue;
2637
2638 if FOptHotFontStyleUsed and bMouseOver then
2639 NFontStyle:= FOptHotFontStyle
2640 else
2641 NFontStyle:= Data.TabFontStyle;
2642
2643 if (FColorFontHot<>clNone) and bMouseOver then
2644 NColorFont:= FColorFontHot
2645 else
2646 if Data.TabModified then
2647 NColorFont:= FColorFontModified
2648 else
2649 NColorFont:= FColorFont;
2650
2651 Info.Clear;
2652 Info.Rect:= RRect;
2653 Info.Caption:= GetTabCaptionFinal(Data, i);
2654 Info.Modified:= Data.TabModified;
2655 Info.Pinned:= Data.TabPinned;
2656 Info.TabIndex:= i;
2657 Info.ColorFont:= NColorFont;
2658 Info.TabMouseOver:= bMouseOver;
2659 Info.TabMouseOverX:= bMouseOverX;
2660 Info.FontStyle:= NFontStyle;
2661
2662 DoPaintTabTo(C, Info);
2663 DoPaintAfter(ElemType, i, C, RRect);
2664 end;
2665
2666 if Data.TabVisibleX then
2667 begin
2668 Info.Clear;
2669 Info.Rect:= RectX;
2670 Info.TabIndex:= i;
2671 Info.TabMouseOverX:= bMouseOverX;
2672 DoPaintX(C, Info);
2673 end;
2674 end;
2675
2676 //paint active tab
2677 i:= FTabIndex;
2678 if IsIndexOk(i) then
2679 begin
2680 Data:= GetTabData(i);
2681 if Assigned(Data) and Data.TabVisible then
2682 begin
2683 RRect:= GetRectScrolled(Data.TabRect);
2684 GetTabXProps(i, RRect, bMouseOverX, RectX);
2685
2686 bMouseOver:= i=FTabIndexOver;
2687
2688 if IsPaintNeeded(aeTabActive, i, C, RRect) then
2689 begin
2690 if FOptActiveFontStyleUsed then
2691 NFontStyle:= FOptActiveFontStyle
2692 else
2693 NFontStyle:= Data.TabFontStyle;
2694
2695 if FColorFontActive<>clNone then
2696 NColorFont:= FColorFontActive
2697 else
2698 if Data.TabModified then
2699 NColorFont:= FColorFontModified
2700 else
2701 NColorFont:= FColorFont;
2702
2703 Info.Clear;
2704 Info.Rect:= RRect;
2705 Info.Caption:= GetTabCaptionFinal(Data, i);
2706 Info.Modified:= Data.TabModified;
2707 Info.Pinned:= Data.TabPinned;
2708 Info.TabIndex:= i;
2709 Info.ColorFont:= NColorFont;
2710 Info.TabActive:= true;
2711 Info.TabMouseOver:= bMouseOver;
2712 Info.TabMouseOverX:= bMouseOverX;
2713 Info.FontStyle:= NFontStyle;
2714
2715 DoPaintTabTo(C, Info);
2716 DoPaintAfter(aeTabActive, i, C, RRect);
2717 end;
2718
2719 if Data.TabVisibleX then
2720 begin
2721 Info.Clear;
2722 Info.Rect:= RectX;
2723 Info.TabIndex:= i;
2724 Info.TabActive:= true;
2725 Info.TabMouseOverX:= bMouseOverX;
2726 DoPaintX(C, Info);
2727 end;
2728 end;
2729 end;
2730
2731 //button back
2732 DoPaintButtonsBG(C);
2733 //buttons
2734 DoPaintArrowLeft(C);
2735 DoPaintArrowRight(C);
2736 DoPaintArrowDown(C);
2737 DoPaintButtonPlus(C);
2738 DoPaintButtonClose(C);
2739 DoPaintUserButtons(C, FButtonsLeft, true);
2740 DoPaintUserButtons(C, FButtonsRight, false);
2741
2742 if FOptShowDropMark then
2743 if _IsDrag then
2744 if PtInControl(Self, Mouse.CursorPos) then
2745 DoPaintDropMark(C);
2746
2747 if FOptShowScrollMark then
2748 DoPaintScrollMark(C);
2749 end;
2750
2751 procedure TATTabs.DoTextOut(C: TCanvas; AX, AY: integer;
2752 const AClipRect: TRect; const AText: string);
2753 {$ifdef WIDE}
2754 var
2755 Str: WideString;
2756 begin
2757 Str:= UTF8Decode(AText);
2758 ExtTextOutW(C.Handle, AX, AY, ETO_CLIPPED, @AClipRect,
2759 PWideChar(Str), Length(Str), nil);
2760 end;
2761 {$else}
2762 begin
2763 ExtTextOut(C.Handle, AX, AY, ETO_CLIPPED, @AClipRect,
2764 PChar(AText), Length(AText), nil);
2765 end;
2766 {$endif}
2767
2768 procedure TATTabs.DoPaintDropMark(C: TCanvas);
2769 var
2770 D: TATTabData;
2771 R: TRect;
2772 N: integer;
2773 begin
2774 N:= FTabIndexDrop;
2775 if N<0 then
2776 N:= TabCount-1;
2777 //if N<>FTabIndex then
2778 begin
2779 D:= GetTabData(N);
2780 if D=nil then Exit;
2781 R:= GetRectScrolled(D.TabRect);
2782
2783 case FOptPosition of
2784 atpTop,
2785 atpBottom:
2786 begin
2787 R.Left:= IfThen(N<=FTabIndex, R.Left, R.Right);
2788 R.Left:= R.Left - DoScale(FOptDropMarkSize) div 2;
2789 R.Right:= R.Left + DoScale(FOptDropMarkSize);
2790 end;
2791 else
2792 begin
2793 R.Top:= IfThen(N<=FTabIndex, R.Top, R.Bottom);
2794 R.Top:= R.Top - DoScale(FOptDropMarkSize) div 2;
2795 R.Bottom:= R.Top + DoScale(FOptDropMarkSize);
2796 end;
2797 end;
2798
2799 C.Brush.Color:= FColorDropMark;
2800 C.FillRect(R);
2801 end;
2802 end;
2803
2804
GetScrollMarkNeedednull2805 function TATTabs.GetScrollMarkNeeded: boolean;
2806 begin
2807 if TabCount=0 then
2808 Result:= false
2809 else
2810 if FScrollPos>0 then
2811 Result:= true
2812 else
2813 case FOptPosition of
2814 atpTop,
2815 atpBottom:
2816 begin
2817 if not FOptVarWidth and not FOptMultiline then
2818 Result:= FTabWidth<=DoScale(FOptTabWidthMinimal)
2819 else
2820 Result:= GetMaxScrollPos>0;
2821 end;
2822 else
2823 begin
2824 Result:= GetMaxScrollPos>0;
2825 end;
2826 end;
2827 end;
2828
2829 procedure TATTabs.DoPaintScrollMark(C: TCanvas);
2830 var
2831 NPos, NSize, NIndent: integer;
2832 R: TRect;
2833 begin
2834 if not FScrollingNeeded then exit;
2835
2836 if not FActualMultiline then
2837 begin
2838 NPos:= GetMaxScrollPos;
2839 NSize:= Width - FRealIndentLeft - FRealIndentRight;
2840
2841 if NPos>0 then
2842 begin
2843 R.Top:= IfThen(FOptPosition=atpBottom, DoScale(FOptTabHeight) + DoScale(FOptSpacer), 0);
2844 R.Bottom:= R.Top + DoScale(FOptScrollMarkSizeY);
2845
2846 R.Left:= FRealIndentLeft +
2847 Max(0, Min(
2848 NSize-DoScale(FOptScrollMarkSizeX),
2849 Int64(FScrollPos) * (NSize-DoScale(FOptScrollMarkSizeX)) div NPos
2850 ));
2851 R.Right:= R.Left + DoScale(FOptScrollMarkSizeX);
2852
2853 C.Brush.Color:= FColorScrollMark;
2854 C.FillRect(R);
2855 end;
2856 end
2857 else
2858 begin
2859 NIndent:= GetInitialVerticalIndent;
2860 NPos:= GetMaxScrollPos;
2861 NSize:= Height-NIndent;
2862
2863 if NPos>0 then
2864 begin
2865 R.Top:= NIndent +
2866 Max(0, Min(
2867 NSize - DoScale(FOptScrollMarkSizeX),
2868 Int64(FScrollPos) * (NSize-DoScale(FOptScrollMarkSizeX)) div NPos
2869 ));
2870 R.Bottom:= R.Top + DoScale(FOptScrollMarkSizeX);
2871
2872 if FOptPosition=atpLeft then
2873 begin
2874 R.Left:= 0;
2875 R.Right:= R.Left + DoScale(FOptScrollMarkSizeY);
2876 end
2877 else
2878 begin
2879 R.Right:= Width;
2880 R.Left:= R.Right - DoScale(FOptScrollMarkSizeY);
2881 end;
2882
2883 C.Brush.Color:= FColorScrollMark;
2884 C.FillRect(R);
2885 end;
2886 end;
2887 end;
2888
2889 procedure TATTabs.SetOptButtonLayout(const AValue: string);
2890 begin
2891 //if FOptButtonLayout=AValue then Exit;
2892 FOptButtonLayout:= AValue;
2893 ApplyButtonLayout;
2894 Invalidate;
2895 end;
2896
2897 procedure TATTabs.SetOptScalePercents(AValue: integer);
2898 begin
2899 if FOptScalePercents=AValue then Exit;
2900 FOptScalePercents:= AValue;
2901 ApplyButtonLayout;
2902 Invalidate;
2903 end;
2904
2905 procedure TATTabs.SetOptVarWidth(AValue: boolean);
2906 begin
2907 if FOptVarWidth=AValue then Exit;
2908 FOptVarWidth:= AValue;
2909 if not AValue then
2910 FScrollPos:= 0;
2911 Invalidate;
2912 end;
2913
2914
GetTabAtnull2915 function TATTabs.GetTabAt(AX, AY: integer; out APressedX: boolean): integer;
2916 var
2917 Pnt: TPoint;
2918 RectTab: TRect;
2919 D: TATTabData;
2920 ok: boolean;
2921 i: integer;
2922 begin
2923 Result:= cTabIndexNone;
2924 APressedX:= false;
2925 Pnt:= Point(AX, AY);
2926
2927 if PtInRect(FRectArrowLeft, Pnt) then
2928 begin
2929 Result:= cTabIndexArrowScrollLeft;
2930 Exit
2931 end;
2932
2933 if PtInRect(FRectArrowRight, Pnt) then
2934 begin
2935 Result:= cTabIndexArrowScrollRight;
2936 Exit
2937 end;
2938
2939 if PtInRect(FRectArrowDown, Pnt) then
2940 begin
2941 Result:= cTabIndexArrowMenu;
2942 Exit
2943 end;
2944
2945 if PtInRect(FRectButtonPlus, Pnt) then
2946 begin
2947 Result:= cTabIndexPlusBtn;
2948 Exit
2949 end;
2950
2951 if PtInRect(FRectButtonClose, Pnt) then
2952 begin
2953 Result:= cTabIndexCloseBtn;
2954 Exit
2955 end;
2956
2957 if PtInRect(FRectButtonUser0, Pnt) then
2958 begin
2959 Result:= cTabIndexUser0;
2960 Exit
2961 end;
2962
2963 if PtInRect(FRectButtonUser1, Pnt) then
2964 begin
2965 Result:= cTabIndexUser1;
2966 Exit
2967 end;
2968
2969 if PtInRect(FRectButtonUser2, Pnt) then
2970 begin
2971 Result:= cTabIndexUser2;
2972 Exit
2973 end;
2974
2975 if PtInRect(FRectButtonUser3, Pnt) then
2976 begin
2977 Result:= cTabIndexUser3;
2978 Exit
2979 end;
2980
2981 if PtInRect(FRectButtonUser4, Pnt) then
2982 begin
2983 Result:= cTabIndexUser4;
2984 Exit
2985 end;
2986
2987 //normal tab?
2988 for i:= 0 to TabCount-1 do
2989 begin
2990 D:= GetTabData(i);
2991 if D=nil then Continue;
2992 if not D.TabVisible then Continue;
2993
2994 RectTab:= GetRectScrolled(D.TabRect);
2995 if RectTab=cRect0 then Continue;
2996
2997 if FActualMultiline then
2998 begin
2999 if RectTab.Top>Pnt.Y then Break;
3000 end
3001 else
3002 begin
3003 if RectTab.Left>Pnt.X then Break;
3004 end;
3005
3006 if PtInRect(RectTab, Pnt) then
3007 begin
3008 Result:= i;
3009 APressedX:= D.TabVisibleX and PtInRect(GetRectScrolled(D.TabRectX), Pnt);
3010 Exit;
3011 end;
3012 end;
3013
3014 //plus tab?
3015 if FOptShowPlusTab then
3016 if PtInRect(FRectTabPlus_Scrolled, Pnt) then
3017 begin
3018 Result:= cTabIndexPlus;
3019 Exit
3020 end;
3021
3022 //empty area after last tab?
3023 RectTab:= FRectTabLast_Scrolled;
3024 if RectTab<>cRect0 then
3025 begin
3026 if FOptPosition in [atpTop, atpBottom] then
3027 ok:= (AX>=RectTab.Right) and (AY>=RectTab.Top) and (AY<RectTab.Bottom)
3028 else
3029 ok:= (AY>=RectTab.Bottom) and (AX>=RectTab.Left) and (AX<RectTab.Right);
3030 if ok then
3031 begin
3032 Result:= cTabIndexEmptyArea;
3033 Exit;
3034 end;
3035 end;
3036 end;
3037
3038 procedure TATTabs.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
3039 var
3040 IsClick, IsDblClick: boolean;
3041 begin
3042 inherited;
3043 IsClick:= FMouseDown and
3044 (Abs(X-FMouseDownPnt.X) < cTabsMouseMaxDistanceToClick) and
3045 (Abs(Y-FMouseDownPnt.Y) < cTabsMouseMaxDistanceToClick);
3046 IsDblClick:= IsClick and FMouseDownDbl;
3047 //IsRightClick:= FMouseDownRightBtn and
3048 // (Abs(X-FMouseDownPnt.X) < cTabsMouseMaxDistanceToClick) and
3049 // (Abs(Y-FMouseDownPnt.Y) < cTabsMouseMaxDistanceToClick);
3050
3051 FMouseDown:= false;
3052 FMouseDownDbl:= false;
3053 FMouseDownRightBtn:= false;
3054 FMouseDragBegins:= false;
3055 Cursor:= crDefault;
3056 Screen.Cursor:= crDefault;
3057
3058 if IsDblClick then
3059 begin
3060 if Assigned(FOnTabDblClick) and (FTabIndexOver>=0) then
3061 FOnTabDblClick(Self, FTabIndexOver);
3062
3063 if FOptMouseDoubleClickClose and (FTabIndexOver>=0) then
3064 DeleteTab(FTabIndexOver, true, true)
3065 else
3066 if FOptMouseDoubleClickPlus and (FTabIndexOver=cTabIndexEmptyArea) then
3067 if Assigned(FOnTabPlusClick) then
3068 FOnTabPlusClick(Self);
3069 Exit
3070 end;
3071
3072 if IsClick then
3073 begin
3074 DoHandleClick;
3075 Invalidate;
3076 Exit
3077 end;
3078 end;
3079
3080 procedure TATTabs.MouseDown(Button: TMouseButton; Shift: TShiftState;
3081 X, Y: integer);
3082 var
3083 IsX: boolean;
3084 begin
3085 inherited;
3086 FMouseDown:= Button in [mbLeft, mbMiddle]; //but not mbRight
3087 FMouseDownRightBtn:= (Button = mbRight);
3088 FMouseDownPnt:= Point(X, Y);
3089 FMouseDownButton:= Button;
3090 FMouseDownShift:= Shift;
3091 FMouseDragBegins:= false;
3092
3093 FTabIndexOver:= GetTabAt(X, Y, IsX);
3094
3095 //activate tab only if not X clicked
3096 if not IsX then
3097 //if TabIndex<>FTabIndexOver then //with this check, CudaText cannot focus active tab in passive tab-group
3098 TabIndex:= FTabIndexOver;
3099
3100 Invalidate;
3101 end;
3102
3103
3104 procedure TATTabs.DoHandleClick;
3105 var
3106 Action: TATTabActionOnClose;
3107 D: TATTabData;
3108 R: TRect;
3109 begin
3110 if FMouseDownButton=mbMiddle then
3111 begin
3112 if FOptMouseMiddleClickClose then
3113 if FTabIndexOver>=0 then
3114 DeleteTab(FTabIndexOver, true, true);
3115 Exit;
3116 end;
3117
3118 if FMouseDownButton=mbLeft then
3119 begin
3120 case FTabIndexOver of
3121 cTabIndexArrowMenu:
3122 begin
3123 EndDrag(false);
3124 FTabIndexOver:= -1;
3125 Invalidate;
3126 ShowTabMenu;
3127 end;
3128
3129 cTabIndexArrowScrollLeft:
3130 DoScrollLeft;
3131
3132 cTabIndexArrowScrollRight:
3133 DoScrollRight;
3134
3135 cTabIndexUser0:
3136 DoClickUser(0);
3137 cTabIndexUser1:
3138 DoClickUser(1);
3139 cTabIndexUser2:
3140 DoClickUser(2);
3141 cTabIndexUser3:
3142 DoClickUser(3);
3143 cTabIndexUser4:
3144 DoClickUser(4);
3145
3146 cTabIndexPlus,
3147 cTabIndexPlusBtn:
3148 begin
3149 EndDrag(false);
3150 FTabIndexOver:= -1;
3151 if Assigned(FOnTabPlusClick) then
3152 FOnTabPlusClick(Self);
3153 end;
3154
3155 cTabIndexCloseBtn:
3156 begin
3157 Action:= aocDefault;
3158 if Assigned(FOnTabGetCloseAction) then
3159 FOnTabGetCloseAction(Self, Action);
3160 DeleteTab(FTabIndex, true, true, Action);
3161 end
3162
3163 else
3164 begin
3165 D:= GetTabData(FTabIndexOver);
3166 if Assigned(D) and D.TabVisibleX then
3167 begin
3168 R:= GetRectScrolled(D.TabRectX);
3169 if PtInRect(R, FMouseDownPnt) then
3170 begin
3171 EndDrag(false);
3172 DeleteTab(FTabIndexOver, true, true);
3173 exit
3174 end;
3175 end;
3176
3177 {
3178 //normal click on tab caption - was handled on MouseDown before
3179 if Assigned(FOnTabClick) then
3180 FOnTabClick(Self);
3181 }
3182 end;
3183 end;
3184 end;
3185 end;
3186
3187 procedure TATTabs.DoHandleRightClick;
3188 var
3189 P: TPoint;
3190 D: TATTabData;
3191 begin
3192 if (FTabIndex=FTabIndexOver) then // to check if click was processed as a valid click on a tab
3193 begin
3194 D:= GetTabData(FTabIndex);
3195 if Assigned(D) and Assigned(D.TabPopupMenu) then
3196 begin
3197 P:= ClientToScreen(FMouseDownPnt);
3198 D.TabPopupMenu.PopUp(P.X, P.Y);
3199 end;
3200 end;
3201 end;
3202
3203 type
3204 TControlHack = class(TControl);
3205
3206 procedure TATTabs.MouseMove(Shift: TShiftState; X, Y: integer);
3207 var
3208 IsX: boolean;
3209 Data: TATTabData;
3210 begin
3211 inherited;
3212
3213 if TabCount=0 then
3214 begin
3215 Invalidate; //cleans up <> v and x highlights if no tabs
3216 exit;
3217 end;
3218
3219 // LCL dragging with DragMode=automatic is started too early.
3220 // so use DragMode=manual and DragStart.
3221 if OptMouseDragEnabled and FMouseDown and (FMouseDownButton=mbLeft) and not _IsDrag then
3222 begin
3223 BeginDrag(false, Mouse.DragThreshold);
3224 {$ifdef fpc}
3225 //needed for Lazarus, when dragging tab below the control to another ATTabs
3226 //but it's bad for Delphi
3227 Screen.Cursor:= crDrag;
3228 {$endif}
3229 Exit
3230 end;
3231
3232 FTabIndexOver:= GetTabAt(X, Y, IsX);
3233 FTabIndexDrop:= FTabIndexOver;
3234 if FTabIndexOver=cTabIndexNone then exit;
3235 Data:= nil;
3236
3237 if ShowHint then
3238 begin
3239 if IsX then
3240 FTabIndexHinted:= cTabIndexCloseBtn
3241 else
3242 FTabIndexHinted:= FTabIndexOver;
3243
3244 if FTabIndexHinted<>FTabIndexHintedPrev then
3245 begin
3246 FTabIndexHintedPrev:= FTabIndexHinted;
3247 Hint:= '';
3248 case FTabIndexHinted of
3249 cTabIndexPlus,
3250 cTabIndexPlusBtn:
3251 Hint:= FHintForPlus;
3252 cTabIndexArrowScrollLeft:
3253 Hint:= FHintForArrowLeft;
3254 cTabIndexArrowScrollRight:
3255 Hint:= FHintForArrowRight;
3256 cTabIndexArrowMenu:
3257 Hint:= FHintForArrowMenu;
3258 cTabIndexCloseBtn:
3259 Hint:= FHintForX;
3260 cTabIndexUser0:
3261 Hint:= FHintForUser0;
3262 cTabIndexUser1:
3263 Hint:= FHintForUser1;
3264 cTabIndexUser2:
3265 Hint:= FHintForUser2;
3266 cTabIndexUser3:
3267 Hint:= FHintForUser3;
3268 cTabIndexUser4:
3269 Hint:= FHintForUser4;
3270 0..10000:
3271 begin
3272 Data:= GetTabData(FTabIndexOver);
3273 if Assigned(Data) and (Data.TabHint<>'') then
3274 Hint:= Data.TabHint;
3275 end;
3276 end; //case
3277
3278 if Hint<>'' then
3279 Application.ActivateHint(Mouse.CursorPos)
3280 else
3281 begin
3282 Application.HideHint;
3283 FTabIndexHintedPrev:= cTabIndexNone;
3284 end;
3285 end;
3286 end; //if ShowHint
3287
3288 if Assigned(Data) then
3289 if Assigned(FOnTabOver) then
3290 FOnTabOver(Self, FTabIndexOver);
3291
3292 //repaint only if really needed
3293 //use {$define tab_paint_counter} to debug it
3294 if (FTabIndexOver<>FLastOverIndex) or (IsX<>FLastOverX) then
3295 begin
3296 Invalidate;
3297 end;
3298 end;
3299
TATTabs.DoMouseWheelnull3300 function TATTabs.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean;
3301 var
3302 bToRight: boolean;
3303 bSwitchTab: boolean;
3304 begin
3305 Result:= false;
3306 bSwitchTab:= false;
3307
3308 case FOptMouseWheelMode of
3309 amwIgnoreWheel:
3310 exit;
3311 amwNormalScroll:
3312 begin
3313 bSwitchTab:= ssShift in Shift;
3314 if bSwitchTab then exit;
3315 end;
3316 amwNormalScrollAndShiftSwitch:
3317 begin
3318 bSwitchTab:= ssShift in Shift;
3319 end;
3320 amwNormalSwitch:
3321 begin
3322 bSwitchTab:= not (ssShift in Shift);
3323 if not bSwitchTab then exit;
3324 end;
3325 amwNormalSwitchAndShiftScroll:
3326 begin
3327 bSwitchTab:= not (ssShift in Shift);
3328 end;
3329 end;
3330
3331 bToRight:= WheelDelta<0;
3332
3333 if bSwitchTab then
3334 begin
3335 SwitchTab(bToRight, false{LoopAtEdge});
3336 end
3337 else
3338 begin
3339 if bToRight then
3340 DoScrollRight
3341 else
3342 DoScrollLeft;
3343 end;
3344
3345 Result:= true;
3346 end;
3347
3348 procedure TATTabs.Resize;
3349 begin
3350 inherited;
3351 FTabsResized:= true;
3352
3353 if Assigned(FBitmap) then
3354 BitmapResizeBySteps(FBitmap, Width, Height);
3355
3356 if FOptActiveVisibleOnResize then
3357 if FTabIndex>=0 then
3358 MakeVisible(FTabIndex);
3359
3360 //auto-scroll tabs to right when width is shrinked
3361 if FScrollPos>0 then
3362 FScrollPos:= Min(FScrollPos, GetMaxScrollPos);
3363
3364 Invalidate;
3365 end;
3366
3367
TATTabs.AddTabnull3368 function TATTabs.AddTab(
3369 AIndex: integer;
3370 const ACaption: TATTabString;
3371 AObject: TObject = nil;
3372 AModified: boolean = false;
3373 AColor: TColor = clNone;
3374 AImageIndex: TImageIndex = -1): TATTabData;
3375 var
3376 Data: TATTabData;
3377 begin
3378 FTabsChanged:= true;
3379
3380 Data:= TATTabData(FTabList.Add);
3381 if IsIndexOk(AIndex) then
3382 Data.Index:= AIndex
3383 else
3384 AIndex:= TabCount-1;
3385
3386 Data.TabCaption:= ACaption;
3387 //Data.TabHint:= AHint;
3388 Data.TabObject:= AObject;
3389 Data.TabModified:= AModified;
3390 Data.TabColor:= AColor;
3391 Data.TabImageIndex:= AImageIndex;
3392 //Data.TabPopupMenu:= APopupMenu;
3393 //Data.TabFontStyle:= AFontStyle;
3394 //Data.TabSpecial:= ASpecial;
3395
3396 FTabIndexHinted:= cTabIndexNone;
3397 FTabIndexHintedPrev:= cTabIndexNone;
3398
3399 Invalidate;
3400
3401 if Assigned(FOnTabMove) then
3402 FOnTabMove(Self, -1, AIndex);
3403
3404 Result:= Data;
3405 end;
3406
3407 procedure TATTabs.AddTab(AIndex: integer; AData: TATTabData);
3408 var
3409 Data: TATTabData;
3410 begin
3411 Data:= TATTabData(FTabList.Add);
3412 Data.Assign(AData);
3413 if IsIndexOk(AIndex) then
3414 Data.Index:= AIndex
3415 else
3416 begin
3417 AIndex:= TabCount-1;
3418 Data.Index:= AIndex;
3419 end;
3420
3421 FTabIndexHinted:= cTabIndexNone;
3422 FTabIndexHintedPrev:= cTabIndexNone;
3423
3424 Invalidate;
3425
3426 if Assigned(FOnTabMove) then
3427 FOnTabMove(Self, -1, AIndex);
3428 end;
3429
TATTabs.DeleteTabnull3430 function TATTabs.DeleteTab(AIndex: integer;
3431 AAllowEvent, AWithCancelBtn: boolean;
3432 AAction: TATTabActionOnClose=aocDefault): boolean;
3433 //
3434 procedure _ActivateRightTab;
3435 begin
3436 if FTabIndex>AIndex then
3437 SetTabIndexEx(FTabIndex-1, true)
3438 else
3439 if (FTabIndex=AIndex) and (FTabIndex>0) and (FTabIndex>=TabCount) then
3440 SetTabIndex(FTabIndex-1)
3441 else
3442 if FTabIndex=AIndex then
3443 SetTabIndex(FTabIndex);
3444 end;
3445 //
3446 procedure _ActivateRecentTab;
3447 var
3448 Idx, i: integer;
3449 Tick, TickMax: Int64;
3450 begin
3451 TickMax:= 0;
3452 Idx:= -1;
3453 for i:= 0 to TabCount-1 do
3454 begin
3455 Tick:= GetTabTick(i);
3456 if Tick>TickMax then
3457 begin
3458 TickMax:= Tick;
3459 Idx:= i;
3460 end;
3461 end;
3462 if Idx>=0 then
3463 SetTabIndex(Idx)
3464 else
3465 _ActivateRightTab;
3466 end;
3467 //
3468 var
3469 CanClose, CanContinue: boolean;
3470 NMax: integer;
3471 begin
3472 FTabsChanged:= true;
3473 FMouseDown:= false;
3474
3475 if AAllowEvent then
3476 begin
3477 CanClose:= true;
3478 CanContinue:= AWithCancelBtn;
3479
3480 if Assigned(FOnTabClose) then
3481 FOnTabClose(Self, AIndex, CanClose, CanContinue);
3482
3483 if AWithCancelBtn and not CanContinue then
3484 begin Result:= false; Exit end;
3485 if not CanClose then
3486 begin Result:= true; Exit end;
3487 end;
3488
3489 if IsIndexOk(AIndex) then
3490 begin
3491 FTabIndexHinted:= cTabIndexNone;
3492 FTabIndexHintedPrev:= cTabIndexNone;
3493
3494 FTabList.Delete(AIndex);
3495
3496 if AAction=aocDefault then
3497 AAction:= FOptWhichActivateOnClose;
3498
3499 case AAction of
3500 aocNone:
3501 begin end;
3502 aocRight:
3503 _ActivateRightTab;
3504 aocRecent:
3505 _ActivateRecentTab;
3506 else
3507 _ActivateRightTab;
3508 end;
3509
3510 //if lot of tabs were opened, and closed last tab, need to scroll all tabs righter
3511 NMax:= GetMaxScrollPos;
3512 if ScrollPos>NMax then
3513 ScrollPos:= NMax;
3514
3515 Invalidate;
3516
3517 if (TabCount=0) then
3518 if Assigned(FOnTabEmpty) then
3519 FOnTabEmpty(Self);
3520
3521 if Assigned(FOnTabMove) then
3522 FOnTabMove(Self, AIndex, -1);
3523 end;
3524
3525 Result:= true;
3526 end;
3527
3528 procedure TATTabs.SetTabIndex(AIndex: integer);
3529 begin
3530 SetTabIndexEx(AIndex, false);
3531 end;
3532
3533 procedure TATTabs.SetTabIndexEx(AIndex: integer; ADisableEvent: boolean);
3534 //note: check "if AIndex=FTabIndex" must not be here, must be in outer funcs.
3535 //Sometimes SetTabIndex(TabIndex) is used in CudaText: do focus of clicked tab, and in DeleteTab.
3536 var
3537 CanChange, DisableEvent, TabChanged: boolean;
3538 begin
3539 if csLoading in ComponentState then
3540 FTabIndexLoaded:= AIndex;
3541 DisableEvent:= (csLoading in ComponentState) or ADisableEvent;
3542 TabChanged:= AIndex<>FTabIndex;
3543
3544 if IsIndexOk(AIndex) then
3545 begin
3546 CanChange:= true;
3547 if Assigned(FOnTabChangeQuery) then
3548 begin
3549 FOnTabChangeQuery(Self, AIndex, CanChange);
3550 if not CanChange then Exit;
3551 end;
3552
3553 FTabIndex:= AIndex;
3554
3555 MakeVisible(AIndex);
3556 Invalidate;
3557
3558 if not DisableEvent then
3559 begin
3560 if Assigned(FOnTabClick) then
3561 FOnTabClick(Self);
3562
3563 if Assigned(FOnTabChanged) and TabChanged then
3564 FOnTabChanged(Self);
3565 end;
3566 end;
3567 end;
3568
TATTabs.HideTabnull3569 function TATTabs.HideTab(AIndex: integer): boolean;
3570 begin
3571 Result:= IsIndexOk(AIndex);
3572 if Result then
3573 begin
3574 GetTabData(AIndex).TabVisible:= false;
3575 // if the deleted tab has focus then this needs to shift to the next
3576 // tab or - if there are none - to the first
3577 if AIndex=TabIndex then
3578 begin
3579 if IsIndexOk(AIndex+1) then
3580 SetTabIndex(AIndex+1)
3581 else
3582 SetTabIndex(0);
3583 end;
3584 end;
3585 end;
3586
ShowTabnull3587 function TATTabs.ShowTab(AIndex: integer): boolean;
3588 begin
3589 Result:= IsIndexOk(AIndex);
3590 if Result then
3591 begin
3592 GetTabData(AIndex).TabVisible:= true;
3593 SetTabIndex(AIndex);
3594 end;
3595 end;
3596
GetTabDatanull3597 function TATTabs.GetTabData(AIndex: integer): TATTabData;
3598 begin
3599 if IsIndexOk(AIndex) then
3600 Result:= TATTabData(FTabList.Items[AIndex])
3601 else
3602 Result:= nil;
3603 end;
3604
3605 {$ifdef windows}
3606 //needed to remove flickering on resize and mouse-over
3607 procedure TATTabs.WMEraseBkgnd(var Message: TMessage);
3608 begin
3609 Message.Result:= 1;
3610 end;
3611 {$endif}
3612
3613 procedure TATTabs.DoPaintArrowTo(C: TCanvas; ATyp: TATTabTriangle; ARect: TRect;
3614 AActive, AEnabled: boolean);
3615 var
3616 Pic: TATTabsPicture;
3617 NColor: TColor;
3618 begin
3619 if FThemed then
3620 begin
3621 if AActive then
3622 case ATyp of
3623 atriLeft: Pic:= FPic_Arrow_L_a;
3624 atriRight: Pic:= FPic_Arrow_R_a;
3625 atriDown: Pic:= FPic_Arrow_D_a;
3626 else exit;
3627 end
3628 else
3629 case ATyp of
3630 atriLeft: Pic:= FPic_Arrow_L;
3631 atriRight: Pic:= FPic_Arrow_R;
3632 atriDown: Pic:= FPic_Arrow_D;
3633 else exit;
3634 end;
3635 Pic.Draw(C,
3636 (ARect.Left+ARect.Right-Pic.Width) div 2,
3637 (ARect.Top+ARect.Bottom-Pic.Height) div 2
3638 );
3639 exit;
3640 end;
3641
3642 if not AEnabled then
3643 NColor:= ColorBlendHalf(FColorArrow, FColorBg)
3644 else
3645 if AActive and not _IsDrag then
3646 NColor:= FColorArrowOver
3647 else
3648 NColor:= FColorArrow;
3649
3650 DrawTriangleType(C, ATyp, ARect, NColor, DoScale(FOptArrowSize) div 2);
3651 end;
3652
3653
GetIndexOfButtonnull3654 function TATTabs.GetIndexOfButton(const AButtons: TATTabButtons; ABtn: TATTabButton): integer;
3655 var
3656 i: integer;
3657 begin
3658 Result:= -1;
3659 for i:= 0 to Length(AButtons)-1 do
3660 if AButtons[i].Id=ABtn then
3661 begin Result:= i; exit; end;
3662 end;
3663
TATTabs.GetButtonsEdgeCoordnull3664 function TATTabs.GetButtonsEdgeCoord(AtLeft: boolean): integer;
3665 begin
3666 if AtLeft then
3667 begin
3668 Result:= DoScale(FOptSpaceInitial);
3669 case FOptPosition of
3670 atpLeft:
3671 Inc(Result, DoScale(FOptSpacer));
3672 atpRight:
3673 Inc(Result, DoScale(FOptSpacer2));
3674 end;
3675 end
3676 else
3677 begin
3678 Result:= Width;
3679 case FOptPosition of
3680 atpLeft:
3681 Dec(Result, DoScale(FOptSpacer2));
3682 atpRight:
3683 Dec(Result, DoScale(FOptSpacer));
3684 end;
3685 end;
3686 end;
3687
GetRectOfButtonIndexnull3688 function TATTabs.GetRectOfButtonIndex(AIndex: integer; AtLeft: boolean): TRect;
3689 var
3690 NPos, i: integer;
3691 begin
3692 NPos:= GetButtonsEdgeCoord(AtLeft);
3693 if AtLeft then
3694 begin
3695 for i:= 0 to AIndex do
3696 begin
3697 Result.Left:= NPos;
3698 Result.Right:= Result.Left+FButtonsLeft[i].Size;
3699 NPos:= Result.Right;
3700 end;
3701 end
3702 else
3703 begin
3704 for i:= 0 to AIndex do
3705 begin
3706 Result.Right:= NPos;
3707 Result.Left:= Result.Right-FButtonsRight[i].Size;
3708 NPos:= Result.Left;
3709 end;
3710 end;
3711
3712 if FOptPosition in [atpTop, atpBottom] then
3713 Result.Top:= DoScale(FOptSpacer)
3714 else
3715 Result.Top:= 0;
3716
3717 Result.Bottom:= Result.Top+DoScale(FOptTabHeight);
3718
3719 if FOptPosition=atpBottom then
3720 Inc(Result.Top);
3721 end;
3722
GetRectOfButtonnull3723 function TATTabs.GetRectOfButton(AButton: TATTabButton): TRect;
3724 var
3725 N: integer;
3726 begin
3727 Result:= cRect0;
3728
3729 N:= GetIndexOfButton(FButtonsLeft, AButton);
3730 if N>=0 then
3731 Result:= GetRectOfButtonIndex(N, true)
3732 else
3733 begin
3734 N:= GetIndexOfButton(FButtonsRight, AButton);
3735 if N>=0 then
3736 Result:= GetRectOfButtonIndex(N, false);
3737 end;
3738 end;
3739
3740
3741 procedure TATTabs.ShowTabMenu;
3742 var
3743 mi: TMenuItem;
3744 P: TPoint;
3745 i: integer;
3746 bShow: boolean;
3747 Data: TATTabData;
3748 begin
3749 if Assigned(TabMenuExternal) then
3750 begin
3751 P:= Point(FRectArrowDown.Left, FRectArrowDown.Bottom);
3752 P:= ClientToScreen(P);
3753 TabMenuExternal.Popup(P.X, P.Y);
3754 exit;
3755 end;
3756
3757 if TabCount=0 then Exit;
3758
3759 bShow:= true;
3760 if Assigned(FOnTabMenu) then
3761 FOnTabMenu(Self, bShow);
3762 if not bShow then Exit;
3763
3764 if not Assigned(FTabMenu) then
3765 FTabMenu:= TPopupMenu.Create(Self);
3766 FTabMenu.Items.Clear;
3767
3768 for i:= 0 to TabCount-1 do
3769 begin
3770 Data:= GetTabData(i);
3771 if Data.TabVisible then
3772 begin
3773 mi:= TMenuItem.Create(Self);
3774 mi.Tag:= i;
3775 mi.Caption:= GetTabData(i).TabCaptionFull;
3776 mi.OnClick:= TabMenuClick;
3777 mi.RadioItem:= true;
3778 mi.Checked:= i=FTabIndex;
3779 FTabMenu.Items.Add(mi);
3780 end;
3781 end;
3782 P:= Point(FRectArrowDown.Left, FRectArrowDown.Bottom);
3783 P:= ClientToScreen(P);
3784 FTabMenu.Popup(P.X, P.Y);
3785 end;
3786
3787 procedure TATTabs.TabMenuClick(Sender: TObject);
3788 begin
3789 SetTabIndex((Sender as TComponent).Tag);
3790 end;
3791
3792 procedure TATTabs.UpdateTabWidths;
3793 var
3794 NValue, NCount: integer;
3795 begin
3796 if FOptVarWidth then Exit;
3797
3798 NCount:= TabCount;
3799 if NCount=0 then Exit;
3800
3801 if FOptPosition in [atpLeft, atpRight] then
3802 begin
3803 FTabWidth:= Width-DoScale(FOptSpacer);
3804 exit
3805 end;
3806
3807 //tricky formula: calculate auto-width
3808 NValue:= (Width
3809 - IfThen(FOptShowPlusTab, GetTabWidth_Plus_Raw + DoScale(FOptSpaceBeforeText+FOptSpaceAfterText))
3810 - FRealIndentLeft
3811 - FRealIndentRight
3812 - FOptSpaceSide
3813 ) div NCount
3814 - DoScale(FOptSpaceBetweenTabs);
3815
3816 NValue:= Max(NValue, DoScale(FOptTabWidthMinimal));
3817 NValue:= Min(NValue, DoScale(FOptTabWidthNormal));
3818
3819 FTabWidth:= NValue;
3820 end;
3821
TATTabs.GetTabVisibleXnull3822 function TATTabs.GetTabVisibleX(AIndex: integer; const D: TATTabData): boolean;
3823 begin
3824 if Width<FOptMinimalWidthForSides then
3825 exit(false);
3826
3827 case FOptShowXButtons of
3828 atbxShowNone:
3829 Result:= false;
3830 atbxShowAll:
3831 Result:= true;
3832 atbxShowActive:
3833 Result:= AIndex=FTabIndex;
3834 atbxShowMouseOver:
3835 Result:= AIndex=FTabIndexOver;
3836 atbxShowActiveAndMouseOver:
3837 Result:= (AIndex=FTabIndex) or (AIndex=FTabIndexOver);
3838 else
3839 Result:= false;
3840 end;
3841
3842 if Result then
3843 begin
3844 if D.TabHideXButton then
3845 begin
3846 Result:= false;
3847 Exit
3848 end;
3849
3850 if not FOptVarWidth then
3851 if FOptPosition in [atpTop, atpBottom] then
3852 if FTabWidth<DoScale(FOptTabWidthMinimalHidesX) then
3853 begin
3854 Result:= false;
3855 Exit
3856 end;
3857 end;
3858 end;
3859
3860 procedure TATTabs.DoTabDrop;
3861 var
3862 NFrom, NTo: integer;
3863 ACanDrop: boolean;
3864 begin
3865 NFrom:= FTabIndex;
3866 if not IsIndexOk(NFrom) then Exit;
3867 NTo:= FTabIndexDrop;
3868 if not IsIndexOk(NTo) then
3869 NTo:= TabCount-1;
3870 if NFrom=NTo then Exit;
3871
3872 ACanDrop:= true;
3873 if Assigned(FOnTabDropQuery) then
3874 FOnTabDropQuery(Self, NFrom, NTo, ACanDrop);
3875 if not ACanDrop then Exit;
3876
3877 FTabList.Items[NFrom].Index:= NTo;
3878 SetTabIndex(NTo);
3879
3880 if Assigned(FOnTabMove) then
3881 FOnTabMove(Self, NFrom, NTo);
3882 end;
3883
3884 procedure TATTabs.MoveTab(AFrom, ATo: integer; AActivateThen: boolean);
3885 begin
3886 if not IsIndexOk(AFrom) then exit;
3887 if not IsIndexOk(ATo) then exit;
3888 if AFrom=ATo then exit;
3889
3890 FTabList.Items[AFrom].Index:= ATo;
3891 if AActivateThen then
3892 SetTabIndex(ATo);
3893 end;
3894
TATTabs.FindTabByObjectnull3895 function TATTabs.FindTabByObject(AObject: TObject): integer;
3896 var
3897 D: TATTabData;
3898 i: integer;
3899 begin
3900 Result:= -1;
3901 for i:= 0 to TabCount-1 do
3902 begin
3903 D:= GetTabData(i);
3904 if D<>nil then
3905 if D.TabObject=AObject then
3906 begin
3907 Result:= i;
3908 exit;
3909 end;
3910 end;
3911 end;
3912
3913 procedure TATTabs.DoTabDropToOtherControl(ATarget: TControl; const APnt: TPoint);
3914 var
3915 ATabs: TATTabs;
3916 NTab, NTabTo: integer;
3917 Data: TATTabData;
3918 P: TPoint;
3919 IsX: boolean;
3920 begin
3921 if not (ATarget is TATTabs) then
3922 begin
3923 if Assigned(TControlHack(ATarget).OnDragDrop) then
3924 begin
3925 P:= APnt;
3926 Data:= GetTabData(FTabIndex);
3927 if Data<>nil then
3928 TControlHack(ATarget).OnDragDrop(ATarget, Data.TabObject, P.X, P.Y);
3929 end;
3930 Exit;
3931 end;
3932
3933 ATabs:= ATarget as TATTabs;
3934 if not ATabs.OptMouseDragEnabled then Exit;
3935
3936 NTab:= FTabIndex;
3937 NTabTo:= ATabs.GetTabAt(APnt.X, APnt.Y, IsX); //-1 is allowed
3938
3939 Data:= GetTabData(NTab);
3940 if Data=nil then Exit;
3941
3942 ATabs.AddTab(NTabTo, Data);
3943
3944 //correct TabObject parent
3945 if Data.TabObject is TWinControl then
3946 if (Data.TabObject as TWinControl).Parent = Self.Parent then
3947 (Data.TabObject as TWinControl).Parent:= ATabs.Parent;
3948
3949 //delete old tab (don't call OnTabClose)
3950 DeleteTab(NTab, false{AllowEvent}, false);
3951
3952 //activate dropped tab
3953 if NTabTo<0 then
3954 ATabs.TabIndex:= ATabs.TabCount-1
3955 else
3956 ATabs.TabIndex:= NTabTo;
3957 end;
3958
GetTabTicknull3959 function TATTabs.GetTabTick(AIndex: integer): Int64;
3960 var
3961 D: TATTabData;
3962 begin
3963 Result:= 0;
3964 if Assigned(FOnTabGetTick) then
3965 begin
3966 D:= GetTabData(AIndex);
3967 if Assigned(D) then
3968 Result:= FOnTabGetTick(Self, D.TabObject);
3969 end;
3970 end;
3971
3972 procedure TATTabs.CMMouseLeave(var Msg: TMessage);
3973 begin
3974 inherited;
3975 FTabIndexOver:= -1;
3976 FTabIndexHinted:= -1;
3977 Invalidate;
3978 end;
3979
3980 procedure TATTabs.SwitchTab(ANext: boolean; ALoopAtEdge: boolean=true);
3981 begin
3982 if TabCount>1 then
3983 if ANext then
3984 begin
3985 if TabIndex=TabCount-1 then
3986 begin
3987 if ALoopAtEdge then
3988 TabIndex:= 0;
3989 end
3990 else
3991 TabIndex:= TabIndex+1;
3992 end
3993 else
3994 begin
3995 if TabIndex=0 then
3996 begin
3997 if ALoopAtEdge then
3998 TabIndex:= TabCount-1;
3999 end
4000 else
4001 TabIndex:= TabIndex-1;
4002 end;
4003 end;
4004
4005 procedure TATTabs.DblClick;
4006 begin
4007 inherited;
4008 FMouseDownDbl:= true;
4009 end;
4010
4011 procedure TATTabs.DragOver(Source: TObject; X, Y: integer; State: TDragState;
4012 var Accept: Boolean);
4013 var
4014 Limit: integer;
4015 {$ifndef FPC}
4016 IsX: Boolean;
4017 {$endif}
4018 begin
4019 //this is workaround for too early painted drop-mark (vertical red line)
4020 if not FMouseDragBegins then
4021 begin
4022 Limit:= Mouse.DragThreshold;
4023 FMouseDragBegins:= (Abs(X-FMouseDownPnt.X)>=Limit) or (Abs(Y-FMouseDownPnt.Y)>=Limit);
4024 end;
4025
4026 if Source is TATTabs then
4027 begin
4028 Accept:=
4029 FOptMouseDragEnabled and
4030 FOptMouseDragOutEnabled;
4031
4032 // Delphi 7 don't call MouseMove during dragging
4033 {$ifndef fpc}
4034 if Accept then
4035 begin
4036 FTabIndexDrop:= GetTabAt(X, Y, IsX);
4037 end;
4038 {$endif}
4039
4040 if Accept then
4041 Invalidate;
4042 end
4043 else
4044 begin
4045 if not FOptMouseDragFromNotATTabs then
4046 Accept:= false
4047 else
4048 inherited;
4049 end;
4050 end;
4051
4052 procedure TATTabs.DragDrop(Source: TObject; X, Y: integer);
4053 begin
4054 if not (Source is TATTabs) then
4055 begin
4056 inherited;
4057 exit;
4058 end;
4059
4060 if (Source=Self) then
4061 begin
4062 //drop to itself
4063 if (FTabIndexDrop>=0) or
4064 (FTabIndexDrop=cTabIndexPlus) or
4065 (FTabIndexDrop=cTabIndexEmptyArea) then
4066 begin
4067 DoTabDrop;
4068 Invalidate;
4069 end;
4070 end
4071 else
4072 begin
4073 //drop to anoter control
4074 (Source as TATTabs).DoTabDropToOtherControl(Self, Point(X, Y));
4075 end;
4076 end;
4077
TATTabs.DoScalenull4078 function TATTabs.DoScale(AValue: integer): integer;
4079 begin
4080 Result:= AValue * FOptScalePercents div 100;
4081 end;
4082
TATTabs.DoScaleFontnull4083 function TATTabs.DoScaleFont(AValue: integer): integer;
4084 begin
4085 Result:= AValue * FOptFontScale div 100;
4086 end;
4087
TATTabs.GetScrollPageSizenull4088 function TATTabs.GetScrollPageSize: integer;
4089 begin
4090 if not FActualMultiline then
4091 Result:= Width * FOptScrollPagesizePercents div 100
4092 else
4093 if FOptPosition in [atpLeft, atpRight] then
4094 Result:= Height * FOptScrollPagesizePercents div 100
4095 else
4096 Result:= FOptTabHeight+FOptSpacer;
4097 end;
4098
GetMaxEdgePosnull4099 function TATTabs.GetMaxEdgePos: integer;
4100 var
4101 R: TRect;
4102 begin
4103 Result:= 0;
4104 if TabCount=0 then Exit;
4105
4106 R:= FRectTabPlus_NotScrolled;
4107 if FActualMultiline then
4108 Result:= R.Bottom
4109 else
4110 Result:= R.Right;
4111 end;
4112
TATTabs.GetMaxScrollPosnull4113 function TATTabs.GetMaxScrollPos: integer;
4114 begin
4115 Result:= GetMaxEdgePos;
4116 if Result=0 then exit;
4117
4118 if not FActualMultiline then
4119 Result:= Max(0, Result - Width + FRealIndentRight)
4120 else
4121 Result:= Max(0, Result - Height);
4122 end;
4123
4124 procedure TATTabs.DoScrollLeft;
4125 var
4126 NPos: integer;
4127 begin
4128 NPos:= Max(0, FScrollPos-GetScrollPageSize);
4129 if NPos<>FScrollPos then
4130 begin
4131 FScrollPos:= NPos;
4132 Invalidate;
4133 end;
4134 end;
4135
4136 procedure TATTabs.DoScrollRight;
4137 var
4138 NPos: integer;
4139 begin
4140 NPos:= Min(GetMaxScrollPos, FScrollPos+GetScrollPageSize);
4141 if NPos<>FScrollPos then
4142 begin
4143 FScrollPos:= NPos;
4144 Invalidate;
4145 end;
4146 end;
4147
4148 procedure TATTabs.DoPaintButtonPlus(C: TCanvas);
4149 var
4150 bOver: boolean;
4151 ElemType: TATTabElemType;
4152 R: TRect;
4153 NColor: TColor;
4154 begin
4155 bOver:= FTabIndexOver=cTabIndexPlusBtn;
4156 if bOver then
4157 ElemType:= aeButtonPlusOver
4158 else
4159 ElemType:= aeButtonPlus;
4160
4161 R:= FRectButtonPlus;
4162
4163 if IsPaintNeeded(ElemType, -1, C, R) then
4164 begin
4165 NColor:= IfThen(
4166 bOver and not _IsDrag,
4167 FColorArrowOver,
4168 FColorArrow);
4169
4170 DoPaintBgTo(C, R);
4171 DrawPlusSign(C, R, DoScale(FOptArrowSize), DoScale(1), NColor);
4172 DoPaintAfter(ElemType, -1, C, R);
4173 end;
4174 end;
4175
4176 procedure TATTabs.DoPaintButtonClose(C: TCanvas);
4177 var
4178 bOver: boolean;
4179 ElemType: TATTabElemType;
4180 R: TRect;
4181 NColor: TColor;
4182 NIndent: integer;
4183 begin
4184 bOver:= FTabIndexOver=cTabIndexCloseBtn;
4185 if bOver then
4186 ElemType:= aeButtonCloseOver
4187 else
4188 ElemType:= aeButtonClose;
4189
4190 R:= FRectButtonClose;
4191
4192 if IsPaintNeeded(ElemType, -1, C, R) then
4193 begin
4194 NColor:= IfThen(
4195 bOver and not _IsDrag,
4196 FColorArrowOver,
4197 FColorArrow);
4198
4199 NIndent:= (R.Right-R.Left) div 2 - DoScale(FOptArrowSize);
4200
4201 DoPaintBgTo(C, R);
4202 CanvasPaintXMark(C, R, NColor, NIndent, NIndent, 1);
4203 DoPaintAfter(ElemType, -1, C, R);
4204 end;
4205 end;
4206
4207
4208 procedure TATTabs.DoPaintArrowDown(C: TCanvas);
4209 var
4210 bOver: boolean;
4211 ElemType: TATTabElemType;
4212 begin
4213 bOver:= FTabIndexOver=cTabIndexArrowMenu;
4214 if bOver then
4215 ElemType:= aeArrowDropdownOver
4216 else
4217 ElemType:= aeArrowDropdown;
4218
4219 if IsPaintNeeded(ElemType, -1, C, FRectArrowDown) then
4220 begin
4221 DoPaintBgTo(C, FRectArrowDown);
4222 DoPaintArrowTo(C, atriDown, FRectArrowDown, bOver, true);
4223 DoPaintAfter(ElemType, -1, C, FRectArrowDown);
4224 end;
4225 end;
4226
4227 procedure TATTabs.DoPaintArrowLeft(C: TCanvas);
4228 var
4229 bOver: boolean;
4230 ElemType: TATTabElemType;
4231 R: TRect;
4232 begin
4233 bOver:= (TabCount > 0) and (FTabIndexOver=cTabIndexArrowScrollLeft);
4234 if bOver then
4235 ElemType:= aeArrowScrollLeftOver
4236 else
4237 ElemType:= aeArrowScrollLeft;
4238
4239 if IsPaintNeeded(ElemType, -1, C, FRectArrowLeft) then
4240 begin
4241 R:= FRectArrowLeft;
4242 if FOptShowArrowsNear then
4243 R.Left:= R.Left * 2 div 3 + R.Right div 3;
4244
4245 DoPaintBgTo(C, FRectArrowLeft);
4246 DoPaintArrowTo(C, atriLeft, R, bOver, FScrollingNeeded);
4247 DoPaintAfter(ElemType, -1, C, FRectArrowLeft);
4248 end;
4249 end;
4250
4251 procedure TATTabs.DoPaintArrowRight(C: TCanvas);
4252 var
4253 bOver: boolean;
4254 ElemType: TATTabElemType;
4255 R: TRect;
4256 begin
4257 bOver:= (TabCount > 0) and (FTabIndexOver=cTabIndexArrowScrollRight);
4258 if bOver then
4259 ElemType:= aeArrowScrollRightOver
4260 else
4261 ElemType:= aeArrowScrollRight;
4262
4263 if IsPaintNeeded(ElemType, -1, C, FRectArrowRight) then
4264 begin
4265 R:= FRectArrowRight;
4266 if FOptShowArrowsNear then
4267 R.Right:= R.Left div 3 + R.Right * 2 div 3;
4268
4269 DoPaintBgTo(C, FRectArrowRight);
4270 DoPaintArrowTo(C, atriRight, R, bOver, FScrollingNeeded);
4271 DoPaintAfter(ElemType, -1, C, FRectArrowRight);
4272 end;
4273 end;
4274
4275
SwapStringnull4276 function SwapString(const S: string): string;
4277 var
4278 i: integer;
4279 begin
4280 Result:= '';
4281 SetLength(Result, Length(S));
4282 for i:= 1 to Length(S) do
4283 Result[Length(S)+1-i]:= S[i];
4284 end;
4285
4286 procedure TATTabs.ApplyButtonLayout;
4287 //
4288 procedure UpdateBtns(var Btns: TATTabButtons; const S: string);
4289 var
4290 i: integer;
4291 begin
4292 SetLength(Btns, 0);
4293 for i:= 1 to Length(S) do
4294 case S[i] of
4295 '<': AddTabButton(Btns, atbScrollLeft, DoScale(FOptButtonSize));
4296 '>': AddTabButton(Btns, atbScrollRight, DoScale(FOptButtonSize));
4297 'v': AddTabButton(Btns, atbDropdownMenu, DoScale(FOptButtonSize));
4298 '+': AddTabButton(Btns, atbPlus, DoScale(FOptButtonSize));
4299 'x': AddTabButton(Btns, atbClose, DoScale(FOptButtonSize));
4300 '0': AddTabButton(Btns, atbUser0, DoScale(FOptButtonSize));
4301 '1': AddTabButton(Btns, atbUser1, DoScale(FOptButtonSize));
4302 '2': AddTabButton(Btns, atbUser2, DoScale(FOptButtonSize));
4303 '3': AddTabButton(Btns, atbUser3, DoScale(FOptButtonSize));
4304 '4': AddTabButton(Btns, atbUser4, DoScale(FOptButtonSize));
4305 '_': AddTabButton(Btns, atbSpace, DoScale(FOptButtonSizeSpace));
4306 '|': AddTabButton(Btns, atbSeparator, DoScale(FOptButtonSizeSeparator));
4307 end;
4308 end;
4309 //
4310 var
4311 S, SLeft, SRight: string;
4312 N: integer;
4313 begin
4314 S:= FOptButtonLayout;
4315 N:= Pos(',', S);
4316 if N=0 then N:= Length(S)+1;
4317 SLeft:= Copy(S, 1, N-1);
4318 SRight:= Copy(S, N+1, MaxInt);
4319
4320 UpdateBtns(FButtonsLeft, SLeft);
4321 UpdateBtns(FButtonsRight, SwapString(SRight));
4322 end;
4323
4324 procedure TATTabs.DoClickUser(AIndex: integer);
4325 begin
4326 if Assigned(FOnTabClickUserButton) then
4327 FOnTabClickUserButton(Self, AIndex);
4328 end;
4329
4330 procedure TATTabs.DoPaintSeparator(C: TCanvas; const R: TRect);
4331 begin
4332 DoPaintBgTo(C, R);
4333 C.Pen.Color:= FColorSeparator;
4334 C.MoveTo(R.Left, R.Top+DoScale(FOptSpaceSeparator));
4335 C.LineTo(R.Left, R.Bottom-DoScale(FOptSpaceSeparator));
4336 end;
4337
4338
TATTabs.ConvertButtonIdToTabIndexnull4339 function TATTabs.ConvertButtonIdToTabIndex(Id: TATTabButton): integer;
4340 begin
4341 case Id of
4342 atbUser0: Result:= cTabIndexUser0;
4343 atbUser1: Result:= cTabIndexUser1;
4344 atbUser2: Result:= cTabIndexUser2;
4345 atbUser3: Result:= cTabIndexUser3;
4346 atbUser4: Result:= cTabIndexUser4;
4347 else
4348 raise Exception.Create('Unknown button id');
4349 end;
4350 end;
4351
4352 procedure TATTabs.DoPaintSpaceInital(C: TCanvas);
4353 var
4354 R: TRect;
4355 begin
4356 R.Left:= 0;
4357 R.Top:= 0;
4358 R.Right:= DoScale(FOptSpaceInitial);
4359 R.Bottom:= DoScale(FOptTabHeight)+DoScale(FOptSpacer);
4360 DoPaintBgTo(C, R);
4361 end;
4362
4363 procedure TATTabs.DoPaintUserButtons(C: TCanvas; const AButtons: TATTabButtons; AtLeft: boolean);
4364 var
4365 BtnId: TATTabButton;
4366 ElemType: TATTabElemType;
4367 NIndex, i: integer;
4368 R: TRect;
4369 begin
4370 //If we have an OptSpaceInitial > 0 then this "hides" scrolled buttons
4371 //in that small area before the first userbutton:
4372 if FOptPosition in [atpTop, atpBottom] then
4373 if FOptSpaceInitial>0 then
4374 DoPaintSpaceInital(C);
4375
4376 for i:= 0 to Length(AButtons)-1 do
4377 begin
4378 BtnId:= AButtons[i].Id;
4379 R:= GetRectOfButtonIndex(i, AtLeft);
4380
4381 case BtnId of
4382 atbUser0..atbUser4:
4383 begin
4384 NIndex:= ConvertButtonIdToTabIndex(BtnId);
4385
4386 if FTabIndexOver=NIndex then
4387 ElemType:= aeButtonUserOver
4388 else
4389 ElemType:= aeButtonUser;
4390
4391 DoPaintBgTo(C, R);
4392 DoPaintAfter(ElemType, Ord(BtnId)-Ord(atbUser0), C, R);
4393 end;
4394 atbSpace:
4395 begin
4396 DoPaintBgTo(C, R);
4397 end;
4398 atbSeparator:
4399 begin
4400 DoPaintSeparator(C, R);
4401 end
4402 end;
4403 end;
4404 end;
4405
4406 procedure TATTabs.Loaded;
4407 begin
4408 inherited;
4409 TabIndex:= FTabIndexLoaded;
4410 end;
4411
4412 procedure TATTabs.DoContextPopup(MousePos: TPoint; var Handled: Boolean);
4413 begin
4414 inherited;
4415 if not Handled then
4416 begin
4417 DoHandleRightClick;
4418 Handled:= true;
4419 end;
4420 end;
4421
TATTabs.GetButtonsWidthnull4422 function TATTabs.GetButtonsWidth(const B: TATTabButtons): integer;
4423 var
4424 i: integer;
4425 begin
4426 Result:= 0;
4427 for i:= 0 to Length(B)-1 do
4428 Inc(Result, B[i].Size);
4429 end;
4430
GetButtonsEmptynull4431 function TATTabs.GetButtonsEmpty: boolean;
4432 begin
4433 Result:=
4434 (Length(FButtonsLeft)=0) and
4435 (Length(FButtonsRight)=0);
4436 end;
4437
GetInitialVerticalIndentnull4438 function TATTabs.GetInitialVerticalIndent: integer;
4439 begin
4440 if GetButtonsEmpty then
4441 Result:= DoScale(FOptSpaceInitial)
4442 else
4443 Result:= DoScale(FOptTabHeight);
4444 end;
4445
4446 procedure TATTabs.DoPaintColoredBand(C: TCanvas; const ARect: TRect; AColor: TColor;
4447 APos: TATTabPosition);
4448 var
4449 NColor: TColor;
4450 R: TRect;
4451 begin
4452 case APos of
4453 atpTop:
4454 begin
4455 R.Left:= ARect.Left+1;
4456 R.Right:= ARect.Right-1;
4457 R.Top:= ARect.Top+1-Ord(FOptShowFlat);
4458 R.Bottom:= R.Top+DoScale(FOptColoredBandSize);
4459 if FOptShowFlat then
4460 Inc(R.Right);
4461 end;
4462 atpBottom:
4463 begin
4464 R.Left:= ARect.Left+1;
4465 R.Right:= ARect.Right-1;
4466 R.Bottom:= ARect.Bottom;
4467 R.Top:= R.Bottom-DoScale(FOptColoredBandSize);
4468 if FOptShowFlat then
4469 Inc(R.Right);
4470 end;
4471 atpLeft:
4472 begin
4473 R.Left:= ARect.Left+1-Ord(FOptShowFlat);
4474 R.Right:= R.Left+DoScale(FOptColoredBandSize);
4475 R.Top:= ARect.Top+1;
4476 R.Bottom:= ARect.Bottom-1;
4477 end;
4478 atpRight:
4479 begin
4480 R.Right:= ARect.Right-1+Ord(FOptShowFlat);
4481 R.Left:= R.Right-DoScale(FOptColoredBandSize);
4482 R.Top:= ARect.Top+1;
4483 R.Bottom:= ARect.Bottom-1;
4484 end;
4485 end;
4486
4487 NColor:= C.Brush.Color;
4488 C.Brush.Color:= AColor;
4489 C.FillRect(R);
4490 C.Brush.Color:= NColor;
4491 end;
4492
4493 procedure TATTabs.DoPaintButtonsBG(C: TCanvas);
4494 var
4495 X1, X2: integer;
4496 begin
4497 if FOptPosition in [atpLeft, atpRight] then
4498 if not GetButtonsEmpty then
4499 begin
4500 X1:= GetButtonsEdgeCoord(true);
4501 X2:= GetButtonsEdgeCoord(false);
4502 DoPaintBgTo(C, Rect(X1, 0, X2, DoScale(FOptTabHeight)));
4503 end;
4504 end;
4505
4506 procedure TATTabs.UpdateCanvasAntialiasMode(C: TCanvas);
4507 {$ifdef fpc}
4508 begin
4509 // https://gitlab.com/freepascal.org/lazarus/lazarus/-/issues/39416
4510 {$ifndef LCLQt5}
4511 C.AntialiasingMode:= amOn;
4512 {$endif}
4513 end;
4514 {$else}
4515 var
4516 p: TPoint;
4517 begin
4518 GetBrushOrgEx(C.Handle, p);
4519 SetStretchBltMode(C.Handle, HALFTONE);
4520 SetBrushOrgEx(C.Handle, p.x, p.y, @p);
4521 end;
4522 {$endif}
4523
4524 procedure TATTabs.UpdateTabRectsToFillLine(AIndexFrom, AIndexTo: integer; ALastLine: boolean);
4525 var
4526 NDelta, NWidthOfPlus, i: integer;
4527 D: TATTabData;
4528 R: TRect;
4529 begin
4530 D:= GetTabData(AIndexTo);
4531 if D=nil then exit;
4532
4533 if ALastLine and FOptShowPlusTab then
4534 NWidthOfPlus:= GetTabRectWidth(true)
4535 else
4536 NWidthOfPlus:= 0;
4537
4538 NDelta:=
4539 (Width - FRealIndentRight - D.TabRect.Right - NWidthOfPlus)
4540 div (AIndexTo-AIndexFrom+1);
4541
4542 for i:= AIndexFrom to AIndexTo do
4543 begin
4544 D:= GetTabData(i);
4545 if D=nil then Continue;
4546 R:= D.TabRect;
4547 if R=cRect0 then Continue;
4548
4549 Inc(R.Left, (i-AIndexFrom)*NDelta);
4550 Inc(R.Right, (i+1-AIndexFrom)*NDelta);
4551
4552 //width of last tab is not precise (+-2pixels). fix it.
4553 if i=AIndexTo then
4554 R.Right:= Width - FRealIndentRight - NWidthOfPlus;
4555
4556 D.TabRect:= R;
4557 end;
4558 end;
4559
4560 procedure TATTabs.UpdateCaptionProps(C: TCanvas; const ACaption: TATTabString;
4561 out ALineHeight: integer; out ATextSize: TSize);
4562 //
4563 procedure _GetExtent(const S: string; var Ex: TSize);
4564 {$ifdef WIDE}
4565 var
4566 StrW: WideString;
4567 {$endif}
4568 begin
4569 {$ifdef WIDE}
4570 StrW:= UTF8Decode(S);
4571 Windows.GetTextExtentPoint32W(C.Handle, PWideChar(StrW), Length(StrW), Ex);
4572 {$else}
4573 Ex:= C.TextExtent(S);
4574 {$endif}
4575 end;
4576 //
4577 var
4578 Sep: TATStringSeparator;
4579 SepItem: string;
4580 Ex: TSize;
4581 begin
4582 ALineHeight:= 0;
4583 ATextSize.cx:= 0;
4584 ATextSize.cy:= 0;
4585
4586 if Pos(#10, ACaption)=0 then
4587 begin
4588 _GetExtent(ACaption, Ex);
4589 ATextSize.CY:= Ex.CY;
4590 ALineHeight:= Ex.CY;
4591 ATextSize.CX:= Ex.CX;
4592 exit;
4593 end;
4594
4595 Sep.Init({$ifdef WIDE}UTF8Encode{$endif}(ACaption), #10);
4596 while Sep.GetItemStr(SepItem) do
4597 begin
4598 _GetExtent(SepItem, Ex);
4599 Inc(ATextSize.CY, Ex.CY);
4600 ALineHeight:= Max(ALineHeight, Ex.CY);
4601 ATextSize.CX:= Max(ATextSize.CX, Ex.CX);
4602 end;
4603 end;
4604
TATTabs.IsTabVisiblenull4605 function TATTabs.IsTabVisible(AIndex: integer): boolean;
4606 var
4607 D: TATTabData;
4608 R: TRect;
4609 begin
4610 D:= GetTabData(AIndex);
4611 if D=nil then
4612 begin
4613 Result:= false;
4614 exit
4615 end;
4616
4617 R:= D.TabRect;
4618 if R=cRect0 then
4619 begin
4620 Result:= false;
4621 exit
4622 end;
4623
4624 if not FScrollingNeeded then
4625 begin
4626 Result:= true;
4627 exit
4628 end;
4629
4630 R:= GetRectScrolled(R);
4631 if not FActualMultiline then
4632 Result:=
4633 (R.Left >= FRealIndentLeft) and
4634 (R.Right < Width-FRealIndentRight)
4635 else
4636 Result:=
4637 (R.Top >= FRealIndentLeft) and
4638 (R.Bottom < Height-FRealIndentRight);
4639 end;
4640
4641 procedure TATTabs.MakeVisible(AIndex: integer);
4642 var
4643 D: TATTabData;
4644 R: TRect;
4645 begin
4646 //sometimes new tab has not updated Data.TabRect
4647 if FTabsChanged or FTabsResized then
4648 begin
4649 FTabsChanged:= false;
4650 FTabsResized:= false;
4651 if Assigned(FBitmap) then
4652 UpdateTabRects(FBitmap.Canvas);
4653 end;
4654
4655 if not FScrollingNeeded then exit;
4656
4657 if IsTabVisible(AIndex) then exit;
4658
4659 D:= GetTabData(AIndex);
4660 if D=nil then exit;
4661 R:= D.TabRect;
4662
4663 if not FActualMultiline then
4664 FScrollPos:= Min(GetMaxScrollPos, Max(0, R.Left - Width div 2))
4665 else
4666 FScrollPos:= Min(GetMaxScrollPos, Max(0, R.Top - Height div 2));
4667
4668 Invalidate;
4669 end;
4670
4671 procedure TATTabs.SetScrollPos(AValue: integer);
4672 begin
4673 //user suggested to not limit ScrollPos
4674 //AValue:= Max(0, Min(GetMaxScrollPos, AValue) );
4675 if FScrollPos=AValue then exit;
4676 FScrollPos:= AValue;
4677 Invalidate;
4678 end;
4679
4680
TATTabs.GetTabFlatEffectivenull4681 function TATTabs.GetTabFlatEffective(AIndex: integer): boolean;
4682 begin
4683 Result:= FOptShowFlat and not (FOptShowFlatMouseOver and (FTabIndexOver=AIndex));
4684 end;
4685
TATTabs.GetTabBgColor_Passivenull4686 function TATTabs.GetTabBgColor_Passive(AIndex: integer): TColor;
4687 var
4688 Data: TATTabData;
4689 begin
4690 if GetTabFlatEffective(AIndex) then
4691 Result:= FColorBg
4692 else
4693 if (FTabIndexOver=AIndex) and not _IsDrag then
4694 Result:= FColorTabOver
4695 else
4696 Result:= FColorTabPassive;
4697
4698 if FOptShowEntireColor then
4699 begin
4700 Data:= GetTabData(AIndex);
4701 if (FTabIndexOver=AIndex) and not _IsDrag and Assigned(Data) and (Data.TabColorOver<>clNone) then
4702 Result:= Data.TabColorOver
4703 else
4704 if Assigned(Data) and (Data.TabColor<>clNone) then
4705 Result:= Data.TabColor;
4706 end;
4707 end;
4708
GetTabBgColor_Activenull4709 function TATTabs.GetTabBgColor_Active(AIndex: integer): TColor;
4710 var
4711 Data: TATTabData;
4712 begin
4713 if GetTabFlatEffective(AIndex) then
4714 Result:= FColorBg
4715 else
4716 Result:= FColorTabActive;
4717
4718 if FOptShowEntireColor then
4719 begin
4720 Data:= GetTabData(AIndex);
4721 if Assigned(Data) and (Data.TabColorActive<>clNone) then
4722 Result:= Data.TabColorActive
4723 else
4724 if Assigned(Data) and (Data.TabColor<>clNone) then
4725 Result:= Data.TabColor;
4726 end;
4727 end;
4728
TATTabs.GetPositionInvertednull4729 function TATTabs.GetPositionInverted(APos: TATTabPosition): TATTabPosition;
4730 begin
4731 case APos of
4732 atpTop:
4733 Result:= atpBottom;
4734 atpBottom:
4735 Result:= atpTop;
4736 atpLeft:
4737 Result:= atpRight;
4738 atpRight:
4739 Result:= atpLeft;
4740 else
4741 raise Exception.Create('Unknown tab pos');
4742 end;
4743 end;
4744
4745 procedure TATTabs.SetTheme(const Data: TATTabTheme);
4746 begin
4747 FThemed:= false;
4748
4749 if not FileExists(Data.FileName_Left) then raise Exception.Create('File not found: '+Data.FileName_Left);
4750 if not FileExists(Data.FileName_Right) then raise Exception.Create('File not found: '+Data.FileName_Right);
4751 if not FileExists(Data.FileName_Center) then raise Exception.Create('File not found: '+Data.FileName_Center);
4752 if not FileExists(Data.FileName_LeftActive) then raise Exception.Create('File not found: '+Data.FileName_LeftActive);
4753 if not FileExists(Data.FileName_RightActive) then raise Exception.Create('File not found: '+Data.FileName_RightActive);
4754 if not FileExists(Data.FileName_CenterActive) then raise Exception.Create('File not found: '+Data.FileName_CenterActive);
4755 if not FileExists(Data.FileName_X) then raise Exception.Create('File not found: '+Data.FileName_X);
4756 if not FileExists(Data.FileName_XActive) then raise Exception.Create('File not found: '+Data.FileName_XActive);
4757 if not FileExists(Data.FileName_Plus) then raise Exception.Create('File not found: '+Data.FileName_Plus);
4758 if not FileExists(Data.FileName_PlusActive) then raise Exception.Create('File not found: '+Data.FileName_PlusActive);
4759 if not FileExists(Data.FileName_ArrowLeft) then raise Exception.Create('File not found: '+Data.FileName_ArrowLeft);
4760 if not FileExists(Data.FileName_ArrowLeftActive) then raise Exception.Create('File not found: '+Data.FileName_ArrowLeftActive);
4761 if not FileExists(Data.FileName_ArrowRight) then raise Exception.Create('File not found: '+Data.FileName_ArrowRight);
4762 if not FileExists(Data.FileName_ArrowRightActive) then raise Exception.Create('File not found: '+Data.FileName_ArrowRightActive);
4763 if not FileExists(Data.FileName_ArrowDown) then raise Exception.Create('File not found: '+Data.FileName_ArrowDown);
4764 if not FileExists(Data.FileName_ArrowDownActive) then raise Exception.Create('File not found: '+Data.FileName_ArrowDownActive);
4765
4766 if FPic_Side_L=nil then FPic_Side_L:= TATTabsPicture.Create;
4767 if FPic_Side_R=nil then FPic_Side_R:= TATTabsPicture.Create;
4768 if FPic_Side_C=nil then FPic_Side_C:= TATTabsPicture.Create;
4769 if FPic_Side_L_a=nil then FPic_Side_L_a:= TATTabsPicture.Create;
4770 if FPic_Side_R_a=nil then FPic_Side_R_a:= TATTabsPicture.Create;
4771 if FPic_Side_C_a=nil then FPic_Side_C_a:= TATTabsPicture.Create;
4772 if FPic_X=nil then FPic_X:= TATTabsPicture.Create;
4773 if FPic_X_a=nil then FPic_X_a:= TATTabsPicture.Create;
4774 if FPic_Plus=nil then FPic_Plus:= TATTabsPicture.Create;
4775 if FPic_Plus_a=nil then FPic_Plus_a:= TATTabsPicture.Create;
4776 if FPic_Arrow_L=nil then FPic_Arrow_L:= TATTabsPicture.Create;
4777 if FPic_Arrow_L_a=nil then FPic_Arrow_L_a:= TATTabsPicture.Create;
4778 if FPic_Arrow_R=nil then FPic_Arrow_R:= TATTabsPicture.Create;
4779 if FPic_Arrow_R_a=nil then FPic_Arrow_R_a:= TATTabsPicture.Create;
4780 if FPic_Arrow_D=nil then FPic_Arrow_D:= TATTabsPicture.Create;
4781 if FPic_Arrow_D_a=nil then FPic_Arrow_D_a:= TATTabsPicture.Create;
4782
4783 FPic_Side_L.LoadFromFile(Data.FileName_Left);
4784 FPic_Side_R.LoadFromFile(Data.FileName_Right);
4785 FPic_Side_C.LoadFromFile(Data.FileName_Center);
4786 FPic_Side_L_a.LoadFromFile(Data.FileName_LeftActive);
4787 FPic_Side_R_a.LoadFromFile(Data.FileName_RightActive);
4788 FPic_Side_C_a.LoadFromFile(Data.FileName_CenterActive);
4789 FPic_X.LoadFromFile(Data.FileName_X);
4790 FPic_X_a.LoadFromFile(Data.FileName_XActive);
4791 FPic_Plus.LoadFromFile(Data.FileName_Plus);
4792 FPic_Plus_a.LoadFromFile(Data.FileName_PlusActive);
4793 FPic_Arrow_L.LoadFromFile(Data.FileName_ArrowLeft);
4794 FPic_Arrow_L_a.LoadFromFile(Data.FileName_ArrowLeftActive);
4795 FPic_Arrow_R.LoadFromFile(Data.FileName_ArrowRight);
4796 FPic_Arrow_R_a.LoadFromFile(Data.FileName_ArrowRightActive);
4797 FPic_Arrow_D.LoadFromFile(Data.FileName_ArrowDown);
4798 FPic_Arrow_D_a.LoadFromFile(Data.FileName_ArrowDownActive);
4799
4800 if not (
4801 (FPic_Side_L.Width=FPic_Side_R.Width) and
4802 (FPic_Side_L.Width=FPic_Side_L_a.Width) and
4803 (FPic_Side_L.Width=FPic_Side_R_a.Width) and
4804 (FPic_Side_L.Height=FPic_Side_R.Height) and
4805 (FPic_Side_L.Height=FPic_Side_C.Height) and
4806 (FPic_Side_L.Height=FPic_Side_L_a.Height) and
4807 (FPic_Side_L.Height=FPic_Side_R_a.Height) and
4808 (FPic_Side_L.Height=FPic_Side_C_a.Height) and
4809 (FPic_X.Width=FPic_X.Height) and
4810 (FPic_X.Width=FPic_X_a.Width) and
4811 (FPic_X.Width=FPic_X_a.Height)
4812 ) then
4813 raise Exception.Create('Incorrect picture sizes in tab-theme');
4814
4815 FThemed:= true;
4816 FOptTabHeight:= FPic_Side_L.Height;
4817 FOptSpaceSide:= FPic_Side_L.Width;
4818 FOptShowFlat:= false;
4819 FOptSpaceBetweenTabs:= FOptSpaceSide * Data.SpaceBetweenInPercentsOfSide div 100;
4820 FOptSpaceXSize:= FPic_X.Width;
4821 FOptSpaceXRight:= FOptSpaceSide div 2 + Data.IndentOfX;
4822 FOptShowArrowsNear:= false;
4823 Height:= FOptTabHeight+FOptSpacer;
4824 end;
4825
GetTabCaptionFinalnull4826 function TATTabs.GetTabCaptionFinal(AData: TATTabData; ATabIndex: integer): TATTabString;
4827 begin
4828 Result:= '';
4829 if AData.TabCaption<>'' then
4830 begin
4831 if AData.TabPinned then
4832 Result:= Result+FOptShowPinnedText;
4833 if AData.TabModified then
4834 Result:= Result+FOptShowModifiedText;
4835 if FOptShowNumberPrefix<>'' then
4836 Result:= Result+Format(FOptShowNumberPrefix, [ATabIndex+1]);
4837 Result:= Result+AData.TabCaptionFull;
4838 end
4839 else
4840 begin
4841 if AData.TabModified then
4842 Result:= Result+FOptShowModifiedText;
4843 end;
4844 end;
4845
4846
4847 initialization
4848 cRect0:= Rect(0, 0, 0, 0);
4849
4850 {$if defined(LCLQT5) or defined(darwin)}
4851 ATTabsStretchDrawEnabled:= false;
4852 ATTabsCircleDrawEnabled:= false;
4853 ATTabsPixelsDrawEnabled:= false;
4854 {$endif};
4855
4856 end.
4857