From 960f221179709c8c7c27ee9c79fc56279727340a Mon Sep 17 00:00:00 2001 From: Vladimir Date: Wed, 5 Aug 2026 14:10:20 +0300 Subject: [PATCH] ui(settings): replace native vertical scrollbar --- SettingsForm.pas | 88 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 87 insertions(+), 1 deletion(-) diff --git a/SettingsForm.pas b/SettingsForm.pas index 44860e1..9a6886b 100644 --- a/SettingsForm.pas +++ b/SettingsForm.pas @@ -29,7 +29,8 @@ uses StdCtrls, ExtCtrls, LCLType, FlatButton, FlatCheckBox, FlatComboBox, FlatEdit, FlatSpinEdit, FlatFloatSpinEdit, FlatRadioButton, - EqualizerControl, AudioOutput, AudioInput, AppTheme, Settings, BoardUtils, DpiUtils; + EqualizerControl, OverlayScrollBar, AudioOutput, AudioInput, AppTheme, Settings, + BoardUtils, DpiUtils; const // Подвкладки страницы Transmit: Profile / EQ / Hardware / Display. @@ -111,6 +112,9 @@ type FNavPanel: TPanel; FContentPanel: TPanel; FFooterPanel: TPanel; + FScrollHost: TPanel; + FScrollBar: TOverlayScrollBar; + FActivePage: TScrollBox; FPageAudio: TScrollBox; FPageDisplay: TScrollBox; FPageSpectrum: TScrollBox; @@ -508,6 +512,10 @@ type procedure BtnTXProfFactoryClick(Sender: TObject); procedure ApplyTheme(const T: TAppTheme); procedure SettingsResize(Sender: TObject); + procedure SettingsScrollChanged(Sender: TObject); + procedure SettingsPageMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); + procedure UpdateSettingsScrollBar; procedure RelayoutResponsiveCards; procedure NavClick(Sender: TObject); procedure SelectPage(APage: TWinControl; ANav: TFlatButton); @@ -799,6 +807,7 @@ begin FRXDevCount := 0; BuildUI; OnResize := SettingsResize; + OnMouseWheel := SettingsPageMouseWheel; RelayoutResponsiveCards; ApplyTheme(DarkTheme); end; @@ -928,6 +937,7 @@ begin Result.BorderStyle := bsNone; Result.Color := CLR_BG; Result.AutoScroll := True; + Result.OnMouseWheel := SettingsPageMouseWheel; Result.Visible := False; end; @@ -1127,12 +1137,78 @@ begin FBtnClose.ClrTextAct:= CLR_ACCENT; FBtnClose.Font.Size := 9; + // Оконный контейнер перекрывает нативный scrollbar TScrollBox. Сам + // TOverlayScrollBar остаётся тонким, а системная прокрутка продолжает + // надёжно двигать всё содержимое страницы. + FScrollHost := TPanel.Create(Self); + FScrollHost.Parent := FContentPanel; + FScrollHost.BevelOuter := bvNone; + FScrollHost.Color := CLR_BG; + FScrollHost.Tag := TAG_PAGE_BG; + + FScrollBar := TOverlayScrollBar.Create(Self); + FScrollBar.Parent := FScrollHost; + FScrollBar.Align := alClient; + FScrollBar.OnPositionChange := SettingsScrollChanged; + SelectPage(FPageAudio, FNavAudio); end; procedure TSettingsForm.SettingsResize(Sender: TObject); begin RelayoutResponsiveCards; + UpdateSettingsScrollBar; +end; + +procedure TSettingsForm.SettingsScrollChanged(Sender: TObject); +begin + if (FActivePage = nil) or (FScrollBar = nil) then Exit; + FActivePage.VertScrollBar.Position := FScrollBar.Position; +end; + +procedure TSettingsForm.SettingsPageMouseWheel(Sender: TObject; + Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; + var Handled: Boolean); +var + P: TPoint; +begin + if (FActivePage = nil) or (FScrollBar = nil) then Exit; + P := FActivePage.ScreenToClient(Mouse.CursorPos); + if (P.X < 0) or (P.Y < 0) or + (P.X >= FActivePage.Width) or (P.Y >= FActivePage.Height) then Exit; + + UpdateSettingsScrollBar; + if FScrollBar.Maximum <= 0 then Exit; + + if WheelDelta > 0 then + FScrollBar.ScrollBy(-DpiScale(64)) + else if WheelDelta < 0 then + FScrollBar.ScrollBy(DpiScale(64)); + Handled := WheelDelta <> 0; +end; + +procedure TSettingsForm.UpdateSettingsScrollBar; +var + GutterW, ViewH, MaxPos: Integer; +begin + if (FActivePage = nil) or (FScrollHost = nil) or + (FScrollBar = nil) then Exit; + + FActivePage.UpdateScrollbars; + ViewH := FActivePage.ClientHeight; + MaxPos := Max(0, FActivePage.VertScrollBar.Range + - FActivePage.VertScrollBar.Page); + + FScrollBar.HoverTarget := FActivePage; + FScrollBar.SetRange(MaxPos, ViewH); + FScrollBar.Position := FActivePage.VertScrollBar.Position; + + // На Windows gutter должен полностью закрывать нативную полосу. Бегунок + // внутри него всё равно рисуется шириной 4 design px. + GutterW := Max(DpiScale(8), FActivePage.VertScrollBar.Size); + FScrollHost.SetBounds(FContentPanel.ClientWidth - GutterW, 0, GutterW, + Max(0, FContentPanel.ClientHeight - FFooterPanel.Height)); + FScrollHost.BringToFront; end; procedure TSettingsForm.RelayoutResponsiveCards; @@ -1294,6 +1370,9 @@ end; procedure TSettingsForm.SelectPage(APage: TWinControl; ANav: TFlatButton); begin + if APage is TScrollBox then + FActivePage := TScrollBox(APage); + FPageAudio.Visible := APage = FPageAudio; FPageDisplay.Visible := APage = FPageDisplay; FPageSpectrum.Visible := APage = FPageSpectrum; @@ -1327,6 +1406,7 @@ begin // Скрытые alClient-страницы LCL не всегда перекладывает до показа. // После переключения берём уже актуальный ClientWidth выбранной страницы. RelayoutResponsiveCards; + UpdateSettingsScrollBar; end; // --------------------------------------------------------------------------- @@ -2767,6 +2847,7 @@ begin GTop := GTop + HDisp + 14; FCalGrpFreq.SetBounds(DpiScale(CAL_MARGIN), DpiScale(GTop), DpiScale(CAL_GRP_W), DpiScale(CAL_GRP2_H)); UpdatePageBottomSpace(FPageCalib); + if FActivePage = FPageCalib then UpdateSettingsScrollBar; end; function TSettingsForm.LayoutCalOffsets(const BandLbl: array of TLabel; @@ -3191,7 +3272,12 @@ procedure TSettingsForm.ApplyTheme(const T: TAppTheme); begin Color := T.BG; Font.Color := T.Text; + if FScrollHost <> nil then FScrollHost.Color := T.BG; + if FScrollBar <> nil then + FScrollBar.SetColors(T.BG, T.Border, + T.SliderThumbHot, T.SliderThumbDrag); WalkControls(Self); + if FScrollHost <> nil then FScrollHost.BringToFront; Invalidate; end;