ui(settings): replace native vertical scrollbar

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;