1 {
2 ATGroups - several page-controls, each based on ATTabs
3 Copyright (c) Alexey Torgashin (UVViewSoft)
4 License: MPL 2.0 or LGPL
5 }
6
7 {$ifdef FPC}
8 {$mode delphi}
9 {$else}
10 {$define windows}
11 {$define SP} //Allow using SpTBXLib
12 {$endif}
13
14 unit ATGroups;
15
16 interface
17
18 uses
19 Classes, Forms, Types, Controls, Graphics,
20 ExtCtrls, Menus,
21 {$ifdef SP}
22 SpTbxDkPanels, SpTbxItem,
23 {$endif}
24 ATTabs;
25
26 type
27 TMySplitter = {$ifdef SP}TSpTbxSplitter{$else}TSplitter{$endif};
28 TMyPopupMenu = {$ifdef SP} TSpTbxPopupMenu {$else} TPopupMenu {$endif};
29
30 type
31
32 { TATPages }
33
34 TATPages = class(TPanel)
35 private
36 FTabs: TATTabs;
37 FEnabledEmpty: boolean;
38 FOnTabFocus: TNotifyEvent;
39 FOnTabClose: TATTabCloseEvent;
40 FOnTabAdd: TNotifyEvent;
41 FOnTabEmpty: TNotifyEvent;
42 FOnTabOver: TATTabOverEvent;
43 FOnTabMove: TATTabMoveEvent;
44 FOnTabGetTick: TATTabGetTickEvent;
45 procedure SetOnTabClose(AEvent: TATTabCloseEvent);
46 procedure SetOnTabAdd(AEvent: TNotifyEvent);
47 procedure TabClick(Sender: TObject);
48 procedure TabDrawBefore(Sender: TObject;
49 AType: TATTabElemType; ATabIndex: Integer;
50 C: TCanvas; const ARect: TRect; var ACanDraw: boolean);
51 procedure TabEmpty(Sender: TObject);
52 procedure TabOver(Sender: TObject; ATabIndex: Integer);
53 procedure TabMove(Sender: TObject; NFrom, NTo: Integer);
TabGetTicknull54 function TabGetTick(Sender: TObject; ATabObject: TObject): Int64;
55 protected
56 procedure Resize; override;
57 procedure Click; override;
58 procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
59 var Accept: Boolean); override;
60 procedure DragDrop(Source: TObject; X, Y: Integer); override;
61 public
62 constructor Create(AOwner: TComponent); override;
AddTabnull63 function AddTab(AIndex: integer; AData: TATTabData; AndActivate: boolean=true): integer;
64 property Tabs: TATTabs read FTabs;
65 property EnabledEmpty: boolean read FEnabledEmpty write FEnabledEmpty;
66 property OnTabFocus: TNotifyEvent read FOnTabFocus write FOnTabFocus;
67 property OnTabClose: TATTabCloseEvent read FOnTabClose write SetOnTabClose;
68 property OnTabAdd: TNotifyEvent read FOnTabAdd write SetOnTabAdd;
69 property OnTabEmpty: TNotifyEvent read FOnTabEmpty write FOnTabEmpty;
70 property OnTabOver: TATTabOverEvent read FOnTabOver write FOnTabOver;
71 property OnTabMove: TATTabMoveEvent read FOnTabMove write FOnTabMove;
72 property OnTabGetTick: TATTabGetTickEvent read FOnTabGetTick write FOnTabGetTick;
73 end;
74
75 type
76 TATTabCloseId = (
77 tabCloseCurrent,
78 tabCloseOthersThisPage,
79 tabCloseOthersAllPages,
80 tabCloseLefterThisPage,
81 tabCloseRighterThisPage,
82 tabCloseAllThisPage,
83 tabCloseAll
84 );
85
86 type
87 TATTabsStringOptionId = (
88 tabOptionModifiedText,
89 tabOptionButtonLayout,
90 tabOptionHintForX,
91 tabOptionHintForPlus,
92 tabOptionHintForArrowLeft,
93 tabOptionHintForArrowRight,
94 tabOptionHintForArrowMenu
95 );
96
97 type
98 TATTabsOptionId = (
99 tabColorText,
100 tabColorTextActive,
101 tabColorTextModified,
102 tabColorBg,
103 tabColorBgActive,
104 tabColorBgPassive,
105 tabColorBgPassiveOver,
106 tabColorBorderActive,
107 tabColorBorderPassive,
108 tabColorSeparator,
109 tabColorCloseBg,
110 tabColorCloseBgOver,
111 tabColorCloseBorderOver,
112 tabColorCloseX,
113 tabColorCloseXOver,
114 tabColorArrow,
115 tabColorArrowOver,
116 tabColorSpecMarks,
117 tabColorActiveMark,
118 tabOptionShowHint,
119 tabOptionVarWidth,
120 tabOptionMultiline,
121 tabOptionScalePercents,
122 tabOptionFontSize,
123 tabOptionPosition,
124 tabOptionShowFlat,
125 tabOptionShowTabs,
126 tabOptionShowXButtons,
127 tabOptionShowXRounded,
128 tabOptionShowPlus,
129 tabOptionShowNums,
130 tabOptionShowEntireColor,
131 tabOptionMouseWheelMode,
132 tabOptionDoubleClickClose,
133 tabOptionMiddleClickClose,
134 tabOptionDragDrop,
135 tabOptionDragFromNotATTabs,
136 tabOptionHeightInner,
137 tabOptionWidthNormal,
138 tabOptionWidthMin,
139 tabOptionWidthMax,
140 tabOptionSpacer,
141 tabOptionSpacer2,
142 tabOptionSpaceInitial,
143 tabOptionSpaceBeforeText,
144 tabOptionSpaceBetweenTabs,
145 tabOptionSpaceSide,
146 tabOptionFontScale,
147 tabOptionColoredBandSize,
148 tabOptionActiveMarkSize,
149 tabOptionScrollMarkSizeX,
150 tabOptionScrollMarkSizeY,
151 tabOptionSpaceXRight,
152 tabOptionSpaceXSize,
153 tabOptionArrowSize,
154 tabOptionButtonSize,
155 tabOptionShowArrowsNear,
156 tabOptionWhichActivateOnClose
157 );
158
159 type
160 TATGroupsMode = (
161 gmUninited,
162 gmOne,
163 gm2v,
164 gm2h,
165 gm3v,
166 gm3h,
167 gm1plus2v,
168 gm1plus2h,
169 gm4v,
170 gm4h,
171 gm4grid,
172 gm6v,
173 gm6h,
174 gm6grid
175 );
176
177 const
178 cGroupsCount: array[TATGroupsMode] of Integer = (
179 1,
180 1,
181 2,
182 2,
183 3,
184 3,
185 3,
186 3,
187 4,
188 4,
189 4,
190 6,
191 6,
192 6
193 );
194
195 type
196 TATGroupsNums = 0..5;
197
198 type
199 TATGroupsPoints = array[TATGroupsNums] of TPoint;
200
201 type
202 TATGroupsPopupEvent = procedure(Sender: TObject; APages: TATPages; ATabIndex: integer) of object;
203
204 type
205 { TATGroups }
206
207 TATGroups = class(TPanel)
208 private
209 FSplit1,
210 FSplit2,
211 FSplit3,
212 FSplit4,
213 FSplit5: TMySplitter;
214 FPanel1,
215 FPanel2: TPanel;
216 FPos1,
217 FPos2,
218 FPos3,
219 FPos4,
220 FPos5: Double;
221 FPrevWidth,
222 FPrevHeight: Integer;
223 FSplitPopup: TMyPopupMenu;
224 FSplitW: integer;
225 FMode: TATGroupsMode;
226 FOnChangeMode: TNotifyEvent;
227 FOnTabPopup: TATGroupsPopupEvent;
228 FOnTabFocus: TNotifyEvent;
229 FOnTabClose: TATTabCloseEvent;
230 FOnTabAdd: TNotifyEvent;
231 FOnTabOver: TATTabOverEvent;
232 FOnTabMove: TATTabMoveEvent;
233 FOnEmpty: TNotifyEvent;
234 FOnTabGetTick: TATTabGetTickEvent;
235 FPopupPages: TATPages;
236 FPopupTabIndex: Integer;
GetImagesnull237 function GetImages: TImageList;
238 procedure SetImages(AValue: TImageList);
239 procedure SetSplitterMinSize(AValue: integer);
240 procedure SetSplitterResizeStyle(AValue: TResizeStyle);
241 procedure SetSplitterColor(AValue: TColor);
242 procedure SplitterOnPaint(Sender: TObject);
243 procedure TabFocus(Sender: TObject);
244 procedure TabEmpty(Sender: TObject);
245 procedure TabPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
246 procedure TabClose(Sender: TObject; ATabIndex: Integer;
247 var ACanClose, ACanContinue: boolean);
248 procedure TabAdd(Sender: TObject);
249 procedure TabOver(Sender: TObject; ATabIndex: Integer);
250 procedure TabMove(Sender: TObject; NFrom, NTo: Integer);
TabGetTicknull251 function TabGetTick(Sender: TObject; ATabObject: TObject): Int64;
252 procedure SetMode(Value: TATGroupsMode);
GetMainPosnull253 function GetMainPos: Integer;
254 procedure SetMainPos(N: Integer);
255 procedure Split1Moved(Sender: TObject);
256 procedure Split2Moved(Sender: TObject);
257 procedure Split3Moved(Sender: TObject);
258 procedure Split4Moved(Sender: TObject);
259 procedure Split5Moved(Sender: TObject);
260 procedure SplitClick(Sender: TObject);
261 procedure InitSplitterPopup;
262 procedure MoveTabsOnModeChanging(Value: TATGroupsMode);
263 protected
264 procedure Resize; override;
265 public
266 Pages1,
267 Pages2,
268 Pages3,
269 Pages4,
270 Pages5,
271 Pages6,
272 PagesCurrent: TATPages;
273 Pages: array[TATGroupsNums] of TATPages;
274 //
275 property Images: TImageList read GetImages write SetImages;
276 property Panel1: TPanel read FPanel1;
277 property Splitter1: TMySplitter read FSplit1;
278 property Splitter2: TMySplitter read FSplit2;
279 property Splitter3: TMySplitter read FSplit3;
280 property Splitter4: TMySplitter read FSplit4;
281 property Splitter5: TMySplitter read FSplit5;
282 property SplitterResizeStyle: TResizeStyle write SetSplitterResizeStyle;
283 property SplitterMinSize: integer write SetSplitterMinSize;
284 property SplitterColor: TColor write SetSplitterColor;
285 //
286 constructor Create(AOwner: TComponent); override;
287 procedure Invalidate; override;
288 //
PagesVisibleCountnull289 function PagesVisibleCount: Integer;
PagesSetIndexnull290 function PagesSetIndex(ANum: Integer): boolean;
291 procedure PagesSetNext(ANext: boolean);
PagesNextIndexnull292 function PagesNextIndex(AIndex: Integer; ANext: boolean; AEnableEmpty: boolean): Integer;
FindPagesnull293 function FindPages(APages: TATPages): Integer;
294 procedure FindPositionOfControl(AObject: TObject; out APagesIndex, ATabIndex: Integer);
295 procedure GetSizes(out APanelSize: TPoint; out APageSize: TATGroupsPoints);
296 procedure SetSizes(const APanelSize: TPoint; const APageSize: TATGroupsPoints);
297 //
298 property PopupPages: TATPages read FPopupPages write FPopupPages;
299 property PopupTabIndex: Integer read FPopupTabIndex write FPopupTabIndex;
300 property SplitterPopupMenu: TMyPopupMenu read FSplitPopup;
301 //
302 property Mode: TATGroupsMode read FMode write SetMode;
303
GetTabTotalCountnull304 function GetTabTotalCount: Integer;
GetTabDataOfTotalIndexnull305 function GetTabDataOfTotalIndex(N: Integer): TATTabData;
SetPagesAndTabIndexnull306 function SetPagesAndTabIndex(APageIndex, ATabIndex: Integer): boolean;
307 procedure SetTabOption(Id: TATTabsOptionId; N: Integer);
308 procedure SetTabOptionString(Id: TATTabsStringOptionId; const AValue: string);
309 procedure SetTabFont(AFont: TFont);
GetTabSingleRowHeightnull310 function GetTabSingleRowHeight: integer;
311 //
CloseTabsOthernull312 function CloseTabsOther(APages: TATPages; ATabIndex: Integer;
313 ADoRighter, ADoLefter: boolean): boolean;
CloseTabsAllnull314 function CloseTabsAll(APages: TATPages): boolean;
CloseTabsnull315 function CloseTabs(Id: TATTabCloseId; AForPopupMenu: boolean): boolean;
316 //
317 procedure MoveTab(AFromPages: TATPages; AFromIndex: Integer;
318 AToPages: TATPages; AToIndex: Integer; AActivateTabAfter: boolean);
319 procedure MoveTabsFromGroupToAnother(APagesFrom, APagesTo: TATPages);
320 procedure MovePopupTabToNext(ANext: boolean);
321 procedure MoveCurrentTabToNext(ANext: boolean);
322 procedure MoveCurrentTabToOpposite;
323 //
324 property MainPos: Integer read GetMainPos write SetMainPos;
325 procedure MainPosIncrease;
326 procedure MainPosDecrease;
327 procedure SaveSplitPos;
328 procedure RestoreSplitPos;
329 //
330 property OnChangeMode: TNotifyEvent read FOnChangeMode write FOnChangeMode;
331 property OnTabPopup: TATGroupsPopupEvent read FOnTabPopup write FOnTabPopup;
332 property OnTabFocus: TNotifyEvent read FOnTabFocus write FOnTabFocus;
333 property OnTabClose: TATTabCloseEvent read FOnTabClose write FOnTabClose;
334 property OnTabAdd: TNotifyEvent read FOnTabAdd write FOnTabAdd;
335 property OnTabOver: TATTabOverEvent read FOnTabOver write FOnTabOver;
336 property OnTabMove: TATTabMoveEvent read FOnTabMove write FOnTabMove;
337 property OnTabGetTick: TATTabGetTickEvent read FOnTabGetTick write FOnTabGetTick;
338 property OnEmpty: TNotifyEvent read FOnEmpty write FOnEmpty;
339 end;
340
PtInControlnull341 function PtInControl(Control: TControl; const ScreenPnt: TPoint): boolean;
342 {
343 procedure DoControlLock(Ctl: TWinControl);
344 procedure DoControlUnlock(Ctl: TWinControl);
345 }
346
347 var
348 MaxTabsHeightPercentsForMultiline: Integer = 70;
349
350 implementation
351
352 uses
353 {$ifdef windows}
354 Windows, Messages,
355 {$endif}
356 SysUtils, StrUtils,
357 {$ifdef SP}
358 SpTbxSkins,
359 {$endif}
360 {$ifdef FPC}
361 LCLType,
362 {$endif}
363 Math, Dialogs;
364
365 const
366 cAbsMin = 4;
367
368 procedure UpdW(C: TControl; Value: Integer); inline;
369 begin
370 if C.Align<>alClient then
371 if Value>cAbsMin then
372 C.Width:= Value;
373 end;
374
375 procedure UpdH(C: TControl; Value: Integer); inline;
376 begin
377 if C.Align<>alClient then
378 if Value>cAbsMin then
379 C.Height:= Value;
380 end;
381
PtInControlnull382 function PtInControl(Control: TControl; const ScreenPnt: TPoint): boolean;
383 begin
384 Result:= PtInRect(Control.ClientRect, Control.ScreenToClient(ScreenPnt));
385 end;
386
387 procedure DoControlLock(Ctl: TWinControl); inline;
388 begin
389 ////If it's called, CudaText has bug: change group mode from 1 to 4Vert,
390 ////and splitters show on wrong positions
391
392 //Ctl.DisableAutoSizing;
393
394 {$ifdef windows}
395 Ctl.Perform(WM_SetRedraw, 0, 0);
396 {$endif}
397 end;
398
399 procedure DoControlUnlock(Ctl: TWinControl); inline;
400 begin
401 //Ctl.EnableAutoSizing;
402
403 {$ifdef windows}
404 Ctl.Perform(WM_SetRedraw, 1, 0);
405 SetWindowPos(Ctl.Handle, 0, 0, 0, 0, 0,
406 SWP_FRAMECHANGED or SWP_NOCOPYBITS or SWP_NOMOVE or SWP_NOZORDER or SWP_NOSIZE);
407 {$endif}
408 end;
409
410
411 { TATPages }
412
413 constructor TATPages.Create(AOwner: TComponent);
414 begin
415 inherited;
416
417 Caption:= '';
418 BorderStyle:= bsNone;
419 BevelInner:= bvNone;
420 BevelOuter:= bvNone;
421 DragMode:= dmAutomatic;
422 FEnabledEmpty:= true;
423
424 Width:= 600;
425 Height:= 600;
426
427 FTabs:= TATTabs.Create(Self);
428 FTabs.Parent:= Self;
429 FTabs.Align:= alTop;
430 FTabs.OnTabClick:= TabClick;
431 FTabs.OnTabDrawBefore:= TabDrawBefore;
432 FTabs.OnTabEmpty:= TabEmpty;
433 FTabs.OnTabOver:= TabOver;
434 FTabs.OnTabMove:= TabMove;
435 FTabs.OnTabGetTick:= TabGetTick;
436
437 //dont set FTabs.DragMode:=dmAutomatic, because then
438 //DragNDrop is called (Lazarus) even with simple closing of tabs by X icon
439 // http://synwrite.sourceforge.net/forums/viewtopic.php?f=20&t=2604
440
441 FTabs.OptTabHeight:= 24;
442 FTabs.OptSpacer:= 2;
443 FTabs.OptSpacer2:= 4;
444 FTabs.OptSpaceBetweenTabs:= 0;
445 FTabs.OptSpaceXSize:= 14;
446 FTabs.OptColoredBandSize:= 5;
447 FTabs.OptTabWidthMinimal:= 40;
448 FTabs.Height:= FTabs.OptTabHeight+FTabs.OptSpacer+1;
449
450 FTabs.OptShowModifiedText:= #$95;
451 FTabs.OptMouseMiddleClickClose:= true;
452 FTabs.OptMouseDoubleClickPlus:= true;
453
454 FTabs.ColorBg:= clWindow;
455 FTabs.ColorCloseX:= clDkGray;
456 end;
457
AddTabnull458 function TATPages.AddTab(AIndex: integer; AData: TATTabData;
459 AndActivate: boolean): integer;
460 begin
461 FTabs.AddTab(AIndex, AData);
462
463 if AData.TabObject is TControl then
464 begin
465 TControl(AData.TabObject).Parent:= Self;
466 TControl(AData.TabObject).Align:= alClient;
467 end;
468
469 if AIndex<0 then
470 Result:= FTabs.TabCount-1
471 else
472 Result:= AIndex;
473
474 if AndActivate then
475 FTabs.TabIndex:= Result;
476 end;
477
478 procedure TATPages.TabClick(Sender: TObject);
479 var
480 i: Integer;
481 D: TATTabData;
482 Ctl: TWinControl;
483 begin
484 DoControlLock(Self);
485 try
486 for i:= 0 to FTabs.TabCount-1 do
487 begin
488 D:= FTabs.GetTabData(i);
489 if D<>nil then
490 begin
491 Ctl:= D.TabObject as TWinControl;
492 Ctl.Visible:= i=FTabs.TabIndex;
493 end;
494 end;
495 finally
496 DoControlUnlock(Self);
497 end;
498
499 D:= FTabs.GetTabData(FTabs.TabIndex);
500 if D<>nil then
501 begin
502 Ctl:= D.TabObject as TWinControl;
503 if Ctl.Showing then
504 if Assigned(FOnTabFocus) then
505 FOnTabFocus(FTabs);
506 end;
507 end;
508
509 procedure TATPages.SetOnTabClose(AEvent: TATTabCloseEvent);
510 begin
511 FOnTabClose:= AEvent;
512 FTabs.OnTabClose:= AEvent;
513 end;
514
515 procedure TATPages.SetOnTabAdd(AEvent: TNotifyEvent);
516 begin
517 FOnTabAdd:= AEvent;
518 FTabs.OnTabPlusClick:= AEvent;
519 end;
520
521 procedure TATPages.TabEmpty(Sender: TObject);
522 begin
523 if Assigned(FOnTabEmpty) then
524 FOnTabEmpty(Sender);
525 end;
526
527 procedure TATPages.TabOver(Sender: TObject; ATabIndex: Integer);
528 begin
529 if Assigned(FOnTabOver) then
530 FOnTabOver(Sender, ATabIndex);
531 end;
532
533 procedure TATPages.TabMove(Sender: TObject; NFrom, NTo: Integer);
534 begin
535 if Assigned(FOnTabMove) then
536 FOnTabMove(Sender, NFrom, NTo);
537 end;
538
TabGetTicknull539 function TATPages.TabGetTick(Sender: TObject; ATabObject: TObject): Int64;
540 begin
541 if Assigned(FOnTabGetTick) then
542 Result:= FOnTabGetTick(Sender, ATabObject)
543 else
544 Result:= 0;
545 end;
546
547 procedure TATPages.Resize;
548 begin
549 inherited;
550
551 if Assigned(FTabs) then
552 if (FTabs.OptPosition in [atpTop, atpBottom]) and FTabs.OptMultiline then
553 FTabs.Constraints.MaxHeight:= Max(
554 Height * MaxTabsHeightPercentsForMultiline div 100,
555 FTabs.OptTabHeight
556 );
557 end;
558
559 procedure TATPages.Click;
560 begin
561 inherited;
562 //click on empty area - add tab
563 if FTabs.TabCount=0 then
564 if Assigned(FOnTabAdd) then
565 FOnTabAdd(FTabs);
566 end;
567
568 procedure TATPages.DragOver(Source: TObject; X, Y: Integer; State: TDragState;
569 var Accept: Boolean);
570 begin
571 Accept:= Source is TATTabs;
572 end;
573
574 procedure TATPages.DragDrop(Source: TObject; X, Y: Integer);
575 begin
576 if Source is TATTabs then
577 TATTabs(Source).DoTabDropToOtherControl(Self.Tabs, Types.Point(2, 2));
578 end;
579
580 { TATGroups }
581
582 constructor TATGroups.Create(AOwner: TComponent);
583 var
584 i: Integer;
585 begin
586 inherited;
587
588 Caption:= '';
589 BorderStyle:= bsNone;
590 BevelInner:= bvNone;
591 BevelOuter:= bvNone;
592
593 Pages1:= TATPages.Create(Self);
594 Pages2:= TATPages.Create(Self);
595 Pages3:= TATPages.Create(Self);
596 Pages4:= TATPages.Create(Self);
597 Pages5:= TATPages.Create(Self);
598 Pages6:= TATPages.Create(Self);
599
600 Pages1.EnabledEmpty:= false;
601 PagesCurrent:= Pages1;
602 Pages[0]:= Pages1;
603 Pages[1]:= Pages2;
604 Pages[2]:= Pages3;
605 Pages[3]:= Pages4;
606 Pages[4]:= Pages5;
607 Pages[5]:= Pages6;
608
609 for i:= Low(Pages) to High(Pages) do
610 with Pages[i] do
611 begin
612 Visible:= i=Low(Pages);
613 Name:= 'aPages'+IntToStr(i); //debug
614 Caption:= '';
615 Tabs.Name:= 'aPagesTabs'+IntToStr(i); //debug
616 //
617 Parent:= Self;
618 Align:= alLeft;
619 //
620 Tabs.OnContextPopup:= Self.TabPopup;
621 OnTabEmpty:= Self.TabEmpty;
622 OnTabFocus:= Self.TabFocus;
623 OnTabClose:= Self.TabClose;
624 OnTabAdd:= Self.TabAdd;
625 OnTabOver:= Self.TabOver;
626 OnTabMove:= Self.TabMove;
627 OnTabGetTick:= Self.TabGetTick;
628 end;
629
630 FSplitW:= 5;
631
632 FSplit1:= TMySplitter.Create(Self);
633 FSplit1.Parent:= Self;
634 FSplit1.OnMoved:= Split1Moved;
635
636 FSplit2:= TMySplitter.Create(Self);
637 FSplit2.Parent:= Self;
638 FSplit2.OnMoved:= Split2Moved;
639
640 FSplit3:= TMySplitter.Create(Self);
641 FSplit3.Parent:= Self;
642 FSplit3.OnMoved:= Split3Moved;
643
644 FSplit4:= TMySplitter.Create(Self);
645 FSplit4.Parent:= Self;
646 FSplit4.OnMoved:= Split4Moved;
647
648 FSplit5:= TMySplitter.Create(Self);
649 FSplit5.Parent:= Self;
650 FSplit5.OnMoved:= Split5Moved;
651
652 SplitterResizeStyle:= rsPattern;
653 SplitterMinSize:= 10;
654 SplitterColor:= clMoneyGreen;
655
656 FSplit1.Width:= FSplitW;
657 FSplit2.Width:= FSplitW;
658 FSplit3.Width:= FSplitW;
659 FSplit4.Width:= FSplitW;
660 FSplit5.Width:= FSplitW;
661
662 {$ifdef fpc}
663 FSplit1.AutoSnap:= false;
664 FSplit2.AutoSnap:= false;
665 FSplit3.AutoSnap:= false;
666 FSplit4.AutoSnap:= false;
667 FSplit5.AutoSnap:= false;
668 {$endif}
669
670 FPanel1:= TPanel.Create(Self);
671 FPanel1.Parent:= Self;
672 FPanel1.Align:= alTop;
673 FPanel1.Caption:= '';
674 FPanel1.BorderStyle:= bsNone;
675 FPanel1.BevelInner:= bvNone;
676 FPanel1.BevelOuter:= bvNone;
677 FPanel1.Visible:= false;
678
679 FPanel2:= TPanel.Create(Self);
680 FPanel2.Parent:= Self;
681 FPanel2.Align:= alClient;
682 FPanel2.Caption:= '';
683 FPanel2.BorderStyle:= bsNone;
684 FPanel2.BevelInner:= bvNone;
685 FPanel2.BevelOuter:= bvNone;
686 FPanel2.Visible:= false;
687
688 InitSplitterPopup;
689 FPopupPages:= nil;
690 FPopupTabIndex:= -1;
691 FMode:= gmOne;
692 end;
693
694 procedure TATGroups.Invalidate;
695 var
696 FPage: TATPages;
697 i: integer;
698 begin
699 inherited;
700
701 for i:= Low(TATGroupsNums) to High(TATGroupsNums) do
702 begin
703 FPage:= Pages[i];
704 if Assigned(FPage) then
705 FPage.Tabs.Invalidate;
706 end;
707 end;
708
709 procedure TATGroups.InitSplitterPopup;
710 //
711 procedure Add(N: Integer);
712 var
713 MI: {$ifdef SP}TSpTbxItem{$else}TMenuItem{$endif};
714 begin
715 MI:= {$ifdef SP}TSpTbxItem{$else}TMenuItem{$endif}.Create(Self);
716 MI.Caption:= Format('%d/%d', [N, 100-N]);
717 MI.Tag:= N;
718 MI.OnClick:= SplitClick;
719 FSplitPopup.Items.Add(MI);
720 end;
721 //
722 begin
723 FSplitPopup:= TMyPopupMenu.Create(Self);
724 Add(20);
725 Add(30);
726 Add(40);
727 Add(50);
728 Add(60);
729 Add(70);
730 Add(80);
731 end;
732
733 procedure SetSplitterPopup(ASplitter: TMySplitter; APopup: TPopupMenu);
734 begin
735 //some Delphi version dont publish TSplitter.PopupMenu
736 ASplitter.PopupMenu:= APopup;
737 end;
738
739 procedure TATGroups.MoveTabsFromGroupToAnother(APagesFrom, APagesTo: TATPages);
740 var
741 i: integer;
742 begin
743 for i:= 0 to APagesFrom.Tabs.TabCount-1 do
744 MoveTab(APagesFrom, 0{first tab}, APagesTo, -1, false);
745 end;
746
747 procedure TATGroups.MoveTabsOnModeChanging(Value: TATGroupsMode);
748 var
749 NCountBefore, NCountAfter, i: Integer;
750 begin
751 NCountBefore:= cGroupsCount[FMode];
752 NCountAfter:= cGroupsCount[Value];
753
754 //loop over group indexes, which will hide after mode changed
755 for i:= NCountAfter to NCountBefore-1 do
756 MoveTabsFromGroupToAnother(Pages[i], Pages[NCountAfter-1]);
757 end;
758
759 procedure TATGroups.SetMode(Value: TATGroupsMode);
760 var
761 NSplit: Double;
762 NPagesBefore, NPagesAfter: Integer;
763 w, h, i: Integer;
764 begin
765 if Value=gmUninited then
766 Value:= gmOne;
767 if (Value<>gmOne) and (Value=FMode) then Exit;
768
769 w:= Width;
770 h:= Height;
771 if w<2 then exit;
772 if h<2 then exit;
773
774 try
775 DoControlLock(Self);
776
777 //actions before changing FMode
778 NPagesBefore:= FindPages(PagesCurrent);
779 MoveTabsOnModeChanging(Value);
780
781 case FMode of
782 gm2v:
783 NSplit:= Pages1.Width / w;
784 gm2h:
785 NSplit:= Pages1.Height / h;
786 else
787 NSplit:= 0.5;
788 end;
789
790 //changing FMode and actions after changing
791 FMode:= Value;
792
793 SetSplitterPopup(FSplit1, nil);
794 SetSplitterPopup(FSplit3, nil);
795 case FMode of
796 gm2v, gm2h:
797 SetSplitterPopup(FSplit1, FSplitPopup);
798 gm1plus2v, gm1plus2h:
799 SetSplitterPopup(FSplit3, FSplitPopup);
800 end;
801
802 for i:= Low(Pages) to High(Pages) do
803 Pages[i].Visible:= i<cGroupsCount[FMode];
804
805 case FMode of
806 gm1plus2v:
807 begin
808 FPanel1.Visible:= true;
809 FPanel2.Visible:= true;
810 Pages1.Parent:= FPanel1;
811 Pages2.Parent:= FPanel2;
812 Pages3.Parent:= FPanel2;
813 Pages4.Parent:= FPanel2;
814 Pages5.Parent:= FPanel2;
815 Pages6.Parent:= FPanel2;
816 FSplit1.Parent:= FPanel1;
817 FSplit2.Parent:= FPanel2;
818 FSplit3.Parent:= Self;
819 FSplit4.Parent:= Self;
820 FSplit5.Parent:= Self;
821 //
822 FPanel1.Align:= alLeft;
823 end;
824 gm1plus2h:
825 begin
826 FPanel1.Visible:= true;
827 FPanel2.Visible:= true;
828 Pages1.Parent:= FPanel1;
829 Pages2.Parent:= FPanel2;
830 Pages3.Parent:= FPanel2;
831 Pages4.Parent:= FPanel2;
832 Pages5.Parent:= FPanel2;
833 Pages6.Parent:= FPanel2;
834 FSplit1.Parent:= FPanel1;
835 FSplit2.Parent:= FPanel2;
836 FSplit3.Parent:= Self;
837 FSplit4.Parent:= Self;
838 FSplit5.Parent:= Self;
839 //
840 FPanel1.Align:= alTop;
841 end;
842 gm4grid:
843 begin
844 FPanel1.Visible:= true;
845 FPanel2.Visible:= true;
846 Pages1.Parent:= FPanel1;
847 Pages2.Parent:= FPanel1;
848 Pages3.Parent:= FPanel2;
849 Pages4.Parent:= FPanel2;
850 Pages5.Parent:= FPanel2;
851 Pages6.Parent:= FPanel2;
852 FSplit1.Parent:= FPanel1;
853 FSplit2.Parent:= FPanel2;
854 FSplit3.Parent:= Self;
855 FSplit4.Parent:= Self;
856 FSplit5.Parent:= Self;
857 //
858 FPanel1.Align:= alTop;
859 end;
860 gm6grid:
861 begin
862 FPanel1.Visible:= true;
863 FPanel2.Visible:= true;
864 Pages1.Parent:= FPanel1;
865 Pages2.Parent:= FPanel1;
866 Pages3.Parent:= FPanel1;
867 Pages4.Parent:= FPanel2;
868 Pages5.Parent:= FPanel2;
869 Pages6.Parent:= FPanel2;
870 FSplit1.Parent:= FPanel1;
871 FSplit2.Parent:= FPanel1;
872 FSplit3.Parent:= Self;
873 FSplit4.Parent:= FPanel2;
874 FSplit5.Parent:= FPanel2;
875 //
876 FPanel1.Align:= alTop;
877 end
878 else
879 begin
880 FPanel1.Visible:= false;
881 FPanel2.Visible:= false;
882 Pages1.Parent:= Self;
883 Pages2.Parent:= Self;
884 Pages3.Parent:= Self;
885 Pages4.Parent:= Self;
886 Pages5.Parent:= Self;
887 Pages6.Parent:= Self;
888 FSplit1.Parent:= Self;
889 FSplit2.Parent:= Self;
890 FSplit3.Parent:= Self;
891 FSplit4.Parent:= Self;
892 FSplit5.Parent:= Self;
893 end;
894 end;
895
896 case FMode of
897 gmOne:
898 begin
899 FSplit1.Visible:= false;
900 FSplit2.Visible:= false;
901 FSplit3.Visible:= false;
902 FSplit4.Visible:= false;
903 FSplit5.Visible:= false;
904 Pages1.Align:= alClient;
905 end;
906 gm2v:
907 begin
908 FSplit1.Visible:= true;
909 FSplit2.Visible:= false;
910 FSplit3.Visible:= false;
911 FSplit4.Visible:= false;
912 FSplit5.Visible:= false;
913 Pages1.Align:= alLeft;
914 Pages2.Align:= alClient;
915 FSplit1.Align:= alLeft;
916 //size
917 UpdW(Pages1, Trunc(w * NSplit));
918 //pos
919 Pages2.Left:= w;
920 FSplit1.Left:= Pages2.Left;
921 end;
922 gm2h:
923 begin
924 FSplit1.Visible:= true;
925 FSplit2.Visible:= false;
926 FSplit3.Visible:= false;
927 FSplit4.Visible:= false;
928 FSplit5.Visible:= false;
929 Pages1.Align:= alTop;
930 Pages2.Align:= alClient;
931 FSplit1.Align:= alTop;
932 //size
933 UpdH(Pages1, Trunc(h * NSplit));
934 //pos
935 Pages2.Top:= h;
936 FSplit1.Top:= Pages2.Top;
937 end;
938 gm3v:
939 begin
940 FSplit1.Visible:= true;
941 FSplit2.Visible:= true;
942 FSplit3.Visible:= false;
943 FSplit4.Visible:= false;
944 FSplit5.Visible:= false;
945 Pages1.Align:= alLeft;
946 Pages2.Align:= alLeft;
947 Pages3.Align:= alClient;
948 FSplit1.Align:= alLeft;
949 FSplit2.Align:= alLeft;
950 //size
951 UpdW(Pages1, w div 3);
952 UpdW(Pages2, w div 3);
953 //pos
954 Pages2.Left:= w;
955 Pages3.Left:= w;
956 FSplit1.Left:= Pages2.Left;
957 FSplit2.Left:= Pages3.Left;
958 end;
959 gm3h:
960 begin
961 FSplit1.Visible:= true;
962 FSplit2.Visible:= true;
963 FSplit3.Visible:= false;
964 FSplit4.Visible:= false;
965 FSplit5.Visible:= false;
966 Pages1.Align:= alTop;
967 Pages2.Align:= alTop;
968 Pages3.Align:= alClient;
969 FSplit1.Align:= alTop;
970 FSplit2.Align:= alTop;
971 //size
972 UpdH(Pages1, h div 3);
973 UpdH(Pages2, h div 3);
974 //pos
975 Pages2.Top:= h;
976 Pages3.Top:= h;
977 FSplit1.Top:= Pages2.Top;
978 FSplit2.Top:= Pages3.Top;
979 end;
980 gm4v:
981 begin
982 FSplit1.Visible:= true;
983 FSplit2.Visible:= true;
984 FSplit3.Visible:= true;
985 FSplit4.Visible:= false;
986 FSplit5.Visible:= false;
987 Pages1.Align:= alLeft;
988 Pages2.Align:= alLeft;
989 Pages3.Align:= alLeft;
990 Pages4.Align:= alClient;
991 FSplit1.Align:= alLeft;
992 FSplit2.Align:= alLeft;
993 FSplit3.Align:= alLeft;
994 //size
995 UpdW(Pages1, w div 4);
996 UpdW(Pages2, w div 4);
997 UpdW(Pages3, w div 4);
998 //pos
999 Pages2.Left:= w;
1000 Pages3.Left:= w;
1001 Pages4.Left:= w;
1002 FSplit1.Left:= Pages2.Left;
1003 FSplit2.Left:= Pages3.Left;
1004 FSplit3.Left:= Pages4.Left;
1005 end;
1006 gm4h:
1007 begin
1008 FSplit1.Visible:= true;
1009 FSplit2.Visible:= true;
1010 FSplit3.Visible:= true;
1011 FSplit4.Visible:= false;
1012 FSplit5.Visible:= false;
1013 Pages1.Align:= alTop;
1014 Pages2.Align:= alTop;
1015 Pages3.Align:= alTop;
1016 Pages4.Align:= alClient;
1017 FSplit1.Align:= alTop;
1018 FSplit2.Align:= alTop;
1019 FSplit3.Align:= alTop;
1020 //size
1021 UpdH(Pages1, h div 4);
1022 UpdH(Pages2, h div 4);
1023 UpdH(Pages3, h div 4);
1024 //pos
1025 Pages2.Top:= h;
1026 Pages3.Top:= h;
1027 Pages4.Top:= h;
1028 FSplit1.Top:= Pages2.Top;
1029 FSplit2.Top:= Pages3.Top;
1030 FSplit3.Top:= Pages4.Top;
1031 end;
1032 gm4grid:
1033 begin
1034 FSplit1.Visible:= true;
1035 FSplit2.Visible:= true;
1036 FSplit3.Visible:= true;
1037 FSplit4.Visible:= false;
1038 FSplit5.Visible:= false;
1039 Pages1.Align:= alLeft;
1040 Pages2.Align:= alClient;
1041 Pages3.Align:= alLeft;
1042 Pages4.Align:= alClient;
1043 FSplit1.Align:= alLeft;
1044 FSplit2.Align:= alLeft;
1045 FSplit3.Align:= alTop;
1046 //size
1047 UpdW(Pages1, w div 2);
1048 UpdW(Pages3, w div 2);
1049 UpdH(FPanel1, h div 2);
1050 //pos-a
1051 FSplit1.Left:= w;
1052 Pages2.Left:= w;
1053 //pos-b
1054 FSplit2.Left:= w;
1055 Pages4.Left:= w;
1056 //pos-c
1057 FSplit3.Top:= h;
1058 FPanel2.Top:= h;
1059 end;
1060 gm1plus2v:
1061 begin
1062 FSplit1.Visible:= false;
1063 FSplit2.Visible:= true;
1064 FSplit3.Visible:= true;
1065 FSplit4.Visible:= false;
1066 FSplit5.Visible:= false;
1067 Pages1.Align:= alClient; //pages1 on panel1
1068 Pages2.Align:= alTop; //pages2 on panel2
1069 Pages3.Align:= alClient;
1070 Pages4.Align:= alBottom;
1071 FSplit1.Align:= alTop;
1072 FSplit2.Align:= alTop;
1073 FSplit3.Align:= alLeft;
1074 //size
1075 UpdH(Pages2, h div 2);
1076 UpdW(FPanel1, w div 2);
1077 //pos-b
1078 FSplit2.Top:= h;
1079 Pages4.Top:= h;
1080 //pos-c
1081 FSplit3.Left:= w;
1082 FPanel2.Left:= w;
1083 end;
1084 gm1plus2h:
1085 begin
1086 FSplit1.Visible:= false;
1087 FSplit2.Visible:= true;
1088 FSplit3.Visible:= true;
1089 FSplit4.Visible:= false;
1090 FSplit5.Visible:= false;
1091 Pages1.Align:= alClient; //pages1 on panel1
1092 Pages2.Align:= alLeft; //pages2 on panel2
1093 Pages3.Align:= alClient;
1094 Pages4.Align:= alRight;
1095 FSplit1.Align:= alLeft;
1096 FSplit2.Align:= alLeft;
1097 FSplit3.Align:= alTop;
1098 //size
1099 UpdW(Pages2, w div 2);
1100 UpdH(FPanel1, h div 2);
1101 //pos-b
1102 FSplit2.Left:= w;
1103 Pages4.Left:= w;
1104 //pos-c
1105 FSplit3.Top:= h;
1106 FPanel2.Top:= h;
1107 end;
1108 gm6grid:
1109 begin
1110 FSplit1.Visible:= true;
1111 FSplit2.Visible:= true;
1112 FSplit3.Visible:= true;
1113 FSplit4.Visible:= true;
1114 FSplit5.Visible:= true;
1115 Pages1.Align:= alLeft;
1116 Pages2.Align:= alLeft;
1117 Pages3.Align:= alClient;
1118 Pages4.Align:= alLeft;
1119 Pages5.Align:= alLeft;
1120 Pages6.Align:= alClient;
1121 FSplit1.Align:= alLeft;
1122 FSplit2.Align:= alLeft;
1123 FSplit3.Align:= alTop;
1124 FSplit4.Align:= alLeft;
1125 FSplit5.Align:= alLeft;
1126 //size
1127 UpdW(Pages1, w div 3);
1128 UpdW(Pages2, w div 3);
1129 UpdW(Pages4, w div 3);
1130 UpdW(Pages5, w div 3);
1131 UpdH(FPanel1, h div 2);
1132 //pos-a
1133 FSplit1.Left:= w;
1134 Pages2.Left:= w;
1135 FSplit2.Left:= w;
1136 Pages3.Left:= w;
1137 //pos-b
1138 FSplit4.Left:= w;
1139 Pages5.Left:= w;
1140 FSplit5.Left:= w;
1141 Pages6.Left:= w;
1142 //pos-c
1143 FSplit3.Top:= h;
1144 FPanel2.Top:= h;
1145 end;
1146 gm6v:
1147 begin
1148 FSplit1.Visible:= true;
1149 FSplit2.Visible:= true;
1150 FSplit3.Visible:= true;
1151 FSplit4.Visible:= true;
1152 FSplit5.Visible:= true;
1153 Pages1.Align:= alLeft;
1154 Pages2.Align:= alLeft;
1155 Pages3.Align:= alLeft;
1156 Pages4.Align:= alLeft;
1157 Pages5.Align:= alLeft;
1158 Pages6.Align:= alClient;
1159 FSplit1.Align:= alLeft;
1160 FSplit2.Align:= alLeft;
1161 FSplit3.Align:= alLeft;
1162 FSplit4.Align:= alLeft;
1163 FSplit5.Align:= alLeft;
1164 //size
1165 UpdW(Pages1, w div 6-3);
1166 UpdW(Pages2, w div 6-3);
1167 UpdW(Pages3, w div 6-3);
1168 UpdW(Pages4, w div 6-3);
1169 UpdW(Pages5, w div 6-3);
1170 //pos
1171 Pages2.Left:= w;
1172 Pages3.Left:= w;
1173 Pages4.Left:= w;
1174 Pages5.Left:= w;
1175 Pages6.Left:= w;
1176 FSplit1.Left:= Pages2.Left;
1177 FSplit2.Left:= Pages3.Left;
1178 FSplit3.Left:= Pages4.Left;
1179 FSplit4.Left:= Pages5.Left;
1180 FSplit5.Left:= Pages6.Left;
1181 end;
1182 gm6h:
1183 begin
1184 FSplit1.Visible:= true;
1185 FSplit2.Visible:= true;
1186 FSplit3.Visible:= true;
1187 FSplit4.Visible:= true;
1188 FSplit5.Visible:= true;
1189 Pages1.Align:= alTop;
1190 Pages2.Align:= alTop;
1191 Pages3.Align:= alTop;
1192 Pages4.Align:= alTop;
1193 Pages5.Align:= alTop;
1194 Pages6.Align:= alClient;
1195 FSplit1.Align:= alTop;
1196 FSplit2.Align:= alTop;
1197 FSplit3.Align:= alTop;
1198 FSplit4.Align:= alTop;
1199 FSplit5.Align:= alTop;
1200 //size
1201 UpdH(Pages1, h div 6-3);
1202 UpdH(Pages2, h div 6-3);
1203 UpdH(Pages3, h div 6-3);
1204 UpdH(Pages4, h div 6-3);
1205 UpdH(Pages5, h div 6-3);
1206 //pos
1207 Pages2.Top:= h;
1208 Pages3.Top:= h;
1209 Pages4.Top:= h;
1210 Pages5.Top:= h;
1211 Pages6.Top:= h;
1212 FSplit1.Top:= Pages2.Top;
1213 FSplit2.Top:= Pages3.Top;
1214 FSplit3.Top:= Pages4.Top;
1215 FSplit4.Top:= Pages5.Top;
1216 FSplit5.Top:= Pages6.Top;
1217 end;
1218 end;
1219
1220 SaveSplitPos;
1221
1222 //focus same group, if possible
1223 NPagesAfter:= Min(NPagesBefore, cGroupsCount[FMode]-1);
1224 if (NPagesAfter>=0) and (NPagesAfter<=High(TATGroupsNums)) then
1225 begin
1226 PagesCurrent:= Pages[NPagesAfter];
1227 if Assigned(FOnTabFocus) then
1228 FOnTabFocus(PagesCurrent.Tabs);
1229 end;
1230 finally
1231 DoControlUnlock(Self);
1232 end;
1233
1234 if Assigned(FOnChangeMode) then
1235 FOnChangeMode(Self);
1236 end;
1237
1238 procedure TATGroups.Split1Moved(Sender: TObject);
1239 var
1240 R: double;
1241 begin
1242 case FMode of
1243 gm3v:
1244 begin
1245 R:= FPos2/(1-FPos1);
1246 UpdW(Pages2, Trunc(R*(Width-Pages1.Width-2*FSplitW)));
1247 end;
1248 gm3h:
1249 begin
1250 R:= FPos2/(1-FPos1);
1251 UpdH(Pages2, Trunc(R*(Height-Pages1.Height-2*FSplitW)));
1252 end;
1253 gm4grid:
1254 begin
1255 UpdW(Pages3, Pages1.Width);
1256 end;
1257 gm6grid:
1258 begin
1259 R:= FPos2/(1-FPos1);
1260 UpdW(Pages2, Trunc(R*(Width-Pages1.Width-2*FSplitW)));
1261 UpdW(Pages4, Pages1.Width);
1262 UpdW(Pages5, Pages2.Width);
1263 end;
1264 end;
1265
1266 SaveSplitPos;
1267 end;
1268
1269 procedure TATGroups.Split2Moved(Sender: TObject);
1270 {
1271 var
1272 R: double;
1273 Size3: integer;
1274 }
1275 begin
1276 case FMode of
1277 {
1278 //disabled due to https://github.com/Alexey-T/CudaText/issues/3199
1279 gm3v:
1280 begin
1281 Size3:= Pages3.Width;
1282 R:= FPos1/(FPos1+FPos2);
1283 UpdW(Pages1, Trunc(R*(Width-Size3)));
1284 UpdW(Pages2, Width-Pages1.Width-Size3-2*FSplitW);
1285 end;
1286 gm3h:
1287 begin
1288 Size3:= Pages3.Height;
1289 R:= FPos1/(FPos1+FPos2);
1290 UpdH(Pages1, Trunc(R*(Height-Size3)));
1291 UpdH(Pages2, Height-Pages1.Height-Size3-2*FSplitW);
1292 end;
1293 }
1294 gm6grid:
1295 begin
1296 {
1297 Size3:= Pages3.Width;
1298 R:= FPos1/(FPos1+FPos2);
1299 UpdW(Pages1, Trunc(R*(Width-Size3)));
1300 UpdW(Pages2, Width-Pages1.Width-Size3-2*FSplitW);
1301 }
1302 UpdW(Pages4, Pages1.Width);
1303 UpdW(Pages5, Pages2.Width);
1304 end;
1305 gm4grid:
1306 begin
1307 UpdW(Pages1, Pages3.Width);
1308 end;
1309 end;
1310
1311 SaveSplitPos;
1312 end;
1313
1314 procedure TATGroups.Split3Moved(Sender: TObject);
1315 begin
1316 SaveSplitPos;
1317 end;
1318
1319 procedure TATGroups.Split4Moved(Sender: TObject);
1320 var
1321 R: double;
1322 begin
1323 case FMode of
1324 gm6grid:
1325 begin
1326 R:= FPos2/(1-FPos1);
1327 UpdW(Pages5, Trunc(R*(Width-Pages4.Width-2*FSplitW)));
1328 UpdW(Pages1, Pages4.Width);
1329 UpdW(Pages2, Pages5.Width);
1330 end;
1331 end;
1332
1333 SaveSplitPos;
1334 end;
1335
1336 procedure TATGroups.Split5Moved(Sender: TObject);
1337 {
1338 var
1339 R: double;
1340 Size6: integer;
1341 }
1342 begin
1343 case FMode of
1344 gm6grid:
1345 begin
1346 {
1347 //disabled due to https://github.com/Alexey-T/CudaText/issues/3199
1348 Size6:= Pages6.Width;
1349 R:= FPos1/(FPos1+FPos2);
1350 UpdW(Pages4, Trunc(R*(Width-Size6)));
1351 UpdW(Pages5, Width-Pages4.Width-Size6-2*FSplitW);
1352 }
1353 UpdW(Pages1, Pages4.Width);
1354 UpdW(Pages2, Pages5.Width);
1355 end;
1356 end;
1357
1358 SaveSplitPos;
1359 end;
1360
1361 procedure TATGroups.TabPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
1362 var
1363 Pnt, PntC: TPoint;
1364 IsX: boolean;
1365 i: Integer;
1366 begin
1367 FPopupPages:= nil;
1368 FPopupTabIndex:= -1;
1369
1370 Pnt:= (Sender as TControl).ClientToScreen(MousePos);
1371 for i:= Low(Pages) to High(Pages) do
1372 if PtInControl(Pages[i].Tabs, Pnt) then
1373 begin
1374 FPopupPages:= Pages[i];
1375 Break
1376 end;
1377 if FPopupPages=nil then Exit;
1378
1379 PntC:= PopupPages.Tabs.ScreenToClient(Pnt);
1380 FPopupTabIndex:= FPopupPages.Tabs.GetTabAt(PntC.X, PntC.Y, IsX);
1381
1382 if Assigned(FOnTabPopup) then
1383 FOnTabPopup(Self, FPopupPages, FPopupTabIndex);
1384 Handled:= true;
1385 end;
1386
1387 procedure TATPages.TabDrawBefore(Sender: TObject;
1388 AType: TATTabElemType; ATabIndex: Integer;
1389 C: TCanvas; const ARect: TRect; var ACanDraw: boolean);
1390 begin
1391 {$ifndef SP}
1392 ACanDraw:= true;
1393 {$else}
1394 case AType of
1395 aeBackground:
1396 begin
1397 if SkinManager.CurrentSkinName='Default' then
1398 begin
1399 C.Brush.Color:= clBtnFace;
1400 C.FillRect(ARect);
1401 end
1402 else
1403 CurrentSkin.PaintBackground(C, ARect,
1404 skncDock, sknsNormal, true{BG}, false{Borders});
1405 ACanDraw:= false;
1406 end;
1407
1408 aeXButton:
1409 begin
1410 //if ATabMouseOver then
1411 // SpDrawXPToolbarButton(Control.Canvas, R, sknsHotTrack, cpNone);
1412 SpDrawGlyphPattern(C, ARect, 0{0 is X icon index},
1413 CurrentSkin.GetTextColor(skncToolbarItem, sknsNormal));
1414 ACanDraw:= false;
1415 end;
1416
1417 aeXButtonOver:
1418 begin
1419 SpDrawXPToolbarButton(C,
1420 Rect(ARect.Left-1, ARect.Top-1, ARect.Right, ARect.Bottom),
1421 sknsHotTrack, cpNone);
1422 SpDrawGlyphPattern(C, ARect, 0{0 is X icon index},
1423 CurrentSkin.GetTextColor(skncToolbarItem, sknsNormal));
1424 ACanDraw:= false;
1425 end;
1426 end;
1427 {$endif}
1428 end;
1429
1430 procedure TATGroups.SaveSplitPos;
1431 var
1432 w, h: integer;
1433 begin
1434 w:= Width;
1435 h:= Height;
1436 if w<2 then Exit;
1437 if h<2 then Exit;
1438
1439 FPos1:= 0;
1440 FPos2:= 0;
1441 FPos3:= 0;
1442 FPos4:= 0;
1443 FPos5:= 0;
1444
1445 case FMode of
1446 gm2v,
1447 gm3v,
1448 gm4v,
1449 gm6v:
1450 begin
1451 FPos1:= Pages1.Width / w;
1452 FPos2:= Pages2.Width / w;
1453 FPos3:= Pages3.Width / w;
1454 FPos4:= Pages4.Width / w;
1455 FPos5:= Pages5.Width / w;
1456 end;
1457 gm2h,
1458 gm3h,
1459 gm4h,
1460 gm6h:
1461 begin
1462 FPos1:= Pages1.Height / h;
1463 FPos2:= Pages2.Height / h;
1464 FPos3:= Pages3.Height / h;
1465 FPos4:= Pages4.Height / h;
1466 FPos5:= Pages5.Height / h;
1467 end;
1468 gm1plus2v:
1469 begin
1470 FPos1:= FPanel1.Width / w;
1471 FPos2:= Pages2.Height / h;
1472 end;
1473 gm1plus2h:
1474 begin
1475 FPos1:= FPanel1.Height / h;
1476 FPos2:= Pages2.Width / w;
1477 end;
1478 gm4grid:
1479 begin
1480 FPos1:= Pages1.Width / w;
1481 FPos2:= Pages3.Width / w;
1482 FPos3:= FPanel1.Height / h;
1483 end;
1484 gm6grid:
1485 begin
1486 FPos1:= Pages1.Width / w;
1487 FPos2:= Pages2.Width / w;
1488 FPos3:= FPanel1.Height / h;
1489 FPos4:= FPos1;
1490 FPos5:= FPos2;
1491 end;
1492 end;
1493 end;
1494
1495 procedure TATGroups.RestoreSplitPos;
1496 var
1497 w, h: integer;
1498 begin
1499 w:= Width;
1500 h:= Height;
1501 if w<2 then Exit;
1502 if h<2 then Exit;
1503
1504 case FMode of
1505 gm2v,
1506 gm3v,
1507 gm4v,
1508 gm6v:
1509 begin
1510 UpdW(Pages1, Trunc(FPos1 * w));
1511 UpdW(Pages2, Trunc(FPos2 * w));
1512 UpdW(Pages3, Trunc(FPos3 * w));
1513 UpdW(Pages4, Trunc(FPos4 * w));
1514 UpdW(Pages5, Trunc(FPos5 * w));
1515 end;
1516 gm2h,
1517 gm3h,
1518 gm4h,
1519 gm6h:
1520 begin
1521 UpdH(Pages1, Trunc(FPos1 * h));
1522 UpdH(Pages2, Trunc(FPos2 * h));
1523 UpdH(Pages3, Trunc(FPos3 * h));
1524 UpdH(Pages4, Trunc(FPos4 * h));
1525 UpdH(Pages5, Trunc(FPos5 * h));
1526 end;
1527 gm1plus2v:
1528 begin
1529 UpdW(FPanel1, Trunc(FPos1 * w));
1530 UpdH(Pages2, Trunc(FPos2 * h));
1531 end;
1532 gm1plus2h:
1533 begin
1534 UpdH(FPanel1, Trunc(FPos1 * h));
1535 UpdW(Pages2, Trunc(FPos2 * w));
1536 end;
1537 gm4grid:
1538 begin
1539 UpdW(Pages1, Trunc(FPos1 * w));
1540 UpdW(Pages3, Trunc(FPos2 * w));
1541 UpdH(FPanel1, Trunc(FPos3 * h));
1542 end;
1543 gm6grid:
1544 begin
1545 UpdW(Pages1, Trunc(FPos1 * w));
1546 UpdW(Pages2, Trunc(FPos2 * w));
1547 UpdH(FPanel1, Trunc(FPos3 * h));
1548 UpdW(Pages4, Pages1.Width);
1549 UpdW(Pages5, Pages2.Width);
1550 end;
1551 end;
1552 end;
1553
1554 procedure TATGroups.Resize;
1555 begin
1556 //Logic FPrev* needed for Lazarus!! laz calls onresize also for internal things like
1557 //splitter move and this causes bad things (resize group1 to width=0 in horz-view)
1558 if (FPrevWidth<>Width) or (FPrevHeight<>Height) then
1559 begin
1560 FPrevWidth:= Width;
1561 FPrevHeight:= Height;
1562 RestoreSplitPos;
1563 end;
1564 end;
1565
1566
1567 procedure TATGroups.TabEmpty(Sender: TObject);
1568 var
1569 APages: TATPages;
1570 begin
1571 APages:= (Sender as TATTabs).Parent as TATPages;
1572
1573 //if last tab closed on Pages1, add new tab
1574 //if last tab closed on Pages2..Pages4, activate Pages1
1575 if not APages.EnabledEmpty then
1576 begin
1577 APages.OnTabAdd(Pages1.Tabs);
1578 end
1579 else
1580 begin
1581 if Pages1.Tabs.TabCount>0 then
1582 Pages1.Tabs.OnTabClick(nil);
1583
1584 if Assigned(FOnEmpty) then
1585 FOnEmpty(APages);
1586 end;
1587 end;
1588
1589 procedure TATGroups.SplitClick(Sender: TObject);
1590 begin
1591 SetMainPos((Sender as TComponent).Tag);
1592 end;
1593
GetMainPosnull1594 function TATGroups.GetMainPos: Integer;
1595 //this is used when we have 2 cols or 2 rows, by context menu over single splitter
1596 begin
1597 case FMode of
1598 gm2v:
1599 begin
1600 Result:= Pages1.Width * 100 div Width;
1601 end;
1602 gm2h:
1603 begin
1604 Result:= Pages1.Height * 100 div Height;
1605 end;
1606 gm1plus2v:
1607 begin
1608 Result:= FPanel1.Width * 100 div Width;
1609 end;
1610 gm1plus2h:
1611 begin
1612 Result:= FPanel1.Height * 100 div Height;
1613 end;
1614 else
1615 Result:= 50;
1616 end;
1617 end;
1618
1619 procedure TATGroups.SetMainPos(N: Integer);
1620 //this is used when we have 2 cols or 2 rows, by context menu over single splitter
1621 begin
1622 case FMode of
1623 gm2v:
1624 begin
1625 UpdW(Pages1, Width * N div 100);
1626 SaveSplitPos;
1627 end;
1628 gm2h:
1629 begin
1630 UpdH(Pages1, Height * N div 100);
1631 SaveSplitPos;
1632 end;
1633 gm1plus2v:
1634 begin
1635 UpdW(FPanel1, Width * N div 100);
1636 SaveSplitPos;
1637 end;
1638 gm1plus2h:
1639 begin
1640 UpdH(FPanel1, Height * N div 100);
1641 SaveSplitPos;
1642 end;
1643 end;
1644 end;
1645
1646 procedure TATGroups.MoveTab(AFromPages: TATPages; AFromIndex: Integer;
1647 AToPages: TATPages; AToIndex: Integer; AActivateTabAfter: boolean);
1648 var
1649 D: TATTabData;
1650 begin
1651 D:= AFromPages.Tabs.GetTabData(AFromIndex);
1652 if D=nil then Exit;
1653
1654 AToPages.AddTab(AToIndex, D);
1655 AFromPages.Tabs.DeleteTab(AFromIndex, false, false);
1656
1657 if AActivateTabAfter then
1658 with AToPages.Tabs do
1659 TabIndex:= IfThen(AToIndex>=0, AToIndex, TabCount-1);
1660 end;
1661
1662
PagesSetIndexnull1663 function TATGroups.PagesSetIndex(ANum: Integer): boolean;
1664 var
1665 APages: TATPages;
1666 begin
1667 if (ANum>=Low(Pages)) and (ANum<=High(Pages)) then
1668 APages:= Pages[ANum]
1669 else
1670 APages:= nil;
1671
1672 Result:= (APages<>nil) and APages.Visible and (APages.Tabs.TabCount>0);
1673 if Result then
1674 APages.Tabs.OnTabClick(nil);
1675 end;
1676
1677 procedure TATGroups.PagesSetNext(ANext: boolean);
1678 var
1679 Num0, Num1: Integer;
1680 begin
1681 Num0:= FindPages(PagesCurrent);
1682 if Num0<0 then Exit;
1683 Num1:= PagesNextIndex(Num0, ANext, false);
1684 if Num1<0 then Exit;
1685 PagesSetIndex(Num1);
1686 end;
1687
1688
FindPagesnull1689 function TATGroups.FindPages(APages: TATPages): Integer;
1690 var
1691 i: Integer;
1692 begin
1693 Result:= -1;
1694 for i:= Low(Pages) to High(Pages) do
1695 if Pages[i] = APages then
1696 begin
1697 Result:= i;
1698 Exit
1699 end;
1700 end;
1701
PagesNextIndexnull1702 function TATGroups.PagesNextIndex(AIndex: Integer; ANext: boolean;
1703 AEnableEmpty: boolean): Integer;
1704 var
1705 N: Integer;
1706 begin
1707 Result:= -1;
1708 N:= AIndex;
1709
1710 repeat
1711 if ANext then Inc(N) else Dec(N);
1712 if N>High(Pages) then N:= Low(Pages) else
1713 if N<Low(Pages) then N:= High(Pages);
1714
1715 if N=AIndex then Exit; //don't return same index
1716
1717 if Pages[N].Visible then
1718 if (Pages[N].Tabs.TabCount>0) or AEnableEmpty then
1719 begin
1720 Result:= N;
1721 Exit
1722 end;
1723 until false;
1724 end;
1725
1726
1727 procedure TATGroups.TabFocus(Sender: TObject);
1728 begin
1729 if Assigned(FOnTabFocus) then
1730 FOnTabFocus(Sender);
1731 end;
1732
1733 procedure TATGroups.MovePopupTabToNext(ANext: boolean);
1734 var
1735 N0, N1: Integer;
1736 begin
1737 N0:= FindPages(PopupPages);
1738 if N0<0 then Exit;
1739 N1:= PagesNextIndex(N0, ANext, true);
1740 if N1<0 then Exit;
1741 MoveTab(PopupPages, PopupTabIndex, Pages[N1], -1, false);
1742 end;
1743
1744 procedure TATGroups.MoveCurrentTabToNext(ANext: boolean);
1745 var
1746 N0, N1: Integer;
1747 begin
1748 N0:= FindPages(PagesCurrent);
1749 if N0<0 then Exit;
1750 N1:= PagesNextIndex(N0, ANext, true);
1751 if N1<0 then Exit;
1752 MoveTab(PagesCurrent, PagesCurrent.Tabs.TabIndex, Pages[N1], -1, true);
1753 end;
1754
1755 procedure TATGroups.TabClose(Sender: TObject; ATabIndex: Integer;
1756 var ACanClose, ACanContinue: boolean);
1757 begin
1758 //not needed
1759 //DoControlLock(Self);
1760 try
1761 if Assigned(FOnTabClose) then
1762 FOnTabClose(Sender, ATabIndex, ACanClose, ACanContinue);
1763 finally
1764 //DoControlUnlock(Self);
1765 end;
1766 end;
1767
1768 procedure TATGroups.TabAdd(Sender: TObject);
1769 begin
1770 if Assigned(FOnTabAdd) then
1771 FOnTabAdd(Sender);
1772 end;
1773
1774 procedure TATGroups.SetTabFont(AFont: TFont);
1775 var
1776 i: Integer;
1777 begin
1778 for i:= Low(Pages) to High(Pages) do
1779 Pages[i].Tabs.Font.Assign(AFont);
1780 end;
1781
TATGroups.GetTabSingleRowHeightnull1782 function TATGroups.GetTabSingleRowHeight: integer;
1783 begin
1784 with Pages1.Tabs do
1785 Result:= DoScale(OptTabHeight+OptSpacer)+1;
1786 end;
1787
1788 procedure TATGroups.SetTabOptionString(Id: TATTabsStringOptionId; const AValue: string);
1789 var
1790 i: Integer;
1791 begin
1792 for i:= Low(Pages) to High(Pages) do
1793 with Pages[i].Tabs do
1794 case Id of
1795 tabOptionModifiedText:
1796 OptShowModifiedText:= AValue;
1797 tabOptionButtonLayout:
1798 OptButtonLayout:= AValue;
1799 tabOptionHintForX:
1800 OptHintForX:= AValue;
1801 tabOptionHintForPlus:
1802 OptHintForPlus:= AValue;
1803 tabOptionHintForArrowLeft:
1804 OptHintForArrowLeft:= AValue;
1805 tabOptionHintForArrowRight:
1806 OptHintForArrowRight:= AValue;
1807 tabOptionHintForArrowMenu:
1808 OptHintForArrowMenu:= AValue;
1809 end;
1810 end;
1811
1812
1813 procedure TATGroups.SetTabOption(Id: TATTabsOptionId; N: Integer);
1814 var
1815 i: Integer;
1816 begin
1817 for i:= Low(Pages) to High(Pages) do
1818 with Pages[i].Tabs do
1819 case Id of
1820 //
1821 tabColorBg:
1822 begin
1823 ColorBg:= N;
1824 Pages[i].Color:= N;
1825 FSplit1.Color:= N;
1826 FSplit2.Color:= N;
1827 FSplit3.Color:= N;
1828 FSplit4.Color:= N;
1829 FSplit5.Color:= N;
1830 end;
1831 tabColorBgActive: ColorTabActive:= N;
1832 tabColorBgPassive: ColorTabPassive:= N;
1833 tabColorBgPassiveOver: ColorTabOver:= N;
1834 tabColorText: ColorFont:= N;
1835 tabColorTextActive: ColorFontActive:= N;
1836 tabColorTextModified: ColorFontModified:= N;
1837 tabColorBorderActive: ColorBorderActive:= N;
1838 tabColorBorderPassive: ColorBorderPassive:= N;
1839 tabColorSeparator: ColorSeparator:= N;
1840 tabColorCloseBg: ColorCloseBg:= N;
1841 tabColorCloseBgOver: ColorCloseBgOver:= N;
1842 tabColorCloseBorderOver: ColorCloseBorderOver:= N;
1843 tabColorCloseX: ColorCloseX:= N;
1844 tabColorCloseXOver: ColorCloseXOver:= N;
1845 tabColorArrow: ColorArrow:= N;
1846 tabColorArrowOver: ColorArrowOver:= N;
1847 tabColorSpecMarks: begin ColorDropMark:= N; ColorScrollMark:= N; end;
1848 tabColorActiveMark: ColorActiveMark:= N;
1849 //
1850 tabOptionFontSize:
1851 begin
1852 Font.Size:= N;
1853 OptTabHeight:= Trunc(N * 1.8) + 8; //tested for sizes 8..38
1854 Height:= GetTabSingleRowHeight;
1855 end;
1856 //
1857 tabOptionPosition:
1858 begin
1859 OptPosition:= TATTabPosition(N);
1860 case OptPosition of
1861 atpTop:
1862 begin
1863 Align:= alTop;
1864 Height:= GetTabSingleRowHeight;
1865 end;
1866 atpBottom:
1867 begin
1868 Align:= alBottom;
1869 Height:= GetTabSingleRowHeight;
1870 end;
1871 atpLeft:
1872 begin
1873 Align:= alLeft;
1874 Width:= OptTabWidthNormal;
1875 end;
1876 atpRight:
1877 begin
1878 Align:= alRight;
1879 Width:= OptTabWidthNormal;
1880 end;
1881 end;
1882 end;
1883
1884 tabOptionShowHint: ShowHint:= Boolean(N);
1885 tabOptionVarWidth: OptVarWidth:= Boolean(N);
1886 tabOptionMultiline: OptMultiline:= Boolean(N);
1887 tabOptionScalePercents: OptScalePercents:= N;
1888 tabOptionShowFlat: OptShowFlat:= Boolean(N);
1889 tabOptionShowTabs: Visible:= Boolean(N);
1890 tabOptionShowXButtons: OptShowXButtons:= TATTabShowClose(N);
1891 tabOptionShowXRounded: OptShowXRounded:= Boolean(N);
1892 tabOptionShowPlus: OptShowPlusTab:= Boolean(N);
1893 tabOptionShowNums: OptShowNumberPrefix:= IfThen(Boolean(N), '%d. ', '');
1894 tabOptionShowEntireColor: OptShowEntireColor:= Boolean(N);
1895 tabOptionShowArrowsNear: OptShowArrowsNear:= Boolean(N);
1896 tabOptionMouseWheelMode: OptMouseWheelMode:= TATTabMouseWheelMode(N);
1897 tabOptionDoubleClickClose: OptMouseDoubleClickClose:= Boolean(N);
1898 tabOptionMiddleClickClose: OptMouseMiddleClickClose:= Boolean(N);
1899 tabOptionDragDrop: OptMouseDragEnabled:= Boolean(N);
1900 tabOptionDragFromNotATTabs:OptMouseDragFromNotATTabs:= Boolean(N);
1901 tabOptionHeightInner: OptTabHeight:= N;
1902 tabOptionWidthMin: OptTabWidthMinimal:= N;
1903 tabOptionWidthMax: OptTabWidthMaximal:= N;
1904 tabOptionWidthNormal:
1905 begin
1906 OptTabWidthNormal:= N;
1907 if OptPosition in [atpLeft, atpRight] then
1908 Width:= OptTabWidthNormal;
1909 end;
1910 tabOptionSpacer: OptSpacer:= N;
1911 tabOptionSpacer2: OptSpacer2:= N;
1912 tabOptionSpaceInitial: OptSpaceInitial:= N;
1913 tabOptionSpaceBeforeText: OptSpaceBeforeText:= N;
1914 tabOptionSpaceBetweenTabs: OptSpaceBetweenTabs:= N;
1915 tabOptionSpaceSide: OptSpaceSide:= N;
1916 tabOptionFontScale: OptFontScale:= N;
1917 tabOptionColoredBandSize: OptColoredBandSize:= N;
1918 tabOptionActiveMarkSize: OptActiveMarkSize:= N;
1919 tabOptionScrollMarkSizeX: OptScrollMarkSizeX:= N;
1920 tabOptionScrollMarkSizeY: OptScrollMarkSizeY:= N;
1921 tabOptionSpaceXRight: OptSpaceXRight:= N;
1922 tabOptionSpaceXSize: OptSpaceXSize:= N;
1923 tabOptionArrowSize: OptArrowSize:= N;
1924 tabOptionButtonSize: OptButtonSize:= N;
1925 tabOptionWhichActivateOnClose: OptWhichActivateOnClose:= TATTabActionOnClose(N);
1926 end;
1927 end;
1928
1929 procedure TATGroups.MoveCurrentTabToOpposite;
1930 var
1931 NFrom, NTo, NTabIndex: Integer;
1932 begin
1933 NFrom:= FindPages(PagesCurrent);
1934 if NFrom<0 then Exit;
1935 if NFrom=0 then NTo:= 1 else NTo:= 0;
1936
1937 NTabIndex:= Pages[NFrom].Tabs.TabIndex;
1938 if NTabIndex<0 then Exit;
1939
1940 if (NTo>0) and (FMode<=gmOne) then
1941 SetMode(gm2v);
1942
1943 MoveTab(Pages[NFrom], NTabIndex, Pages[NTo], -1, true);
1944 end;
1945
GetTabTotalCountnull1946 function TATGroups.GetTabTotalCount: Integer;
1947 var
1948 i: Integer;
1949 begin
1950 Result:= 0;
1951 for i:= Low(Pages) to High(Pages) do
1952 Inc(Result, Pages[i].Tabs.TabCount);
1953 end;
1954
1955
TATGroups.GetTabDataOfTotalIndexnull1956 function TATGroups.GetTabDataOfTotalIndex(N: Integer): TATTabData;
1957 var
1958 i, Count: Integer;
1959 begin
1960 Result:= nil;
1961 Count:= N;
1962 for i:= Low(Pages) to High(Pages) do
1963 begin
1964 if (Count>=0) and (Count<Pages[i].Tabs.TabCount) then
1965 begin
1966 Result:= Pages[i].Tabs.GetTabData(Count);
1967 Exit
1968 end;
1969 Dec(Count, Pages[i].Tabs.TabCount);
1970 end;
1971 end;
1972
TATGroups.CloseTabsOthernull1973 function TATGroups.CloseTabsOther(APages: TATPages; ATabIndex: Integer;
1974 ADoRighter, ADoLefter: boolean): boolean;
1975 var
1976 Data: TATTabData;
1977 j: Integer;
1978 begin
1979 Result:= false;
1980 with APages do
1981 begin
1982 if ADoRighter then
1983 for j:= Tabs.TabCount-1 downto ATabIndex+1 do
1984 begin
1985 Data:= Tabs.GetTabData(j);
1986 if Assigned(Data) and Data.TabPinned then Continue;
1987 if not Tabs.DeleteTab(j, true, true) then Exit;
1988 end;
1989 if ADoLefter then
1990 for j:= ATabIndex-1 downto 0 do
1991 begin
1992 Data:= Tabs.GetTabData(j);
1993 if Assigned(Data) and Data.TabPinned then Continue;
1994 if not Tabs.DeleteTab(j, true, true) then Exit;
1995 end;
1996 end;
1997 Result:= true;
1998 end;
1999
TATGroups.CloseTabsAllnull2000 function TATGroups.CloseTabsAll(APages: TATPages): boolean;
2001 var
2002 Data: TATTabData;
2003 j: Integer;
2004 begin
2005 Result:= false;
2006 with APages do
2007 begin
2008 Tabs.TabIndex:= 0; //activate 1st tab to remove TabIndex change on closing
2009 for j:= Tabs.TabCount-1 downto 0 do
2010 begin
2011 Data:= Tabs.GetTabData(j);
2012 if Assigned(Data) and Data.TabPinned then Continue;
2013 if not Tabs.DeleteTab(j, true, true) then Exit;
2014 end;
2015 end;
2016 Result:= true;
2017 end;
2018
CloseTabsnull2019 function TATGroups.CloseTabs(Id: TATTabCloseId; AForPopupMenu: boolean): boolean;
2020 var
2021 i: Integer;
2022 APagesIndex, ATabIndex: Integer;
2023 begin
2024 Result:= false;
2025
2026 if AForPopupMenu then
2027 begin
2028 if not Assigned(PopupPages) then exit;
2029 APagesIndex:= FindPages(PopupPages);
2030 ATabIndex:= PopupTabIndex;
2031 end
2032 else
2033 begin
2034 if not Assigned(PagesCurrent) then exit;
2035 APagesIndex:= FindPages(PagesCurrent);
2036 ATabIndex:= PagesCurrent.Tabs.TabIndex;
2037 end;
2038
2039 if (APagesIndex<0) or (APagesIndex>High(TATGroupsNums)) then exit;
2040
2041 case Id of
2042 tabCloseCurrent:
2043 begin
2044 with Pages[APagesIndex].Tabs do
2045 if not DeleteTab(ATabIndex, true, true) then Exit;
2046 end;
2047 tabCloseOthersThisPage:
2048 begin
2049 if not CloseTabsOther(Pages[APagesIndex], ATabIndex, true, true) then Exit;
2050 end;
2051 tabCloseLefterThisPage:
2052 begin
2053 if not CloseTabsOther(Pages[APagesIndex], ATabIndex, false, true) then Exit;
2054 end;
2055 tabCloseRighterThisPage:
2056 begin
2057 if not CloseTabsOther(Pages[APagesIndex], ATabIndex, true, false) then Exit;
2058 end;
2059 tabCloseOthersAllPages:
2060 begin
2061 for i:= High(Pages) downto Low(Pages) do
2062 if i=APagesIndex then
2063 begin
2064 if not CloseTabsOther(Pages[i], ATabIndex, true, true) then Exit;
2065 end
2066 else
2067 begin
2068 if not CloseTabsAll(Pages[i]) then Exit;
2069 end;
2070 end;
2071 tabCloseAllThisPage:
2072 begin
2073 if not CloseTabsAll(Pages[APagesIndex]) then Exit;
2074 end;
2075 tabCloseAll:
2076 begin
2077 for i:= High(Pages) downto Low(Pages) do
2078 if not CloseTabsAll(Pages[i]) then Exit;
2079 end;
2080 end;
2081
2082 Result:= true;
2083 end;
2084
2085
2086 const
2087 cMinSplitter = 10;
2088 cDeltaSplitter = 5;
2089
2090 procedure TATGroups.MainPosIncrease;
2091 begin
2092 MainPos:= Min(MainPos + cDeltaSplitter, 100-cMinSplitter);
2093 end;
2094
2095 procedure TATGroups.MainPosDecrease;
2096 begin
2097 MainPos:= Max(MainPos - cDeltaSplitter, cMinSplitter);
2098 end;
2099
PagesVisibleCountnull2100 function TATGroups.PagesVisibleCount: Integer;
2101 begin
2102 Result:= cGroupsCount[FMode];
2103 end;
2104
SetPagesAndTabIndexnull2105 function TATGroups.SetPagesAndTabIndex(APageIndex, ATabIndex: Integer): boolean;
2106 var
2107 Page: TATPages;
2108 begin
2109 Result:= false;
2110 if not ((APageIndex>=0) and (APageIndex<PagesVisibleCount)) then exit;
2111 Page:= Pages[APageIndex];
2112 if not ((ATabIndex>=0) and (ATabIndex<Page.Tabs.TabCount)) then exit;
2113 Result:= true;
2114 if Page.Tabs.TabIndex<>ATabIndex then
2115 Page.Tabs.TabIndex:= ATabIndex;
2116 end;
2117
2118 procedure TATGroups.TabOver(Sender: TObject; ATabIndex: Integer);
2119 begin
2120 if Assigned(FOnTabOver) then
2121 FOnTabOver(Sender, ATabIndex);
2122 end;
2123
2124 procedure TATGroups.TabMove(Sender: TObject; NFrom, NTo: Integer);
2125 begin
2126 if Assigned(FOnTabMove) then
2127 FOnTabMove(Sender, NFrom, NTo);
2128 end;
2129
TabGetTicknull2130 function TATGroups.TabGetTick(Sender: TObject; ATabObject: TObject): Int64;
2131 begin
2132 if Assigned(FOnTabGetTick) then
2133 Result:= FOnTabGetTick(Sender, ATabObject)
2134 else
2135 Result:= 0;
2136 end;
2137
2138
2139 procedure TATGroups.FindPositionOfControl(AObject: TObject;
2140 out APagesIndex, ATabIndex: Integer);
2141 var
2142 TempPages: TATPages;
2143 begin
2144 APagesIndex:= -1;
2145 ATabIndex:= -1;
2146 if AObject=nil then Exit;
2147
2148 TempPages:= TWinControl(AObject).Parent as TATPages;
2149 APagesIndex:= FindPages(TempPages);
2150 ATabIndex:= TempPages.Tabs.FindTabByObject(AObject);
2151 end;
2152
TATGroups.GetImagesnull2153 function TATGroups.GetImages: TImageList;
2154 begin
2155 Result:= Pages1.Tabs.Images;
2156 end;
2157
2158 procedure TATGroups.SetImages(AValue: TImageList);
2159 var
2160 i: integer;
2161 begin
2162 for i:= Low(TATGroupsNums) to High(TATGroupsNums) do
2163 Pages[i].Tabs.Images:= AValue;
2164 end;
2165
2166 procedure TATGroups.SetSplitterMinSize(AValue: integer);
2167 begin
2168 FSplit1.MinSize:= AValue;
2169 FSplit2.MinSize:= AValue;
2170 FSplit3.MinSize:= AValue;
2171 FSplit4.MinSize:= AValue;
2172 FSplit5.MinSize:= AValue;
2173 end;
2174
2175 procedure TATGroups.SetSplitterResizeStyle(AValue: TResizeStyle);
2176 begin
2177 FSplit1.ResizeStyle:= AValue;
2178 FSplit2.ResizeStyle:= AValue;
2179 FSplit3.ResizeStyle:= AValue;
2180 FSplit4.ResizeStyle:= AValue;
2181 FSplit5.ResizeStyle:= AValue;
2182 end;
2183
2184 procedure TATGroups.SetSplitterColor(AValue: TColor);
2185 var
2186 Event: TNotifyEvent;
2187 begin
2188 if AValue=clNone then
2189 Event:= nil
2190 else
2191 Event:= SplitterOnPaint;
2192
2193 FSplit1.OnPaint:= Event;
2194 FSplit2.OnPaint:= Event;
2195 FSplit3.OnPaint:= Event;
2196 FSplit4.OnPaint:= Event;
2197 FSplit5.OnPaint:= Event;
2198
2199 FSplit1.Color:= AValue;
2200 FSplit2.Color:= AValue;
2201 FSplit3.Color:= AValue;
2202 FSplit4.Color:= AValue;
2203 FSplit5.Color:= AValue;
2204
2205 FSplit1.Invalidate;
2206 FSplit2.Invalidate;
2207 FSplit3.Invalidate;
2208 FSplit4.Invalidate;
2209 FSplit5.Invalidate;
2210 end;
2211
2212 procedure TATGroups.SplitterOnPaint(Sender: TObject);
2213 begin
2214 //empty to disable themed paint
2215 end;
2216
_FixOddnull2217 function _FixOdd(N: integer): integer; inline;
2218 //this is to fix shifting of splitter pos, if position is saved to config / restored later
2219 begin
2220 if Odd(N) then
2221 Result:= N+1
2222 else
2223 Result:= N;
2224 end;
2225
2226 procedure TATGroups.GetSizes(out APanelSize: TPoint; out APageSize: TATGroupsPoints);
2227 var
2228 i: integer;
2229 begin
2230 if (Width<2) or (Height<2) then
2231 begin
2232 APanelSize.x:= 100;
2233 APanelSize.y:= 100;
2234 for i in TATGroupsNums do
2235 begin
2236 APageSize[i].x:= 100;
2237 APageSize[i].y:= 100;
2238 end;
2239 exit
2240 end;
2241
2242 APanelSize.x:= _FixOdd(Panel1.Width * 100 div Width);
2243 APanelSize.y:= _FixOdd(Panel1.Height * 100 div Height);
2244 for i in TATGroupsNums do
2245 begin
2246 APageSize[i].x:= _FixOdd(Pages[i].Width * 100 div Width);
2247 APageSize[i].y:= _FixOdd(Pages[i].Height * 100 div Height);
2248 end;
2249 end;
2250
2251 procedure TATGroups.SetSizes(const APanelSize: TPoint; const APageSize: TATGroupsPoints);
2252 const
2253 cMaxSize = 8000; //to avoid SigFPE on Linux sometimes, when setting Height~~100K
2254 var
2255 i: integer;
2256 begin
2257 Panel1.Width := Min(cMaxSize, APanelSize.x * Width div 100);
2258 Panel1.Height:= Min(cMaxSize, APanelSize.y * Height div 100);
2259 for i in TATGroupsNums do
2260 begin
2261 Pages[i].Width:= Min(cMaxSize, APageSize[i].x * Width div 100);
2262 Pages[i].Height:= Min(cMaxSize, APageSize[i].y * Height div 100);
2263 end;
2264 end;
2265
2266 end.
2267