feat(ui): add hover overlay scroll for left panel

FlatDropDown.pas

@@ -18,7 +18,7 @@ unit FlatDropDown;
 interface
 
 uses
-  Classes, SysUtils, Controls, Graphics, ExtCtrls, FlatButton;
+  Classes, SysUtils, Controls, Graphics, ExtCtrls, Math, FlatButton;
 
 type
   TButtonStyleProc     = procedure(B: TFlatButton; Active: Boolean) of object;
@@ -33,13 +33,14 @@ type
     FItemIndex:   Integer;
     FColumns:     Integer;
     FItemBtnH:    Integer;
+    FRightInset96: Integer;
     FIsOpen:      Boolean;
     FOnSelect:    TDropDownSelectEvent;
     procedure ItemClick(Sender: TObject);
     procedure PositionPopup;
   public
     constructor Create(AAnchor: TFlatButton; APopupParent: TWinControl;
-                       ACols, ABtnH: Integer);
+                       ACols, ABtnH: Integer; ARightInset96: Integer = 0);
     destructor Destroy; override;
     procedure SetItems(const ANames: array of string);
     procedure SetItemIndex(Idx: Integer);
@@ -54,13 +55,15 @@ type
 implementation
 
 constructor TFlatDropDown.Create(AAnchor: TFlatButton; APopupParent: TWinControl;
-                                  ACols, ABtnH: Integer);
+                                  ACols, ABtnH: Integer;
+                                  ARightInset96: Integer = 0);
 begin
   inherited Create;
   FAnchor      := AAnchor;
   FPopupParent := APopupParent;
   FColumns     := ACols;
   FItemBtnH    := ABtnH;
+  FRightInset96 := Max(0, ARightInset96);
   FItemIndex   := 0;
   FIsOpen      := False;
   FPopup := TPanel.Create(nil);
@@ -85,7 +88,11 @@ begin
     FPopup.Controls[0].Free;
   Count := Length(ANames);
   SetLength(FItemBtns, Count);
-  PopW := FPopupParent.ClientWidth;
+  // Popup может жить в контейнере с постоянно зарезервированным overlay-
+  // scrollbar gutter. Inset задаётся в 96-DPI координатах и пересчитывается
+  // при каждом наполнении: SetItems бывает и до, и после DPI-scale формы.
+  PopW := Max(1, FPopupParent.ClientWidth -
+                 FPopupParent.Scale96ToForm(FRightInset96));
   BtnW := (PopW - 4) div FColumns;
   FPopup.SetBounds(0, 0, PopW,
                    ((Count + FColumns - 1) div FColumns) * FItemBtnH);

MainForm.pas

@@ -24,7 +24,8 @@ interface
 uses
   Classes, SysUtils, StrUtils, FreqDisplay, DeviceForm, FilterPopup,
   VfoOverlay, SampleRateOverlay, BandPlanOverlay,
-  FlatButton, FlatSlider, FlatDropDown, AppTheme, Forms, Controls, Graphics, Dialogs,
+  FlatButton, FlatSlider, FlatDropDown, OverlayScrollBar, AppTheme,
+  Forms, Controls, Graphics, Dialogs,
   StdCtrls, ExtCtrls, Buttons, Menus, Math, Types, SyncObjs,
   OpenGLContextEx,
   LCLIntf, LCLType, GraphType,
@@ -104,6 +105,7 @@ const
   SMETER_MARGIN      = 3;
   TOP_SMETER_GAP     = 8;
   TOP_VFO_FONT       = 25;
+  LEFT_SCROLL_GUTTER_W = 8;
   LEFT_PANEL_BTN_PAD  = 3;
   LEFT_PANEL_BTN_GAP  = 2;
 
@@ -263,6 +265,8 @@ type
 
     // ---- Left panel ----
     PanelLeft: TPanel;
+    FLeftScrollBar: TOverlayScrollBar;
+    FLeftScrollOffset: Integer;
 
     PanelVfoA:    TPanel;
       LblVfoALabel: TLabel;
@@ -627,6 +631,9 @@ type
     procedure ApplyXvtrToNetwork;
     procedure RebuildXvtrButtons;
     procedure RelayoutBelowBands;
