From 67a66246b00c2f4d581f22d76d44469b58fb41aa Mon Sep 17 00:00:00 2001 From: Jordan Russell Date: Fri, 22 Nov 2024 00:56:52 -0600 Subject: [PATCH] TNewTabSet: Fix EnsureCurrentTabIsFullyVisible. It was broken by Cleanup commit, but even with that fixed, it still had issues, e.g. sometimes only making tabs partly visible. Ended up rewriting it. Now it makes the current tab fully visible, and also ensures that at least 30 pixels of the adjacent tabs are visible. If there isn't room, the overflowing pixels on the right side are clipped. --- Components/NewTabSet.pas | 82 ++++++++++++++++++++++++---------------- 1 file changed, 49 insertions(+), 33 deletions(-) diff --git a/Components/NewTabSet.pas b/Components/NewTabSet.pas index 269fe33cf..279dd4369 100644 --- a/Components/NewTabSet.pas +++ b/Components/NewTabSet.pas @@ -35,7 +35,8 @@ TNewTabSet = class(TCustomControl) FTheme: TTheme; FThemeDark: Boolean; FHotIndex: Integer; - function GetTabRect(Index: Integer): TRect; + procedure EnsureCurrentTabIsFullyVisible; + function GetTabRect(const Index: Integer; const ApplyTabsOffset: Boolean = True): TRect; function GetCloseButtonRect(const TabRect: TRect): TRect; procedure InvalidateTab(Index: Integer); procedure CloseButtonsListChanged(Sender: TObject; const Item: Boolean; @@ -48,8 +49,8 @@ TNewTabSet = class(TCustomControl) procedure SetTabPosition(Value: TTabPosition); procedure SetTheme(Value: TTheme); procedure SetHints(const Value: TStrings); + function ToCurrentPPI(const XY: Integer): Integer; procedure UpdateThemeData(const Open: Boolean); - procedure EnsureCurrentTabIsFullyVisible; protected procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE; @@ -60,6 +61,7 @@ TNewTabSet = class(TCustomControl) procedure UpdateHotIndex(NewHotIndex: Integer); procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; procedure Paint; override; + procedure Resize; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -161,6 +163,7 @@ function LightenColor(const Color: TColorRef; const Amount: Integer): TColorRef; { TNewTabSet } const + TabSetMarginX = 4; TabPaddingX = 5; TabPaddingY = 3; CloseButtonSizeX = 12; @@ -248,7 +251,36 @@ procedure TNewTabSet.WMThemeChanged(var Message: TMessage); inherited; end; -function TNewTabSet.GetTabRect(Index: Integer): TRect; +procedure TNewTabSet.EnsureCurrentTabIsFullyVisible; +begin + const AdjacentTabVisiblePixels = ToCurrentPPI(30); + const CR = ClientRect; + const R = GetTabRect(FTabIndex, False); + var Offset := FTabsOffset; + + { If the tab is overflowing to the right, scroll right } + var Overflow := R.Right - Offset - CR.Right + AdjacentTabVisiblePixels; + if Overflow > 0 then + Inc(Offset, Overflow); + + { If there's extra space after the last tab, scroll left if possible } + const LastTabRight = GetTabRect(FTabs.Count-1, False).Right + + ToCurrentPPI(TabSetMarginX); + Offset := Min(Offset, Max(0, LastTabRight - CR.Right)); + + { If the tab is overflowing to the left, scroll left } + Overflow := Offset - R.Left + AdjacentTabVisiblePixels; + if Overflow > 0 then + Offset := Max(0, Offset - Overflow); + + if FTabsOffset <> Offset then begin + FTabsOffset := Offset; + Invalidate; + end; +end; + +function TNewTabSet.GetTabRect(const Index: Integer; + const ApplyTabsOffset: Boolean = True): TRect; var CR: TRect; I, SizeX, SizeY: Integer; @@ -258,7 +290,9 @@ function TNewTabSet.GetTabRect(Index: Integer): TRect; Canvas.Font.Assign(Font); if FTabPosition = tpBottom then Result.Top := 0; - Result.Right := 4 - FTabsOffset; + Result.Right := ToCurrentPPI(TabSetMarginX); + if ApplyTabsOffset then + Dec(Result.Right, FTabsOffset); for I := 0 to FTabs.Count-1 do begin Size := Canvas.TextExtent(FTabs[I]); SizeX := Size.cx + (TabPaddingX * 2); @@ -473,6 +507,12 @@ procedure TNewTabSet.Paint; DrawTabs(False); end; +procedure TNewTabSet.Resize; +begin + EnsureCurrentTabIsFullyVisible; + inherited; +end; + procedure TNewTabSet.SetCloseButtons(Value: TBoolList); begin FCloseButtons.Clear; @@ -523,6 +563,11 @@ procedure TNewTabSet.SetTheme(Value: TTheme); end; end; +function TNewTabSet.ToCurrentPPI(const XY: Integer): Integer; +begin + Result := MulDiv(XY, CurrentPPI, 96); +end; + procedure TNewTabSet.UpdateThemeData(const Open: Boolean); begin if FMenuThemeData <> 0 then begin @@ -538,33 +583,4 @@ procedure TNewTabSet.UpdateThemeData(const Open: Boolean); end; end; -procedure TNewTabSet.EnsureCurrentTabIsFullyVisible; -var - rcTab, rcCtl, rcLast: TRect; - iExtra, iDelta, iNewOffset: Integer; -begin - rcCtl := ClientRect; - rcTab := GetTabRect(FTabIndex); - - { Check and modify tabs offset so everything fits } - iExtra := Min(rcCtl.Width div 2, rcTab.Width * 4); { arbitrary value, adjust as needed } - iDelta := rcTab.Width div 2; { arbitrary value, adjust as needed } - - { Left side is easy, limit is always 0 } - if rcTab.Left < rcCtl.Left + iDelta then begin - FTabsOffset := Max(0, FTabsOffset - rcCtl.Left - rcTab.Left - iExtra); - Invalidate; - end; - - { Right side limit depends on last tab and total available space } - if rcTab.Right > rcCtl.Right - iDelta then begin - iNewOffset := FTabsOffset + (rcTab.Right - rcCtl.Right) + iExtra; - FTabsOffset := 0; { We need the last tabs leftmost position w/o any offset } - rcLast := GetTabRect(FTabs.Count-1); - FTabsOffset := Max(0, Min(iNewOffset, rcLast.Right - rcCtl.Width + 10)); - Invalidate; - end; -end; - - end.