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

2026-08-25 20:37:33 +00:00 · 2026-08-05 13:44:12 +03:00
parent 94bb15bbaf
commit b7b9119339
3 changed files with 391 additions and 19 deletions
@@ -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);
@@ -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;
-  PanelMode.Top   := Y; Y := Y + PanelMode.Height + 2;
+  Gap := Scale96ToForm(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
@@ -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.