+    procedure UpdateLeftPanelScroll;
+    function  CursorOverLeftPanel: Boolean;
+    procedure LeftScrollChanged(Sender: TObject);
     procedure BtnXvtrBandClick(Sender: TObject);
     procedure ActivateXvtrBand(Idx: Integer);
     procedure DeactivateXvtr;
@@ -1939,9 +1946,19 @@ begin
   PanelLeft := TPanel.Create(Self);
   PanelLeft.Parent     := Self;
   PanelLeft.Align      := alLeft;
-  PanelLeft.Width      := LEFT_W;
+  // Узкий правый gutter зарезервирован постоянно: появление overlay-scrollbar
+  // не меняет ширину панели и не дёргает область спектра.
+  PanelLeft.Width      := LEFT_W + LEFT_SCROLL_GUTTER_W;
   PanelLeft.BevelOuter := bvNone;
 
+  FLeftScrollOffset   := 0;
+  FLeftScrollBar := TOverlayScrollBar.Create(Self);
+  FLeftScrollBar.Parent := PanelLeft;
+  FLeftScrollBar.Align := alRight;
+  FLeftScrollBar.Width := LEFT_SCROLL_GUTTER_W;
+  FLeftScrollBar.HoverTarget := PanelLeft;
+  FLeftScrollBar.OnPositionChange := LeftScrollChanged;
+
   Y := 0;
 
   // Compact top VFO group
@@ -2134,7 +2151,8 @@ begin
   BtnTXProfile.OnMouseDown := BtnTXProfileMouseDown;
   StyleButton(BtnTXProfile, False);
 
-  FTXProfileDropDown := TFlatDropDown.Create(BtnTXProfile, PanelLeft, 1, BTN_SM);
+  FTXProfileDropDown := TFlatDropDown.Create(BtnTXProfile, PanelLeft, 1, BTN_SM,
+    LEFT_SCROLL_GUTTER_W);
   FTXProfileDropDown.OnSelect := OnTXProfileDropDownSelect;
   RenderTXProfile;
 
@@ -2179,7 +2197,8 @@ begin
   BtnChannels.OnMouseDown := BtnChannelsMouseDown;
   StyleButton(BtnChannels, False);
 
-  FChannelsDropDown := TFlatDropDown.Create(BtnChannels, PanelLeft, 1, BTN_SM);
+  FChannelsDropDown := TFlatDropDown.Create(BtnChannels, PanelLeft, 1, BTN_SM,
+    LEFT_SCROLL_GUTTER_W);
   FChannelsDropDown.OnSelect := OnChannelsDropDownSelect;
   RefreshChannelsDropDown;
 
@@ -2485,7 +2504,8 @@ begin
                             BTN_H, BtnFMCTCSSToneClick);
   StyleButton(BtnFMCTCSSTone, False);
 
-  FCTCSSDropDown := TFlatDropDown.Create(BtnFMCTCSSTone, PanelLeft, 4, BTN_SM);
+  FCTCSSDropDown := TFlatDropDown.Create(BtnFMCTCSSTone, PanelLeft, 4, BTN_SM,
+    LEFT_SCROLL_GUTTER_W);
   FCTCSSDropDown.SetItems(CTCSS_NAMES);
   FCTCSSDropDown.SetItemIndex(FController.FFMCTCSSToneIdx);
   FCTCSSDropDown.OnSelect := OnCTCSSDropDownSelect;
@@ -2509,7 +2529,8 @@ begin
                            BTN_H, BtnFMStepSelClick);
   StyleButton(BtnFMStepSel, False);
 
-  FStepDropDown := TFlatDropDown.Create(BtnFMStepSel, PanelLeft, FM_STEP_COUNT, BTN_SM);
+  FStepDropDown := TFlatDropDown.Create(BtnFMStepSel, PanelLeft, FM_STEP_COUNT,
+    BTN_SM, LEFT_SCROLL_GUTTER_W);
   FStepDropDown.SetItems(FM_STEP_NAMES);
   FStepDropDown.SetItemIndex(FController.FFMStepIdx);
   FStepDropDown.OnSelect := OnStepDropDownSelect;
