From b7b9119339dfba076dec6cab8ec22b8d8e6e935a Mon Sep 17 00:00:00 2001 From: Vladimir Date: Wed, 5 Aug 2026 13:44:12 +0300 Subject: [PATCH] feat(ui): add hover overlay scroll for left panel --- FlatDropDown.pas | 15 ++- MainForm.pas | 158 ++++++++++++++++++++++++++--- OverlayScrollBar.pas | 237 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 391 insertions(+), 19 deletions(-) create mode 100644 OverlayScrollBar.pas diff --git a/FlatDropDown.pas b/FlatDropDown.pas index 92055b2..009b109 100644 --- a/FlatDropDown.pas +++ b/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); diff --git a/MainForm.pas b/MainForm.pas index 6e941ab..e8cd3c0 100644 --- a/MainForm.pas +++ b/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; - 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 diff --git a/OverlayScrollBar.pas b/OverlayScrollBar.pas new file mode 100644 index 0000000..741c96e --- /dev/null +++ b/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.