@@ -2634,6 +2655,7 @@ end;
 
 procedure TMainForm.RightPanelResize(Sender: TObject);
 begin
+  UpdateLeftPanelScroll;
   ResizeSpectrumPanels;
 end;
 
@@ -3149,6 +3171,9 @@ begin
 
   Color := T.BG; Font.Color := T.Text;
   DP(PanelToolbar); DP(PanelLeft);
+  if FLeftScrollBar <> nil then
+    FLeftScrollBar.SetColors(T.Panel, T.Border,
+      T.SliderThumbHot, T.SliderThumbDrag);
   DP(PanelTopVfoGroup); DP(PanelTopVfoA); DP(PanelTopVfoB);
   DP(PanelVfoA); DP(PanelVfoB); DP(PanelVfoButtons);
   DP(PanelBands); DP(PanelMode); DP(PanelFilter);
@@ -8092,36 +8117,123 @@ end;
 // создаёт новые для enabled слотов в 3-м и 4-м ряду PanelBands.
 procedure TMainForm.RelayoutBelowBands;
 var
-  Y: Integer;
+  Y, Gap: Integer;
 begin
   if PanelBands = nil then Exit;
-  Y := PanelBands.Top + PanelBands.Height + 2;
+  Gap := Scale96ToForm(2);
-  PanelMode.Top   := Y; Y := Y + PanelMode.Height + 2;
+  Y := PanelBands.Top + PanelBands.Height + Gap;
+  PanelMode.Top   := Y; Y := Y + PanelMode.Height + Gap;
   if PanelFilter.Visible then
   begin
     PanelFilter.Top := Y;
-    Y := Y + PanelFilter.Height + 2;
+    Y := Y + PanelFilter.Height + Gap;
   end;
   if (PanelRawDev <> nil) and PanelRawDev.Visible then
   begin
-    PanelRawDev.Top := Y; Y := Y + PanelRawDev.Height + 2;
+    PanelRawDev.Top := Y; Y := Y + PanelRawDev.Height + Gap;
   end;
   if (PanelFMStep <> nil) and PanelFMStep.Visible then
   begin
-    PanelFMStep.Top := Y; Y := Y + PanelFMStep.Height + 2;
+    PanelFMStep.Top := Y; Y := Y + PanelFMStep.Height + Gap;
   end;
   if (PanelFMSQ <> nil) and PanelFMSQ.Visible then
   begin
-    PanelFMSQ.Top := Y; Y := Y + PanelFMSQ.Height + 2;
+    PanelFMSQ.Top := Y; Y := Y + PanelFMSQ.Height + Gap;
   end;
   if (PanelFMCTCSS <> nil) and PanelFMCTCSS.Visible then
   begin
-    PanelFMCTCSS.Top := Y; Y := Y + PanelFMCTCSS.Height + 2;
+    PanelFMCTCSS.Top := Y; Y := Y + PanelFMCTCSS.Height + Gap;
   end;
   if (PanelFMRpt <> nil) and PanelFMRpt.Visible then
   begin
-    PanelFMRpt.Top := Y; Y := Y + PanelFMRpt.Height + 2;
+    PanelFMRpt.Top := Y; Y := Y + PanelFMRpt.Height + Gap;
   end;
+  UpdateLeftPanelScroll;
+end;
+
+function TMainForm.CursorOverLeftPanel: Boolean;
+var
+  P: TPoint;
+begin
+  Result := False;
+  if (PanelLeft = nil) or (not PanelLeft.Visible) then Exit;
+  P := PanelLeft.ScreenToClient(Mouse.CursorPos);
+  Result := (P.X >= 0) and (P.Y >= 0) and
+            (P.X < PanelLeft.ClientWidth) and (P.Y < PanelLeft.ClientHeight);
+end;
+
+procedure TMainForm.LeftScrollChanged(Sender: TObject);
+var
+  NewValue, Delta: Integer;
+
+  procedure MovePanel(P: TPanel);
+  begin
+    if P <> nil then P.Top := P.Top + Delta;
+  end;
+
+begin
+  if FLeftScrollBar = nil then Exit;
+  NewValue := FLeftScrollBar.Position;
+  if NewValue = FLeftScrollOffset then Exit;
+  // Top хранится уже с учётом текущего scroll offset. При движении вниз
+  // содержимое уходит вверх, поэтому знак у дельты обратный.
+  Delta := FLeftScrollOffset - NewValue;
+  FLeftScrollOffset := NewValue;
+
+  MovePanel(PanelTX);
+  MovePanel(PanelRXBlock);
+  MovePanel(PanelAGC);
+  MovePanel(PanelPlutoAGC);
+  MovePanel(PanelBands);
+  MovePanel(PanelMode);
+  MovePanel(PanelFilter);
+  MovePanel(PanelRawDev);
+  MovePanel(PanelFMStep);
+  MovePanel(PanelFMSQ);
+  MovePanel(PanelFMCTCSS);
+  MovePanel(PanelFMRpt);
+
+  if FTXProfileDropDown <> nil then FTXProfileDropDown.ClosePopup;
+  if FChannelsDropDown <> nil then FChannelsDropDown.ClosePopup;
+  if FCTCSSDropDown <> nil then FCTCSSDropDown.ClosePopup;
+  if FStepDropDown <> nil then FStepDropDown.ClosePopup;
+end;
+
+procedure TMainForm.UpdateLeftPanelScroll;
+var
+  ContentBottom, ViewH, NewMax: Integer;
+
+  procedure MeasurePanel(P: TPanel);
+  var
+    B: Integer;
+  begin
+    if (P = nil) or (not P.Visible) then Exit;
+    // Возвращаем логическую позицию до сдвига viewport.
+    B := P.Top + FLeftScrollOffset + P.Height;
+    if B > ContentBottom then ContentBottom := B;
+  end;
+
+begin
+  if (PanelLeft = nil) or (FLeftScrollBar = nil) then Exit;
+  ViewH := PanelLeft.ClientHeight;
+  if ViewH <= 0 then Exit;
+
+  ContentBottom := 0;
+  MeasurePanel(PanelTX);
+  MeasurePanel(PanelRXBlock);
+  MeasurePanel(PanelAGC);
+  MeasurePanel(PanelPlutoAGC);
+  MeasurePanel(PanelBands);
+  MeasurePanel(PanelMode);
+  MeasurePanel(PanelFilter);
+  MeasurePanel(PanelRawDev);
+  MeasurePanel(PanelFMStep);
+  MeasurePanel(PanelFMSQ);
+  MeasurePanel(PanelFMCTCSS);
+  MeasurePanel(PanelFMRpt);
+
+  NewMax := Max(0, ContentBottom + Scale96ToForm(4) - ViewH);
+  FLeftScrollBar.SetRange(NewMax, ViewH);
 end;
 
 procedure TMainForm.RebuildXvtrButtons;
@@ -8362,6 +8474,22 @@ begin
   // виджет крутил бы B, а этот хендлер — активный A.
   if OverFreqDisp(FreqDispA) or OverFreqDisp(FreqDispB) then Exit;
 
+  // Если левая колонка не помещается, колесо над любой её частью прокручивает
+  // колонку, а не частоту. Scrollbar остаётся overlay и появляется по hover.
+  if CursorOverLeftPanel then
+  begin
+    UpdateLeftPanelScroll;
+    if (FLeftScrollBar <> nil) and (FLeftScrollBar.Maximum > 0) then
+    begin
+      if WheelDelta > 0 then
+        FLeftScrollBar.ScrollBy(-Scale96ToForm(64))
+      else if WheelDelta < 0 then
+        FLeftScrollBar.ScrollBy(Scale96ToForm(64));
+      Handled := True;
+      Exit;
+    end;
+  end;
+
   // Колесо над раскрытым списком устройств во флаге — прокрутка этого списка.
   for i := 0 to MAX_PANS - 1 do
     if (FPans[i] <> nil) and Assigned(FPans[i].PbSpectrum) and

OverlayScrollBar.pas

@@ -0,0 +1,237 @@
+unit OverlayScrollBar;
+
+{
+  Тонкий вертикальный overlay-scrollbar без системного оформления.
+
+  Сам контрол всегда занимает зарезервированный gutter, но трек и бегунок
+  рисуются только при Max > 0 и наведении мыши на HoverTarget. Содержимое
+  контрол не двигает: владелец подписывается на OnPositionChange.
+}
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, Controls, ExtCtrls, Forms, Graphics, Math, Types, LCLType;
+
+type
+  TOverlayScrollBar = class(TPaintBox)
+  private
+    FHoverTarget: TControl;
+    FMaximum: Integer;
+    FPosition: Integer;
+    FViewportSize: Integer;
+    FHover: Boolean;
+    FDragging: Boolean;
+    FDragY: Integer;
+    FDragPosition: Integer;
+    FBGColor: TColor;
+    FTrackColor: TColor;
+    FThumbColor: TColor;
+    FThumbDragColor: TColor;
+    FOnPositionChange: TNotifyEvent;
+    procedure AppUserInput(Sender: TObject; Msg: Cardinal);
+    procedure SetPosition(AValue: Integer);
+    function CursorOverTarget: Boolean;
+    function ThumbRect: TRect;
+  protected
+    procedure Paint; override;
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+      X, Y: Integer); override;
+    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+      X, Y: Integer); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure SetRange(AMaximum, AViewportSize: Integer);
+    procedure ScrollBy(ADelta: Integer);
+    procedure SetColors(ABG, ATrack, AThumb, AThumbDrag: TColor);
+    property HoverTarget: TControl read FHoverTarget write FHoverTarget;
+    property Maximum: Integer read FMaximum;
+    property Position: Integer read FPosition write SetPosition;
+    property OnPositionChange: TNotifyEvent
+      read FOnPositionChange write FOnPositionChange;
+  end;
+
+implementation
+
+constructor TOverlayScrollBar.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  Width := 8;
+  FMaximum := 0;
+  FPosition := 0;
+  FViewportSize := 0;
+  FHover := False;
+  FDragging := False;
+  FBGColor := TColor($00181818);
+  FTrackColor := TColor($00303030);
+  FThumbColor := TColor($00407040);
+  FThumbDragColor := TColor($00509050);
+  Application.AddOnUserInputHandler(@AppUserInput);
+end;
+
+destructor TOverlayScrollBar.Destroy;
+begin
+  Application.RemoveOnUserInputHandler(@AppUserInput);
+  if GetCaptureControl = Self then SetCaptureControl(nil);
+  inherited Destroy;
+end;
+
+procedure TOverlayScrollBar.SetColors(ABG, ATrack, AThumb,
+  AThumbDrag: TColor);
+begin
+  FBGColor := ABG;
+  FTrackColor := ATrack;
+  FThumbColor := AThumb;
+  FThumbDragColor := AThumbDrag;
+  Invalidate;
+end;
+
+procedure TOverlayScrollBar.SetRange(AMaximum, AViewportSize: Integer);
+var
+  OldMaximum: Integer;
+begin
+  OldMaximum := FMaximum;
+  FMaximum := Max(0, AMaximum);
+  FViewportSize := Max(0, AViewportSize);
+  if FPosition > FMaximum then
+    SetPosition(FMaximum)
+  else if OldMaximum <> FMaximum then
+    Invalidate;
+end;
+
+procedure TOverlayScrollBar.SetPosition(AValue: Integer);
+var
+  NewValue: Integer;
+begin
+  NewValue := EnsureRange(AValue, 0, FMaximum);
+  if NewValue = FPosition then Exit;
+  FPosition := NewValue;
+  if Assigned(FOnPositionChange) then FOnPositionChange(Self);
+  Invalidate;
+end;
+
+procedure TOverlayScrollBar.ScrollBy(ADelta: Integer);
+begin
+  SetPosition(FPosition + ADelta);
+end;
+
+function TOverlayScrollBar.CursorOverTarget: Boolean;
+var
+  P: TPoint;
+begin
+  Result := False;
+  if (FHoverTarget = nil) or (not FHoverTarget.Visible) then Exit;
+  P := FHoverTarget.ScreenToClient(Mouse.CursorPos);
+  Result := (P.X >= 0) and (P.Y >= 0) and
+            (P.X < FHoverTarget.Width) and (P.Y < FHoverTarget.Height);
+end;
+
+procedure TOverlayScrollBar.AppUserInput(Sender: TObject; Msg: Cardinal);
+var
+  NewHover: Boolean;
+begin
+  NewHover := CursorOverTarget;
+  if NewHover = FHover then Exit;
+  FHover := NewHover;
+  Invalidate;
+end;
+
+function TOverlayScrollBar.ThumbRect: TRect;
+var
+  TrackTop, TrackH, ThumbH, Travel, ContentH: Integer;
+begin
+  Result := Rect(0, 0, 0, 0);
+  if (FMaximum <= 0) or (FViewportSize <= 0) then Exit;
+  TrackTop := Scale96ToForm(4);
+  TrackH := Height - 2 * TrackTop;
+  if TrackH <= 0 then Exit;
+  ContentH := FViewportSize + FMaximum;
+  ThumbH := Max(Scale96ToForm(28),
+                MulDiv(TrackH, FViewportSize, Max(1, ContentH)));
+  ThumbH := Min(ThumbH, TrackH);
+  Travel := TrackH - ThumbH;
+  Result.Left := Max(1, (Width - Scale96ToForm(4)) div 2);
+  Result.Right := Width - Result.Left;
+  Result.Top := TrackTop;
+  if (Travel > 0) and (FMaximum > 0) then
+    Inc(Result.Top, MulDiv(Travel, FPosition, FMaximum));
+  Result.Bottom := Result.Top + ThumbH;
+end;
+
+procedure TOverlayScrollBar.Paint;
+var
+  R: TRect;
+  TrackX: Integer;
+begin
+  Canvas.Brush.Style := bsSolid;
+  Canvas.Brush.Color := FBGColor;
+  Canvas.FillRect(ClientRect);
+  if (FMaximum <= 0) or ((not FHover) and (not FDragging)) then Exit;
+
+  TrackX := Width div 2;
+  Canvas.Pen.Color := FTrackColor;
+  Canvas.Pen.Width := Max(1, Scale96ToForm(1));
+  Canvas.Line(TrackX, Scale96ToForm(4),
+    TrackX, Height - Scale96ToForm(4));
+
+  R := ThumbRect;
+  if IsRectEmpty(R) then Exit;
+  if FDragging then Canvas.Brush.Color := FThumbDragColor
+  else              Canvas.Brush.Color := FThumbColor;
+  Canvas.Pen.Style := psClear;
+  Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom,
+    Scale96ToForm(3), Scale96ToForm(3));
+  Canvas.Pen.Style := psSolid;
+end;
+
+procedure TOverlayScrollBar.MouseDown(Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+var
+  R: TRect;
+begin
+  inherited MouseDown(Button, Shift, X, Y);
+  if (Button <> mbLeft) or (FMaximum <= 0) then Exit;
+  R := ThumbRect;
+  if PtInRect(R, Point(X, Y)) then
+  begin
+    FDragging := True;
+    FDragY := Y;
+    FDragPosition := FPosition;
+    SetCaptureControl(Self);
+  end
+  else if Y < R.Top then
+    ScrollBy(-FViewportSize + Scale96ToForm(40))
+  else
+    ScrollBy(FViewportSize - Scale96ToForm(40));
+  Invalidate;
+end;
+
+procedure TOverlayScrollBar.MouseMove(Shift: TShiftState; X, Y: Integer);
+var
+  R: TRect;
+  TrackH, Travel: Integer;
+begin
+  inherited MouseMove(Shift, X, Y);
+  if not FDragging then Exit;
+  R := ThumbRect;
+  TrackH := Height - 2 * Scale96ToForm(4);
+  Travel := TrackH - (R.Bottom - R.Top);
+  if Travel <= 0 then Exit;
+  SetPosition(FDragPosition + MulDiv(Y - FDragY, FMaximum, Travel));
+end;
+
+procedure TOverlayScrollBar.MouseUp(Button: TMouseButton;
+  Shift: TShiftState; X, Y: Integer);
+begin
+  inherited MouseUp(Button, Shift, X, Y);
+  if Button <> mbLeft then Exit;
+  FDragging := False;
+  if GetCaptureControl = Self then SetCaptureControl(nil);
+  Invalidate;
+end;
+
+end.