Files
ewsdr/PanafallPanel.pas
T
ew8bakandClaude Opus 4.8 3ee996154a feat(slices): выбор КВ-диапазона на панах N (Flex-style band-селектор)
Кликабельный бейдж диапазона («20m») в шапке пана N → popup-меню КВ-бандов.
На выбор — по-флексовому: ретюн DDC на VfoA диапазона (из общего band-кэша,
как пан 0), активный приёмник садится на VfoA с mode/filter/AGC + zoom/pan
этого диапазона, прочие слайсы пана убираются (вне новой полосы). Только на
настоящих КВ (не XVTR, не Pluto).

- TPanafallPanel: FHeaderBandLabel + OnBandClick/BandClickable/SetHeaderBand;
  каскад left-лейблов шапки вынесен в LayoutHeaderLabels (band/rate/adc без
  дыр при скрытии).
- MainForm: OnPanBandClick/PanBandMenuItemClick/ApplyPanBand +
  PanBandSelectorVisible (гейт КВ); band-лейбл в UpdatePanHeaders (по
  FreqToBandIdx частоты DDC), тема в ApplyPanHeaderTheme.

Ограничение: per-slice AGC-Top в движке нет — подтягиваются
mode/filter/AGC-mode/zoom/pan, но не индивидуальный AGC-Top диапазона.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-07-13 14:27:17 +03:00

1465 lines
62 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
unit PanafallPanel;
{
TPanafallPanel — панадаптер (спектр + линейка частот + сплиттер + водопад +
полоса пана/зума с кнопками) как единый composite-объект.
Этап 3.0 плана мультислайсов (doc/SLICES_PLAN.md): вынос панадаптера из
MainForm без изменения поведения. Панель владеет:
• конструированием контролов (Build) и SpectrumView (CPU или OpenGL);
• геометрией стека спектр/линейка/сплиттер/водопад/пан-зум (Layout);
• механикой сплиттера (drag с призраком, пересчёт по MouseUp);
• прокидкой мыши пан/зум-полосы в TPanZoomBar.
Семантика мыши спектра/водопада (тюн, слайсы, маркер, оверлеи) остаётся у
хозяина — он подвешивает свои обработчики через публичные поля Spectrum*/
Waterfall*/Zoom*Click ДО вызова Build.
Хозяин по-прежнему сам синхронизирует состояние view (частоты, палитры,
wf-настройки) и решает, когда звать Layout (resize, show/hide, сплиттер).
Фаза B1: панель владеет коллекцией флагов слайсов (главный флаг A создаёт
хозяин и отдаёт через AttachMainFlag): раскладка LayoutFlags, диспетчер мыши
флагов, создание/закрытие слайс-флагов, заливка их состояния из контроллера,
тик S-метров (TickFlags). Семантические обработчики событий флага (MODE/DSP/
AUD/TX…) остаются у хозяина — он проводит их через OnWireFlag.
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, Math, Controls, ExtCtrls, StdCtrls, Graphics, Forms,
LCLIntf, LCLType,
OpenGLContextEx,
AppTheme, WDSPEngine, RadioController, VfoOverlay,
SpectrumView, SpectrumViewOpengl, PanZoomBar, FlatButton;
type
TWireFlagEvent = procedure(O: TVfoOverlay) of object;
TSliceClosedEvent = procedure(SliceId: Integer) of object;
TPanafallPanel = class(TComponent)
private
FParent: TWinControl;
FUseOpenGL: Boolean;
FView: TSpectrumView;
FPbSpectrum: TControl;
FPbRuler: TPaintBox;
FSplitter: TPanel;
FPbWaterfall: TControl;
FPbPanZoom: TPaintBox;
FZoomBar: TPanZoomBar;
FBtnZoomIn: TFlatButton;
FBtnZoomDef: TFlatButton;
FBtnZoomOut: TFlatButton;
// Актуальные размеры областей после Layout (для DSP-движка и
// resize-детектора хозяина).
FSpectrumWidth: Integer;
FSpectrumHeight: Integer;
FWaterfallHeight: Integer;
FShowSpectrum: Boolean;
FShowWaterfall: Boolean;
FSplitterRatio: Double;
// Сплиттер-драг: обновление размеров только при отпускании мыши (MouseUp),
// чтобы исключить фризы; во время перетаскивания двигаем контролы визуально.
FSplitterDrag: Boolean;
FSplitterDragY0: Integer;
FSplitterSH0: Integer;
// Геометрия последнего Layout для drag-математики: верх области спектра и
// высота спектр+водопад ВНУТРИ региона пана (не всего родителя!).
FSplitTopOff: Integer;
FSplitAvailH: Integer; // 0 = сплиттер сейчас нелегитимен
FOnSplitterMoved: TNotifyEvent;
// ---- Флаги слайсов (фаза B1) ----
FController: TRadioController; // не владеем
FMainFlag: TVfoOverlay; // флаг A (главный) — создаёт хозяин
FSliceFlags: array of TVfoOverlay; // флаги B+ (Owner=Self)
FActiveFlag: TVfoOverlay; // чьё событие сейчас обрабатывается
FPendingSliceClose: Integer; // SliceId к удалению после мыши (0=нет)
FMainFlagPinned: Boolean; // True = левая панель хозяина скрыта
FLastSliceMeterMs: QWord; // троттлинг S-метра слайсов (~10 Гц)
FOnWireFlag: TWireFlagEvent;
FOnSliceClosed: TSliceClosedEvent;
FOnFlagsInvalidate: TNotifyEvent;
// ---- Стек панов (этап 3.3) ----
FPanId: Integer; // 0 = главный пан
FStackTop: Integer; // Y-начало региона пана внутри родителя
FStackHeight: Integer; // высота региона (0 = до низа родителя)
FHeaderPanel: TPanel; // шапка пана (видна при панах >= 2)
FHeaderLabel: TLabel;
FHeaderRateLabel: TLabel; // «NNN kHz»; у панов N>0 кликабелен (селектор rate)
FRateClickable: Boolean;
FOnRateClick: TNotifyEvent;
FHeaderBandLabel: TLabel; // «20m»; кликабелен на КВ (селектор диапазона пана, 3.6)
FBandClickable: Boolean;
FOnBandClick: TNotifyEvent;
FHeaderADCLabel: TLabel; // «RX1»/«RX2»; кликабелен при 2 АЦП (тумблер, 3.4)
FADCClickable: Boolean;
FOnADCClick: TNotifyEvent;
FBtnPopPan: TFlatButton; // «⧉» pop-out в отдельное окно (паны N>0, 3.5)
FOnPanPopOut: TNotifyEvent;
FBtnDisplay: TFlatButton; // «◑» per-pan настройки дисплея (3.6)
FOnDisplayClick: TNotifyEvent;
FDisplayOverride: Boolean; // True = пан переопределил глобальный дефолт (persist)
FBtnClosePan: TFlatButton; // «×» в шапке (только паны N>0)
FBtnAddPan: TFlatButton; // «⊞» в ряду пан/зума (только пан 0)
FHeaderVisible: Boolean;
FShowZoomRow: Boolean; // False у панов N>0 (пан-зум — этап 3.3+)
FOnPanClose: TNotifyEvent;
FOnAddPan: TNotifyEvent;
FAddPanWanted: Boolean; // хозяин: показывать «⊞» в ряду пан/зума
FBtnGrid: TFlatButton; // «▦/▤» тумблер грид-раскладки (пан 0)
FGridBtnWanted: Boolean; // хозяин: показывать тумблер (>=2 доп. панов)
FStackLeft: Integer; // регион пана: X (0 при полной ширине)
FStackWidth: Integer; // ширина региона (0 = вся ширина родителя)
procedure BtnClosePanClick(Sender: TObject);
procedure BtnAddPanClick(Sender: TObject);
procedure HeaderRateClick(Sender: TObject);
procedure SetRateClickable(AValue: Boolean);
procedure HeaderBandClick(Sender: TObject);
procedure SetBandClickable(AValue: Boolean);
procedure LayoutHeaderLabels; // каскад left-лейблов (band/rate/adc)
procedure HeaderADCClick(Sender: TObject);
procedure SetADCClickable(AValue: Boolean);
procedure BtnPopPanClick(Sender: TObject);
procedure BtnDisplayClick(Sender: TObject);
procedure PositionHeaderChildren(RW, H: Integer);
// Видимое частотное окно ЭТОГО пана: пан 0 — окно главного (зум/пан),
// паны N — центр их DDC ± rate/2 (пан-зум — этап 3.3+).
procedure ViewWindow(out VC, VS: Double);
procedure SplitterMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SplitterMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure SplitterMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PanZoomMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PanZoomMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure PanZoomMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PanZoomDblClick(Sender: TObject);
procedure PositionPanZoomBar(X0, BottomY, RW, H: Integer; AVisible: Boolean);
public
// Обработчики мыши спектра/водопада и кликов зум-кнопок хозяина —
// задать ДО вызова Build (Build подвешивает их на создаваемые контролы).
SpectrumMouseDown: TMouseEvent;
SpectrumMouseMove: TMouseMoveEvent;
SpectrumMouseUp: TMouseEvent;
SpectrumMouseLeave: TNotifyEvent;
SpectrumDblClick: TNotifyEvent;
WaterfallMouseDown: TMouseEvent;
WaterfallMouseMove: TMouseMoveEvent;
WaterfallMouseUp: TMouseEvent;
ZoomInClick: TNotifyEvent;
ZoomDefClick: TNotifyEvent;
ZoomOutClick: TNotifyEvent;
GridClick: TNotifyEvent; // «▦/▤» тумблер грид-раскладки (пан 0)
constructor Create(AOwner: TComponent; AUseOpenGL: Boolean); reintroduce;
destructor Destroy; override;
// Создаёт контролы в AParent и подвешивает обработчики (см. поля выше).
procedure Build(AParent: TWinControl; AMSAA: Integer);
// Переносит ВСЕ контролы панели в другого родителя (pop-out/dock, 3.5).
// GL-контексты канв при этом пересоздаются — хозяин обязан сбросить
// GL-кэши вьюхи (ResetGLCache) после вызова.
procedure ReparentTo(NewParent: TWinControl);
// Полная раскладка стека. ATopOffset — высота wideband-блока хозяина
// над спектром. Show-флаги приходят от контроллера (FShowSpectrum/
// FShowWaterfall).
procedure Layout(ATopOffset: Integer; AShowSpectrum, AShowWaterfall: Boolean);
// Мин. высота региона, при которой Layout не вылезает за него (те же
// константы/DPI, что в Layout; учитывает текущую HeaderVisible).
function MinLayoutHeight(ATopOffset: Integer;
AShowSpectrum, AShowWaterfall: Boolean): Integer;
property View: TSpectrumView read FView;
property PbSpectrum: TControl read FPbSpectrum;
property PbRuler: TPaintBox read FPbRuler;
property Splitter: TPanel read FSplitter;
property PbWaterfall: TControl read FPbWaterfall;
property PbPanZoom: TPaintBox read FPbPanZoom;
property ZoomBar: TPanZoomBar read FZoomBar;
property BtnZoomIn: TFlatButton read FBtnZoomIn;
property BtnZoomDef: TFlatButton read FBtnZoomDef;
property BtnZoomOut: TFlatButton read FBtnZoomOut;
property SpectrumWidth: Integer read FSpectrumWidth;
property SpectrumHeight: Integer read FSpectrumHeight;
property WaterfallHeight: Integer read FWaterfallHeight;
property SplitterRatio: Double read FSplitterRatio write FSplitterRatio;
// ---- Стек панов (этап 3.3) ----
// Регион пана внутри родителя задаёт хозяин ПЕРЕД Layout (стек панов).
property PanId: Integer read FPanId write FPanId;
property StackTop: Integer read FStackTop write FStackTop;
property StackHeight: Integer read FStackHeight write FStackHeight;
// Грид-раскладка: регион пана может быть колонкой (StackWidth=0 = вся ширина).
property StackLeft: Integer read FStackLeft write FStackLeft;
property StackWidth: Integer read FStackWidth write FStackWidth;
// Шапка пана: текст ставит хозяин (частота), rate — отдельным лейблом
// (SetHeaderRate); у панов N>0 хозяин делает его кликабельным (селектор
// rate, RateClickable + OnRateClick). «×» → OnPanClose.
property HeaderVisible: Boolean read FHeaderVisible write FHeaderVisible;
procedure SetHeaderText(const S: string);
procedure SetHeaderRate(const S: string);
property RateClickable: Boolean read FRateClickable write SetRateClickable;
property OnRateClick: TNotifyEvent read FOnRateClick write FOnRateClick;
// Бейдж диапазона «20m» (3.6, только КВ-паны N): пустой текст = скрыт,
// клик = меню КВ-диапазонов (хозяин).
procedure SetHeaderBand(const S: string);
property BandClickable: Boolean read FBandClickable write SetBandClickable;
property OnBandClick: TNotifyEvent read FOnBandClick write FOnBandClick;
property HeaderBandLabel: TLabel read FHeaderBandLabel;
// Бейдж ADC-источника «RX1»/«RX2» (3.4): показывается при NumADCs>1,
// клик = тумблер АЦП (хозяин).
procedure SetHeaderADC(const S: string);
property ADCClickable: Boolean read FADCClickable write SetADCClickable;
property OnADCClick: TNotifyEvent read FOnADCClick write FOnADCClick;
// «⧉» (3.5): вынести пан в отдельное окно (хозяин).
property OnPanPopOut: TNotifyEvent read FOnPanPopOut write FOnPanPopOut;
// «◑» (3.6): открыть поповер per-pan настроек дисплея (хозяин).
property OnDisplayClick: TNotifyEvent read FOnDisplayClick write FOnDisplayClick;
property BtnDisplay: TFlatButton read FBtnDisplay;
// Пан переопределил глобальный дефолт дисплея (для персиста панов N).
property DisplayOverride: Boolean read FDisplayOverride write FDisplayOverride;
property HeaderPanel: TPanel read FHeaderPanel;
property HeaderLabel: TLabel read FHeaderLabel;
property HeaderRateLabel: TLabel read FHeaderRateLabel;
property HeaderADCLabel: TLabel read FHeaderADCLabel;
property BtnPopPan: TFlatButton read FBtnPopPan;
property BtnClosePan: TFlatButton read FBtnClosePan;
property BtnAddPan: TFlatButton read FBtnAddPan;
// Ряд пан/зума: у панов N>0 скрыт (их зум — этап 3.3+).
property ShowZoomRow: Boolean read FShowZoomRow write FShowZoomRow;
// «⊞» в ряду пан/зума (пан 0): показать/спрятать решает хозяин.
property AddPanEnabled: Boolean read FAddPanWanted write FAddPanWanted;
// «▦/▤» тумблер грид-раскладки (пан 0, виден при >=2 доп. панах).
property GridBtnEnabled: Boolean read FGridBtnWanted write FGridBtnWanted;
property BtnGrid: TFlatButton read FBtnGrid;
property OnPanClose: TNotifyEvent read FOnPanClose write FOnPanClose;
property OnAddPan: TNotifyEvent read FOnAddPan write FOnAddPan;
// Пользователь отпустил сплиттер (ratio уже обновлён) — хозяин делает
// полный пересчёт (у него wideband/S-метр/оверлеи).
property OnSplitterMoved: TNotifyEvent read FOnSplitterMoved write FOnSplitterMoved;
// ---- Флаги слайсов ----
// Главный флаг (слайс A) создаёт хозяин (проводка событий у него) и отдаёт
// сюда; панель подключает его к view и включает в раскладку/диспетчер.
procedure AttachMainFlag(O: TVfoOverlay);
// SliceId флага, чьё событие сейчас обрабатывается (0 = главный).
function CurSliceId: Integer;
// Первый слайс панели (0 = слайсов B+ нет) — цель клика-тюна пана N.
function FirstSliceId: Integer;
function FindSliceFlag(SliceId: Integer): TVfoOverlay;
procedure CreateSliceFlag(SliceId: Integer);
procedure DestroySliceFlag(SliceId: Integer);
procedure DestroyAllSliceFlags; // сброс всех слайсов панели (+RemoveSlice)
// «×» на флаге: нельзя free внутри его же обработчика мыши — пометить...
procedure RequestSliceClose(SliceId: Integer);
// …и снять после возврата из диспетчера.
procedure ProcessPendingSliceClose;
// SliceId, чья несущая под пикселем X спектра (0 = нет).
function SliceAtPixel(X: Integer): Integer;
// SliceId флага под курсором мыши (прямоугольник оверлея; 0 = нет).
function SliceUnderCursor: Integer;
// Единый packing всех флагов (A+B+) в один ряд, без наездов.
procedure LayoutFlags;
// Флаг A виден: панель хозяина скрыта (MainFlagPinned) ИЛИ есть слайсы B+.
procedure UpdateMainFlagVisibility;
procedure PushSliceFlagState(SliceId: Integer);
procedure PushAllSliceFlagStates; // все флаги панели (после смены rate и т.п.)
procedure PushMainFlagExtState;
procedure PushMainFlagAudioDevices;
// Тик: S-метр/частота главного флага + позиции + троттленный S-метр слайсов.
procedure TickFlags;
procedure SetFlagsTheme(const T: TAppTheme);
function DispatchFlagsMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
procedure DispatchFlagsMouseMove(X, Y: Integer);
function DispatchFlagsMouseUp(X, Y: Integer): Boolean;
procedure DispatchFlagsMouseLeave;
property Controller: TRadioController read FController write FController;
property MainFlag: TVfoOverlay read FMainFlag;
property MainFlagPinned: Boolean read FMainFlagPinned write FMainFlagPinned;
// Проводка семантических событий флага (MODE/DSP/AUD/…) — хозяин.
property OnWireFlag: TWireFlagEvent read FOnWireFlag write FOnWireFlag;
// Слайс закрыт «×» — хозяину сбросить активный слайс и т.п.
property OnSliceClosed: TSliceClosedEvent read FOnSliceClosed write FOnSliceClosed;
// Флаги сдвинулись/пересозданы — хозяину пометить кадр грязным
// (эквивалент прежнего OnVfoOverlayInvalidate(nil)).
property OnFlagsInvalidate: TNotifyEvent read FOnFlagsInvalidate write FOnFlagsInvalidate;
end;
implementation
constructor TPanafallPanel.Create(AOwner: TComponent; AUseOpenGL: Boolean);
begin
inherited Create(AOwner);
FUseOpenGL := AUseOpenGL;
if FUseOpenGL then
FView := TSpectrumViewOpenGL.Create
else
FView := TSpectrumView.Create;
FZoomBar := TPanZoomBar.Create;
FSplitterRatio := 0.40;
FSplitterDrag := False;
FShowZoomRow := True; // паны N>0 выключают (их зум — этап 3.3+)
FHeaderVisible := False; // шапка появляется при панах >= 2
end;
destructor TPanafallPanel.Destroy;
begin
// Порядок как в прежнем FormDestroy: view/зум-бар первыми, контролы
// (Owner=Self) освободит inherited.
FreeAndNil(FZoomBar);
FreeAndNil(FView);
// Кнопки ряда зума создаются MakeFlatBtn с Owner=КОНТЕЙНЕР (не Self) —
// inherited их не освободит, и после гибели пана они оставались жить
// на родителе (STOP → «блуждающие» −/⌂/+ поверх окна).
FreeAndNil(FBtnZoomOut);
FreeAndNil(FBtnZoomDef);
FreeAndNil(FBtnZoomIn);
FreeAndNil(FBtnAddPan);
FreeAndNil(FBtnGrid);
inherited Destroy;
end;
procedure TPanafallPanel.Build(AParent: TWinControl; AMSAA: Integer);
begin
FParent := AParent;
if FUseOpenGL then
begin
FPbSpectrum := TOpenGLControl.Create(Self);
TOpenGLControl(FPbSpectrum).AutoResizeViewport := False;
TOpenGLControl(FPbSpectrum).DoubleBuffered := True;
TOpenGLControl(FPbSpectrum).MultiSampling := Max(1, AMSAA);
TOpenGLControl(FPbSpectrum).OnPaint := FView.PaintSpectrum;
TOpenGLControl(FPbSpectrum).OnMouseDown := SpectrumMouseDown;
TOpenGLControl(FPbSpectrum).OnDblClick := SpectrumDblClick;
TOpenGLControl(FPbSpectrum).OnMouseMove := SpectrumMouseMove;
TOpenGLControl(FPbSpectrum).OnMouseUp := SpectrumMouseUp;
TOpenGLControl(FPbSpectrum).OnMouseLeave := SpectrumMouseLeave;
TSpectrumViewOpenGL(FView).AttachControl(TOpenGLControl(FPbSpectrum));
end
else
begin
FPbSpectrum := TPaintBox.Create(Self);
TPaintBox(FPbSpectrum).OnPaint := FView.PaintSpectrum;
TPaintBox(FPbSpectrum).OnMouseDown := SpectrumMouseDown;
TPaintBox(FPbSpectrum).OnDblClick := SpectrumDblClick;
TPaintBox(FPbSpectrum).OnMouseMove := SpectrumMouseMove;
TPaintBox(FPbSpectrum).OnMouseUp := SpectrumMouseUp;
TPaintBox(FPbSpectrum).OnMouseLeave := SpectrumMouseLeave;
end;
FPbSpectrum.Parent := AParent;
// ЯВНЫЙ crArrow (не crDefault!): GL-виджет с WA_NativeWindow — отдельная
// Wayland-поверхность; без явного курсора она навсегда наследует курсор,
// бывший под мышью в момент создания (пан создаётся кнопкой «⊞» с
// crHandPoint → «рука» прилипала ко всему пану).
FPbSpectrum.Cursor := crArrow;
FPbRuler := TPaintBox.Create(Self);
FPbRuler.Parent := AParent;
FPbRuler.OnPaint := FView.PaintRuler;
FPbRuler.Cursor := crDefault;
FView.PbRuler := FPbRuler;
// ---- Сплиттер между спектром+линейкой и водопадом ----
FSplitter := TPanel.Create(Self);
FSplitter.Parent := AParent;
FSplitter.BevelOuter := bvNone;
FSplitter.Color := TColor($00303030);
FSplitter.Cursor := crVSplit;
FSplitter.Height := 5;
FSplitter.OnMouseDown := SplitterMouseDown;
FSplitter.OnMouseMove := SplitterMouseMove;
FSplitter.OnMouseUp := SplitterMouseUp;
if FUseOpenGL then
begin
FPbWaterfall := TOpenGLControl.Create(Self);
TOpenGLControl(FPbWaterfall).AutoResizeViewport := False;
TOpenGLControl(FPbWaterfall).DoubleBuffered := True;
TOpenGLControl(FPbWaterfall).OnPaint := FView.PaintWaterfall;
TOpenGLControl(FPbWaterfall).OnMouseDown := WaterfallMouseDown;
TOpenGLControl(FPbWaterfall).OnMouseMove := WaterfallMouseMove;
TOpenGLControl(FPbWaterfall).OnMouseUp := WaterfallMouseUp;
TSpectrumViewOpenGL(FView).AttachWaterfallControl(TOpenGLControl(FPbWaterfall));
end
else
begin
FPbWaterfall := TPaintBox.Create(Self);
TPaintBox(FPbWaterfall).OnPaint := FView.PaintWaterfall;
TPaintBox(FPbWaterfall).OnMouseDown := WaterfallMouseDown;
TPaintBox(FPbWaterfall).OnMouseMove := WaterfallMouseMove;
TPaintBox(FPbWaterfall).OnMouseUp := WaterfallMouseUp;
end;
FPbWaterfall.Parent := AParent;
FPbWaterfall.Cursor := crArrow; // см. комментарий у FPbSpectrum.Cursor
// ---- Панель пана/зума под водопадом ----
// Кнопки создаём с дефолтными цветами; финальная тема — у хозяина
// (ApplyDarkTheme → StyleButton/SetTheme через алиасы).
FPbPanZoom := TPaintBox.Create(Self);
FPbPanZoom.Parent := AParent;
FPbPanZoom.OnPaint := FZoomBar.Paint;
FPbPanZoom.OnMouseDown := PanZoomMouseDown;
FPbPanZoom.OnMouseMove := PanZoomMouseMove;
FPbPanZoom.OnMouseUp := PanZoomMouseUp;
FPbPanZoom.OnDblClick := PanZoomDblClick;
FZoomBar.PaintBox := FPbPanZoom;
FBtnZoomOut := MakeFlatBtn(AParent, '', 0, 0, 10, 10, ZoomOutClick);
FBtnZoomDef := MakeFlatBtn(AParent, '⌂', 0, 0, 10, 10, ZoomDefClick);
FBtnZoomIn := MakeFlatBtn(AParent, '+', 0, 0, 10, 10, ZoomInClick);
// ---- Кнопка «добавить пан» в ряду пан/зума (хозяин включает на пане 0) ----
FBtnAddPan := MakeFlatBtn(AParent, '⊞', 0, 0, 10, 10, BtnAddPanClick);
FBtnAddPan.Hint := 'Add panadapter';
FBtnAddPan.ShowHint := True;
FBtnAddPan.Visible := False;
// Тумблер грид-раскладки (пан 0; глифом рулит хозяин: ▦ = в грид, ▤ = в стек).
FBtnGrid := MakeFlatBtn(AParent, '▦', 0, 0, 10, 10, GridClick);
FBtnGrid.Hint := 'Grid layout';
FBtnGrid.ShowHint := True;
FBtnGrid.Visible := False;
// ---- Шапка пана (тонкая полоска над спектром; видна при панах >= 2) ----
FHeaderPanel := TPanel.Create(Self);
FHeaderPanel.Parent := AParent;
FHeaderPanel.BevelOuter := bvNone;
FHeaderPanel.Visible := False;
FHeaderLabel := TLabel.Create(Self);
FHeaderLabel.Parent := FHeaderPanel;
FHeaderLabel.AutoSize := True;
FHeaderLabel.Left := 8;
// Rate — отдельным лейблом за основным текстом: у панов N>0 он кликабелен
// (селектор rate DDC), у пана 0 — просто текст.
FHeaderRateLabel := TLabel.Create(Self);
FHeaderRateLabel.Parent := FHeaderPanel;
FHeaderRateLabel.AutoSize := True;
FHeaderRateLabel.OnClick := HeaderRateClick;
// Band-бейдж «20m» (3.6): между текстом пана и rate; пустой = скрыт.
FHeaderBandLabel := TLabel.Create(Self);
FHeaderBandLabel.Parent := FHeaderPanel;
FHeaderBandLabel.AutoSize := True;
FHeaderBandLabel.Visible := False;
FHeaderBandLabel.OnClick := HeaderBandClick;
// ADC-бейдж «RX1»/«RX2» (3.4): пустой текст = скрыт (одноАЦПшные платы).
FHeaderADCLabel := TLabel.Create(Self);
FHeaderADCLabel.Parent := FHeaderPanel;
FHeaderADCLabel.AutoSize := True;
FHeaderADCLabel.OnClick := HeaderADCClick;
FBtnDisplay := MakeFlatBtn(FHeaderPanel, '◑', 0, 0, 10, 10, BtnDisplayClick);
FBtnDisplay.Hint := 'Display settings';
FBtnDisplay.ShowHint := True;
FBtnDisplay.Visible := False; // хозяин включает при видимой шапке
FBtnPopPan := MakeFlatBtn(FHeaderPanel, '⧉', 0, 0, 10, 10, BtnPopPanClick);
FBtnPopPan.Hint := 'Pop out';
FBtnPopPan.ShowHint := True;
FBtnPopPan.Visible := False; // хозяин включает у панов N>0
FBtnClosePan := MakeFlatBtn(FHeaderPanel, '×', 0, 0, 10, 10, BtnClosePanClick);
FBtnClosePan.Visible := False; // хозяин включает у панов N>0
end;
procedure TPanafallPanel.ReparentTo(NewParent: TWinControl);
begin
if (NewParent = nil) or (NewParent = FParent) then Exit;
FParent := NewParent;
FPbSpectrum.Parent := NewParent;
FPbRuler.Parent := NewParent;
FSplitter.Parent := NewParent;
FPbWaterfall.Parent := NewParent;
FPbPanZoom.Parent := NewParent;
FBtnZoomOut.Parent := NewParent;
FBtnZoomDef.Parent := NewParent;
FBtnZoomIn.Parent := NewParent;
FBtnAddPan.Parent := NewParent;
FBtnGrid.Parent := NewParent;
FHeaderPanel.Parent := NewParent; // дети шапки едут вместе с ней
end;
procedure TPanafallPanel.BtnClosePanClick(Sender: TObject);
begin
if Assigned(FOnPanClose) then FOnPanClose(Self);
end;
procedure TPanafallPanel.BtnAddPanClick(Sender: TObject);
begin
if Assigned(FOnAddPan) then FOnAddPan(Self);
end;
procedure TPanafallPanel.LayoutHeaderLabels;
// Единый каскад left-лейблов шапки: [текст пана] [band?] [rate] [adc?].
// Скрытые (Visible=False) лейблы пропускаются, чтобы не оставлять дыр.
var X: Integer;
begin
if FHeaderLabel = nil then Exit;
X := FHeaderLabel.Left + FHeaderLabel.Width + 6;
if (FHeaderBandLabel <> nil) and FHeaderBandLabel.Visible then
begin
FHeaderBandLabel.Left := X;
Inc(X, FHeaderBandLabel.Width + 10);
end;
if FHeaderRateLabel <> nil then
begin
FHeaderRateLabel.Left := X;
Inc(X, FHeaderRateLabel.Width + 10);
end;
if FHeaderADCLabel <> nil then
FHeaderADCLabel.Left := X;
end;
procedure TPanafallPanel.SetHeaderText(const S: string);
begin
if FHeaderLabel = nil then Exit;
if FHeaderLabel.Caption = S then Exit;
FHeaderLabel.Caption := S;
LayoutHeaderLabels; // ширина текста изменилась — сдвинуть хвост
end;
procedure TPanafallPanel.SetHeaderRate(const S: string);
begin
if FHeaderRateLabel = nil then Exit;
if FHeaderRateLabel.Caption <> S then FHeaderRateLabel.Caption := S;
LayoutHeaderLabels;
end;
procedure TPanafallPanel.SetHeaderBand(const S: string);
begin
if FHeaderBandLabel = nil then Exit;
if FHeaderBandLabel.Caption <> S then FHeaderBandLabel.Caption := S;
FHeaderBandLabel.Visible := S <> '';
LayoutHeaderLabels;
end;
procedure TPanafallPanel.SetBandClickable(AValue: Boolean);
begin
FBandClickable := AValue;
if FHeaderBandLabel <> nil then
begin
if AValue then FHeaderBandLabel.Cursor := crHandPoint
else FHeaderBandLabel.Cursor := crArrow;
end;
end;
procedure TPanafallPanel.HeaderBandClick(Sender: TObject);
begin
if FBandClickable and Assigned(FOnBandClick) then FOnBandClick(Self);
end;
procedure TPanafallPanel.SetRateClickable(AValue: Boolean);
begin
FRateClickable := AValue;
if FHeaderRateLabel <> nil then
begin
if AValue then
FHeaderRateLabel.Cursor := crHandPoint
else
FHeaderRateLabel.Cursor := crArrow;
end;
end;
procedure TPanafallPanel.HeaderRateClick(Sender: TObject);
begin
if FRateClickable and Assigned(FOnRateClick) then FOnRateClick(Self);
end;
procedure TPanafallPanel.SetHeaderADC(const S: string);
begin
if FHeaderADCLabel = nil then Exit;
if FHeaderADCLabel.Caption <> S then FHeaderADCLabel.Caption := S;
FHeaderADCLabel.Visible := S <> '';
LayoutHeaderLabels;
end;
procedure TPanafallPanel.SetADCClickable(AValue: Boolean);
begin
FADCClickable := AValue;
if FHeaderADCLabel <> nil then
begin
if AValue then
FHeaderADCLabel.Cursor := crHandPoint
else
FHeaderADCLabel.Cursor := crArrow;
end;
end;
procedure TPanafallPanel.HeaderADCClick(Sender: TObject);
begin
if FADCClickable and Assigned(FOnADCClick) then FOnADCClick(Self);
end;
procedure TPanafallPanel.BtnPopPanClick(Sender: TObject);
begin
if Assigned(FOnPanPopOut) then FOnPanPopOut(Self);
end;
procedure TPanafallPanel.BtnDisplayClick(Sender: TObject);
begin
if Assigned(FOnDisplayClick) then FOnDisplayClick(Self);
end;
procedure TPanafallPanel.ViewWindow(out VC, VS: Double);
begin
VC := 0; VS := 0;
if FController = nil then Exit;
// Единая точка видимого окна: PanId=0 → главный зум, паны N → свой пан-зум.
FController.GetPanViewWindow(FPanId, VC, VS);
end;
procedure TPanafallPanel.PositionHeaderChildren(RW, H: Integer);
var BtnS, X: Integer;
begin
if FHeaderLabel <> nil then
FHeaderLabel.Top := (H - FHeaderLabel.Height) div 2;
if FHeaderBandLabel <> nil then
FHeaderBandLabel.Top := (H - FHeaderBandLabel.Height) div 2;
if FHeaderRateLabel <> nil then
FHeaderRateLabel.Top := (H - FHeaderRateLabel.Height) div 2;
if FHeaderADCLabel <> nil then
FHeaderADCLabel.Top := (H - FHeaderADCLabel.Height) div 2;
LayoutHeaderLabels; // единый каскад left-позиций
// Кнопки шапки прижаты вправо, справа налево: [×] [⧉] [◑]. Позиция каждой
// зависит от видимости соседей (у пана 0 нет × и ⧉ — ◑ уезжает к краю).
BtnS := H - 4;
X := RW - 2;
if (FBtnClosePan <> nil) and FBtnClosePan.Visible then
begin
Dec(X, BtnS); FBtnClosePan.SetBounds(X, 2, BtnS, BtnS); Dec(X, 4);
end;
if (FBtnPopPan <> nil) and FBtnPopPan.Visible then
begin
Dec(X, BtnS); FBtnPopPan.SetBounds(X, 2, BtnS, BtnS); Dec(X, 4);
end;
if (FBtnDisplay <> nil) and FBtnDisplay.Visible then
begin
Dec(X, BtnS); FBtnDisplay.SetBounds(X, 2, BtnS, BtnS); Dec(X, 4);
end;
end;
procedure TPanafallPanel.PositionPanZoomBar(X0, BottomY, RW, H: Integer;
AVisible: Boolean);
var BtnW, Gap, StripW, X, NBtns: Integer; WantAdd, WantGrid: Boolean;
begin
if (FPbPanZoom = nil) or (FBtnZoomIn = nil) then Exit;
// «⊞» добавления пана и «▦/▤» грид-тумблер живут в этом же ряду; хозяин
// включает их флагами AddPanEnabled/GridBtnEnabled (Visible — здесь).
WantAdd := FAddPanWanted and (FBtnAddPan <> nil);
WantGrid := FGridBtnWanted and (FBtnGrid <> nil);
FPbPanZoom.Visible := AVisible;
FBtnZoomIn.Visible := AVisible;
FBtnZoomDef.Visible := AVisible;
FBtnZoomOut.Visible := AVisible;
if FBtnAddPan <> nil then FBtnAddPan.Visible := AVisible and WantAdd;
if FBtnGrid <> nil then FBtnGrid.Visible := AVisible and WantGrid;
if not AVisible then Exit;
Gap := MulDiv(2, Screen.PixelsPerInch, 96);
BtnW := H; // квадратные кнопки в высоту строки
NBtns := 3;
if WantAdd then Inc(NBtns);
if WantGrid then Inc(NBtns);
StripW := RW - NBtns * BtnW - (NBtns + 1) * Gap;
if StripW < 20 then StripW := 20;
FPbPanZoom.SetBounds(X0, BottomY, StripW, H);
X := X0 + StripW + Gap;
FBtnZoomOut.SetBounds(X, BottomY, BtnW, H); Inc(X, BtnW + Gap);
FBtnZoomDef.SetBounds(X, BottomY, BtnW, H); Inc(X, BtnW + Gap);
FBtnZoomIn.SetBounds(X, BottomY, BtnW, H);
if WantGrid then
begin
Inc(X, BtnW + Gap);
FBtnGrid.SetBounds(X, BottomY, BtnW, H);
end;
if WantAdd then
begin
Inc(X, BtnW + Gap);
FBtnAddPan.SetBounds(X, BottomY, BtnW, H);
end;
FPbPanZoom.Invalidate;
end;
function TPanafallPanel.MinLayoutHeight(ATopOffset: Integer;
AShowSpectrum, AShowWaterfall: Boolean): Integer;
const
SPLITTER_H = 5;
MIN_SH = 60; // = Layout
MIN_WH = 40; // = Layout
var
RULER_H, PANZOOM_H, HEADER_H: Integer;
begin
RULER_H := MulDiv(18, Screen.PixelsPerInch, 96);
PANZOOM_H := MulDiv(22, Screen.PixelsPerInch, 96);
HEADER_H := MulDiv(20, Screen.PixelsPerInch, 96);
Result := ATopOffset;
if FHeaderVisible then Inc(Result, HEADER_H);
if (AShowSpectrum or AShowWaterfall) and FShowZoomRow then
Inc(Result, PANZOOM_H);
if AShowSpectrum then Inc(Result, MIN_SH + RULER_H);
if AShowWaterfall then
begin
Inc(Result, MIN_WH);
if AShowSpectrum then Inc(Result, SPLITTER_H)
else Inc(Result, RULER_H); // водопад-only тоже рисует линейку
end;
end;
procedure TPanafallPanel.Layout(ATopOffset: Integer;
AShowSpectrum, AShowWaterfall: Boolean);
const
SPLITTER_H = 5;
MIN_SH = 60; // минимальная высота спектра
MIN_WH = 40; // минимальная высота водопада
var
RW, RH, SH, WH, TopOff, X0: Integer;
AvailH: Integer;
RULER_H: Integer;
PANZOOM_H: Integer;
HEADER_H: Integer;
ShowPZ: Boolean;
EffRatio: Double;
begin
if (FParent = nil) or (FPbSpectrum = nil) then Exit;
FShowSpectrum := AShowSpectrum;
FShowWaterfall := AShowWaterfall;
FSplitAvailH := 0; // валидно только в режиме «спектр+водопад» (ниже)
RULER_H := MulDiv(18, Screen.PixelsPerInch, 96);
// Регион пана — прямоугольник [X0..X0+RW) × [FStackTop..RH): грид-раскладка
// ставит паны колонками; 0/0 по каждой оси = весь родитель.
X0 := FStackLeft;
if FStackWidth > 0 then
RW := FStackWidth
else
begin
X0 := 0;
RW := FParent.ClientWidth;
end;
if FStackHeight > 0 then
RH := FStackTop + FStackHeight
else
RH := FParent.ClientHeight;
// Шапка пана — первой строкой региона (видна при панах >= 2).
HEADER_H := MulDiv(20, Screen.PixelsPerInch, 96);
if FHeaderPanel <> nil then
begin
FHeaderPanel.Visible := FHeaderVisible;
if FHeaderVisible then
begin
FHeaderPanel.SetBounds(X0, FStackTop, RW, HEADER_H);
PositionHeaderChildren(RW, HEADER_H);
end;
end;
// Резервируем низ под панель пана/зума (видна, если виден спектр или водопад).
PANZOOM_H := MulDiv(22, Screen.PixelsPerInch, 96);
ShowPZ := (AShowSpectrum or AShowWaterfall) and FShowZoomRow;
PositionPanZoomBar(X0, RH - PANZOOM_H, RW, PANZOOM_H, ShowPZ);
if ShowPZ then RH := RH - PANZOOM_H;
TopOff := ATopOffset + FStackTop;
if FHeaderVisible then Inc(TopOff, HEADER_H);
// ---- Оба скрыты ----
if (not AShowSpectrum) and (not AShowWaterfall) then
begin
FPbSpectrum.Visible := False;
FPbRuler.Visible := False;
FSplitter.Visible := False;
FPbWaterfall.Visible := False;
FSpectrumWidth := RW;
FSpectrumHeight := 0;
FWaterfallHeight := 0;
Exit;
end;
// ---- Только спектр (водопад скрыт) ----
if AShowSpectrum and (not AShowWaterfall) then
begin
AvailH := RH - TopOff - RULER_H;
if AvailH < MIN_SH then AvailH := MIN_SH;
SH := AvailH;
FPbSpectrum.SetBounds(X0, TopOff, RW, SH);
FPbSpectrum.Visible := True;
FPbRuler.SetBounds(X0, TopOff + SH, RW, RULER_H);
FPbRuler.Visible := True;
FSplitter.Visible := False;
FPbWaterfall.Visible := False;
FSpectrumWidth := RW;
FSpectrumHeight := SH;
FWaterfallHeight := 0;
if RW > 0 then
begin
FView.SetSpectrumBitmapSize(RW, SH);
FView.SetWaterfallBitmapSize(1, 1);
FView.SetRulerSize(RW, RULER_H);
FView.DrawSpectrum;
FPbSpectrum.Invalidate;
FPbRuler.Invalidate;
end;
Exit;
end;
// ---- Только водопад (спектр скрыт): линейка под водопадом ----
if (not AShowSpectrum) and AShowWaterfall then
begin
AvailH := RH - TopOff - RULER_H;
if AvailH < MIN_WH then AvailH := MIN_WH;
WH := AvailH;
FPbSpectrum.Visible := False;
FSplitter.Visible := False;
FPbWaterfall.SetBounds(X0, TopOff, RW, WH);
FPbWaterfall.Visible := True;
FPbRuler.SetBounds(X0, TopOff + WH, RW, RULER_H);
FPbRuler.Visible := True;
FSpectrumWidth := RW;
FSpectrumHeight := 0;
FWaterfallHeight := WH;
if RW > 0 then
begin
FView.SetSpectrumBitmapSize(1, 1);
FView.SetWaterfallBitmapSize(RW, WH);
FView.SetRulerSize(RW, RULER_H);
FView.DrawWaterfall;
FPbWaterfall.Invalidate;
FPbRuler.Invalidate;
end;
Exit;
end;
// ---- Оба видимы: стандартный режим со сплиттером ----
FPbSpectrum.Visible := True;
FPbRuler.Visible := True;
FSplitter.Visible := True;
FPbWaterfall.Visible := True;
AvailH := RH - TopOff - RULER_H - SPLITTER_H;
if AvailH < (MIN_SH + MIN_WH) then Exit;
// Запоминаем геометрию для drag-математики сплиттера (регион пана в стеке).
FSplitTopOff := TopOff;
FSplitAvailH := AvailH;
// Ограничиваем соотношение, чтобы каждая зона имела минимальный размер.
// Кламп — в ЛОКАЛЬНУЮ переменную: FSplitterRatio правит только юзер
// (drag сплиттера). Иначе в маленьком регионе (стек панов) кламп
// перезаписывал ratio (60/AvailH → ~0.7) и после закрытия панов
// пропорция «50/50» не восстанавливалась.
EffRatio := FSplitterRatio;
if EffRatio < MIN_SH / AvailH then
EffRatio := MIN_SH / AvailH;
if EffRatio > 1.0 - MIN_WH / AvailH then
EffRatio := 1.0 - MIN_WH / AvailH;
SH := Round(AvailH * EffRatio);
WH := AvailH - SH;
if WH < MIN_WH then WH := MIN_WH;
// Спектр
FPbSpectrum.SetBounds(X0, TopOff, RW, SH);
// Линейка частот — всегда прижата к низу спектра
FPbRuler.SetBounds(X0, TopOff + SH, RW, RULER_H);
// Сплиттер — между линейкой и водопадом
FSplitter.SetBounds(X0, TopOff + SH + RULER_H, RW, SPLITTER_H);
// Водопад — под сплиттером
FPbWaterfall.SetBounds(X0, TopOff + SH + RULER_H + SPLITTER_H, RW, WH);
// Обновляем переменные размеров
FSpectrumWidth := RW;
FSpectrumHeight := SH;
FWaterfallHeight := WH;
// Пересоздаём bitmap точно под новый размер
if RW > 0 then
begin
if SH > 0 then FView.SetSpectrumBitmapSize(RW, SH);
if WH > 0 then FView.SetWaterfallBitmapSize(RW, WH);
FView.SetRulerSize(RW, RULER_H);
FView.DrawSpectrum;
FPbSpectrum.Invalidate;
if FPbRuler <> nil then FPbRuler.Invalidate;
FPbWaterfall.Invalidate;
end;
end;
// ===========================================================================
// Splitter — перетаскивание границы спектр/водопад
// Обновление размеров происходит только при отпускании мыши (MouseUp),
// чтобы исключить фризы во время перетаскивания.
// Во время перетаскивания рисуем только призрак-линию на сплиттере.
// ===========================================================================
procedure TPanafallPanel.SplitterMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
begin
if Button <> mbLeft then Exit;
FSplitterDrag := True;
FSplitterSH0 := FSpectrumHeight;
// Y в координатах родителя (области панадаптера)
P := FParent.ScreenToClient(FSplitter.ClientToScreen(Point(X, Y)));
FSplitterDragY0 := P.Y;
FSplitter.Color := TColor($005050A0); // подсветка при захвате
{$IFDEF WINDOWS}
SetCapture(FSplitter.Handle);
{$ENDIF}
end;
procedure TPanafallPanel.SplitterMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
P: TPoint;
DeltaY: Integer;
NewSH: Integer;
TopOff, AvailH: Integer;
RULER_H: Integer;
const
SPLITTER_H = 5;
MIN_SH = 60;
MIN_WH = 40;
begin
RULER_H := MulDiv(18, Screen.PixelsPerInch, 96);
if not FSplitterDrag then Exit;
// Геометрия региона ЭТОГО пана из последнего Layout (стек панов!),
// а не от всего родителя.
TopOff := FSplitTopOff;
AvailH := FSplitAvailH;
if AvailH <= 0 then Exit;
P := FParent.ScreenToClient(FSplitter.ClientToScreen(Point(X, Y)));
DeltaY := P.Y - FSplitterDragY0;
NewSH := FSplitterSH0 + DeltaY;
if NewSH < MIN_SH then NewSH := MIN_SH;
if NewSH > AvailH - MIN_WH then NewSH := AvailH - MIN_WH;
// Только двигаем сплиттер визуально — без пересчёта битмапов
FSplitter.Top := TopOff + NewSH + RULER_H;
FPbWaterfall.Top := TopOff + NewSH + RULER_H + SPLITTER_H;
FPbWaterfall.Height := AvailH - NewSH;
end;
procedure TPanafallPanel.SplitterMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
DeltaY: Integer;
NewSH: Integer;
AvailH: Integer;
const
MIN_SH = 60;
MIN_WH = 40;
begin
if not FSplitterDrag then Exit;
FSplitterDrag := False;
{$IFDEF WINDOWS}
ReleaseCapture;
{$ENDIF}
FSplitter.Color := TColor($00303030); // обычный цвет
P := FParent.ScreenToClient(FSplitter.ClientToScreen(Point(X, Y)));
DeltaY := P.Y - FSplitterDragY0;
// Высота спектр+водопад региона ЭТОГО пана из последнего Layout (стек панов!).
AvailH := FSplitAvailH;
if AvailH <= 0 then Exit;
NewSH := FSplitterSH0 + DeltaY;
if NewSH < MIN_SH then NewSH := MIN_SH;
if NewSH > AvailH - MIN_WH then NewSH := AvailH - MIN_WH;
// Сохраняем новое соотношение; полный пересчёт с перерисовкой — у хозяина
// (ему виднее: wideband, S-метр, оверлеи).
FSplitterRatio := NewSH / AvailH;
if Assigned(FOnSplitterMoved) then FOnSplitterMoved(Self);
end;
// ===========================================================================
// Пан/зум-полоса — прокидка мыши в TPanZoomBar
// ===========================================================================
procedure TPanafallPanel.PanZoomMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FZoomBar <> nil then FZoomBar.HandleMouseDown(Button, X, Y);
end;
procedure TPanafallPanel.PanZoomMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if FZoomBar <> nil then FZoomBar.HandleMouseMove(X, Y);
end;
procedure TPanafallPanel.PanZoomMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FZoomBar <> nil then FZoomBar.HandleMouseUp;
end;
procedure TPanafallPanel.PanZoomDblClick(Sender: TObject);
begin
if FZoomBar <> nil then FZoomBar.HandleDblClick;
end;
// ===========================================================================
// Флаги слайсов: коллекция, раскладка, диспетчер мыши, тик
// ===========================================================================
procedure TPanafallPanel.AttachMainFlag(O: TVfoOverlay);
begin
FMainFlag := O;
FView.VfoOverlay := O;
end;
function TPanafallPanel.CurSliceId: Integer;
begin
if Assigned(FActiveFlag) then Result := FActiveFlag.SliceId else Result := 0;
end;
function TPanafallPanel.FirstSliceId: Integer;
var i: Integer;
begin
Result := 0;
for i := 0 to High(FSliceFlags) do
if FSliceFlags[i] <> nil then Exit(FSliceFlags[i].SliceId);
end;
function TPanafallPanel.FindSliceFlag(SliceId: Integer): TVfoOverlay;
var i: Integer;
begin
Result := nil;
for i := 0 to High(FSliceFlags) do
if (FSliceFlags[i] <> nil) and (FSliceFlags[i].SliceId = SliceId) then
Exit(FSliceFlags[i]);
end;
procedure TPanafallPanel.CreateSliceFlag(SliceId: Integer);
var
O: TVfoOverlay;
S: TCtrlSlice;
begin
if FindSliceFlag(SliceId) <> nil then Exit;
if (FController = nil) or not FController.GetSlice(SliceId, S) then Exit;
O := TVfoOverlay.Create(Self);
if Assigned(FOnWireFlag) then FOnWireFlag(O);
O.SetSliceInfo(SliceId, S.Letter, False);
O.SMeterThreshold := 1.5; // слайсы: грубее метр → меньше дорогих ре-рендеров флага
O.Width := OVL_W;
O.Height := O.BaseHeight;
O.Visible := True; // флаги слайсов видны всегда (не зависят от скрытия панели)
SetLength(FSliceFlags, Length(FSliceFlags) + 1);
FSliceFlags[High(FSliceFlags)] := O;
FView.AddSliceOverlay(O);
PushSliceFlagState(SliceId);
UpdateMainFlagVisibility; // появился слайс B+ → показать и флаг A (если панель открыта)
LayoutFlags;
end;
procedure TPanafallPanel.DestroySliceFlag(SliceId: Integer);
var
i, j: Integer;
O: TVfoOverlay;
begin
O := FindSliceFlag(SliceId);
if O = nil then Exit;
if FController <> nil then FController.RemoveSlice(SliceId);
FView.RemoveSliceOverlay(O);
// Убираем из массива со сжатием.
j := 0;
for i := 0 to High(FSliceFlags) do
if FSliceFlags[i] <> O then
begin
FSliceFlags[j] := FSliceFlags[i];
Inc(j);
end;
SetLength(FSliceFlags, j);
O.Free;
if Assigned(FOnSliceClosed) then FOnSliceClosed(SliceId);
UpdateMainFlagVisibility; // закрыт последний слайс при открытой панели → скрыть флаг A
if Assigned(FOnFlagsInvalidate) then FOnFlagsInvalidate(Self); // Self = панель (роутинг по пану)
end;
procedure TPanafallPanel.DestroyAllSliceFlags;
// Полный сброс слайсов панели (каждый DestroySliceFlag зовёт RemoveSlice +
// сжимает FSliceFlags). Нужен персисту: слайсы пана 0 переживают STOP, а
// восстановление создаёт их заново — иначе дубли.
begin
while Length(FSliceFlags) > 0 do
DestroySliceFlag(FSliceFlags[0].SliceId);
end;
procedure TPanafallPanel.RequestSliceClose(SliceId: Integer);
begin
FPendingSliceClose := SliceId;
end;
procedure TPanafallPanel.ProcessPendingSliceClose;
var Id: Integer;
begin
if FPendingSliceClose = 0 then Exit;
Id := FPendingSliceClose;
FPendingSliceClose := 0;
DestroySliceFlag(Id);
end;
// SliceId, чья несущая под пикселем X (в пределах допуска), 0 если нет.
function TPanafallPanel.SliceAtPixel(X: Integer): Integer;
const TOL = 6;
var
i, CarrierX: Integer;
VC, VS: Double;
S: TCtrlSlice;
O: TVfoOverlay;
begin
Result := 0;
if (FPbSpectrum = nil) or (FPbSpectrum.Width <= 0) or (FController = nil) then Exit;
ViewWindow(VC, VS);
if VS <= 0 then Exit;
for i := 0 to High(FSliceFlags) do
begin
O := FSliceFlags[i];
if (O = nil) or (not O.Visible) then Continue;
if not FController.GetSlice(O.SliceId, S) then Continue;
CarrierX := Round((S.TargetHz - VC + VS / 2) / VS * FPbSpectrum.Width);
if Abs(X - CarrierX) <= TOL then Exit(O.SliceId);
end;
end;
// Флаг слайса под курсором мыши (в клиентских координатах спектра)?
function TPanafallPanel.SliceUnderCursor: Integer;
var P: TPoint; i: Integer; O: TVfoOverlay;
begin
Result := 0;
if (FPbSpectrum = nil) or (not FPbSpectrum.Visible) then Exit;
P := FPbSpectrum.ScreenToClient(Mouse.CursorPos);
for i := 0 to High(FSliceFlags) do
begin
O := FSliceFlags[i];
if (O = nil) or (not O.Visible) then Continue;
if (P.X >= O.Left) and (P.X < O.Left + O.Width) and
(P.Y >= O.Top) and (P.Y < O.Top + O.Height) then
Exit(O.SliceId);
end;
end;
// Позиционирование всех флагов (главный A + слайсы B+) единым проходом.
// Идеал каждого флага — рядом со СВОЕЙ полосой фильтра (справа, флип влево
// если не влезает). Флаги не наезжают друг на друга: сосед слева «толкает»
// правого; если ряд вылез за правый край — обратный проход поджимает влево.
procedure TPanafallPanel.LayoutFlags;
const
FLAG_TOP = 35; // все флаги на одном уровне
GAPX = 4; // минимальный зазор между соседними флагами
var
Ovls: array of TVfoOverlay;
Ideal, OWs, Lefts: array of Integer;
n, i, j, W: Integer;
VC, VS: Double;
S: TCtrlSlice;
LoHz, HiHz: Double;
TmpO: TVfoOverlay;
TmpI: Integer;
Moved: Boolean;
// Идеальный Left рядом с полосой фильтра [loHz..hiHz] вокруг несущей Carrier.
function IdealLeftFor(Carrier, loHz, hiHz: Double; OW: Integer): Integer;
var vfoX, sx1, sx2, nl: Integer;
begin
vfoX := Round((Carrier - VC + VS / 2) / VS * W);
sx1 := Max(0, Min(W - 1, vfoX + Round(loHz / VS * W)));
sx2 := Max(0, Min(W - 1, vfoX + Round(hiHz / VS * W)));
nl := sx2 + 6; // по умолчанию справа от полосы
if nl + OW > W - 4 then nl := sx1 - 6 - OW; // не влезает → слева
Result := nl;
end;
begin
if (FPbSpectrum = nil) or (FController = nil) then Exit;
W := FPbSpectrum.Width;
ViewWindow(VC, VS);
if (W <= 0) or (VS <= 0) then Exit;
// 1. Собрать видимые флаги + их идеальный Left рядом со своей полосой.
n := 0;
SetLength(Ovls, 1 + Length(FSliceFlags));
SetLength(Ideal, 1 + Length(FSliceFlags));
SetLength(OWs, 1 + Length(FSliceFlags));
if Assigned(FMainFlag) and FMainFlag.Visible then
begin
case FController.FMode of
MODE_LSB: begin LoHz := -FController.FFilterBW; HiHz := -100; end;
MODE_USB: begin LoHz := 100; HiHz := FController.FFilterBW; end;
MODE_DIGL: begin LoHz := -FController.FFilterBW; HiHz := 0; end;
MODE_DIGU: begin LoHz := 0; HiHz := FController.FFilterBW; end;
else begin LoHz := -FController.FFilterBW / 2; HiHz := FController.FFilterBW / 2; end;
end;
Ovls[n] := FMainFlag;
OWs[n] := FMainFlag.Width;
Ideal[n] := IdealLeftFor(FController.FVfoA, LoHz, HiHz, OWs[n]);
Inc(n);
end;
for i := 0 to High(FSliceFlags) do
begin
if (FSliceFlags[i] = nil) or (not FSliceFlags[i].Visible) then Continue;
if not FController.GetSlice(FSliceFlags[i].SliceId, S) then Continue;
Ovls[n] := FSliceFlags[i];
OWs[n] := FSliceFlags[i].Width;
Ideal[n] := IdealLeftFor(S.TargetHz, S.FilterLo, S.FilterHi, OWs[n]);
Inc(n);
end;
if n = 0 then Exit;
// 2. Сортировка по идеальному Left (≈ по частоте) — пузырьком, n мал.
for i := 0 to n - 2 do
for j := 0 to n - 2 - i do
if Ideal[j] > Ideal[j + 1] then
begin
TmpI := Ideal[j]; Ideal[j] := Ideal[j + 1]; Ideal[j + 1] := TmpI;
TmpI := OWs[j]; OWs[j] := OWs[j + 1]; OWs[j + 1] := TmpI;
TmpO := Ovls[j]; Ovls[j] := Ovls[j + 1]; Ovls[j + 1] := TmpO;
end;
// 3. Вперёд-проход: сосед слева толкает правого (тот не пересекает).
SetLength(Lefts, n);
for i := 0 to n - 1 do
begin
Lefts[i] := Ideal[i];
if (i > 0) and (Lefts[i] < Lefts[i - 1] + OWs[i - 1] + GAPX) then
Lefts[i] := Lefts[i - 1] + OWs[i - 1] + GAPX;
end;
// 4. Если ряд вылез за правый край — обратный проход поджимает влево.
if Lefts[n - 1] + OWs[n - 1] > W - 4 then
for i := n - 1 downto 0 do
if i = n - 1 then
Lefts[i] := Min(Lefts[i], W - 4 - OWs[i])
else
Lefts[i] := Min(Lefts[i], Lefts[i + 1] - GAPX - OWs[i]);
// 5. Применить (зажать в поле), инвалидировать при реальном сдвиге.
Moved := False;
for i := 0 to n - 1 do
begin
Lefts[i] := Max(4, Lefts[i]);
if (Ovls[i].Left <> Lefts[i]) or (Ovls[i].Top <> FLAG_TOP) then
begin
Ovls[i].Left := Lefts[i];
Ovls[i].Top := FLAG_TOP;
Moved := True;
end;
end;
if Moved and Assigned(FOnFlagsInvalidate) then FOnFlagsInvalidate(Self);
end;
// Флаг главного приёмника (слайс A) виден, когда СКРЫТА левая панель хозяина
// (MainFlagPinned) ЛИБО есть доп. слайсы (B+): тогда A всегда представлен
// флагом рядом с B/C…, а сворачивание/раскрытие панели при живых слайсах не
// дёргает его появление.
procedure TPanafallPanel.UpdateMainFlagVisibility;
var
ShouldShow: Boolean;
begin
if (FMainFlag = nil) or (FController = nil) then Exit;
ShouldShow := FMainFlagPinned or (Length(FSliceFlags) > 0);
if ShouldShow = FMainFlag.Visible then Exit;
if ShouldShow then
begin
FMainFlag.Width := OVL_W;
FMainFlag.Height := FMainFlag.BaseHeight; // растёт сам при открытии fly-out
FMainFlag.SetState(FController.FMode, FController.FFilterBW, FController.FVfoA, FController.FLastSMeter);
FMainFlag.SetDSPState(FController.FNRMode, FController.FNBMode, FController.FSNB, FController.FANF, FController.FAGCMode);
FMainFlag.SetSquelchState(FController.FFMSQOn, FController.FFMSQLevel);
FMainFlag.Visible := True;
PushMainFlagExtState;
PushMainFlagAudioDevices;
LayoutFlags;
end
else
begin
FMainFlag.HandleMouseLeave;
FMainFlag.Visible := False;
end;
end;
// Заливает во флаг слайса его текущее состояние из контроллера.
procedure TPanafallPanel.PushSliceFlagState(SliceId: Integer);
var
O: TVfoOverlay;
S: TCtrlSlice;
BW, Cnt, I: Integer;
Names: TStringList;
Indices: array[0..63] of Integer;
Idx: array of Integer;
begin
O := FindSliceFlag(SliceId);
if (O = nil) or (FController = nil) or not FController.GetSlice(SliceId, S) then Exit;
case S.Mode of
MODE_LSB, MODE_DIGL: BW := -S.FilterLo;
MODE_USB, MODE_DIGU: BW := S.FilterHi;
else BW := S.FilterHi - S.FilterLo;
end;
O.SetState(S.Mode, BW, S.TargetHz, FController.SliceSMeter(SliceId));
O.SetDSPState(0, 0, False, False, FController.FAGCMode);
O.SetSquelchState(S.FMSQOn, S.FMSQLevel);
O.SetExtState(Round(S.Volume * 100), S.Muted, False, False, False);
// Список аудио-устройств (общий PA-список) + текущее устройство слайса.
if Assigned(FController.FAudioOut) then
begin
Names := TStringList.Create;
try
Cnt := 0;
FController.FAudioOut.EnumOutputDevices(Names, Indices, Cnt);
SetLength(Idx, Cnt);
for I := 0 to Cnt - 1 do Idx[I] := Indices[I];
O.SetAudioDevices(Names, Idx, S.DevName);
finally
Names.Free;
end;
end;
end;
procedure TPanafallPanel.PushAllSliceFlagStates;
var i: Integer;
begin
for i := 0 to High(FSliceFlags) do
if FSliceFlags[i] <> nil then PushSliceFlagState(FSliceFlags[i].SliceId);
end;
procedure TPanafallPanel.PushMainFlagExtState;
begin
if not (Assigned(FMainFlag) and FMainFlag.Visible) or (FController = nil) then Exit;
// TxSel: этот слайс выбран для передачи. Пока TX только главный → всегда True.
FMainFlag.SetExtState(FController.ActiveVolume, FController.FMuted,
FController.FSplitTxB, FController.FTransmitting, True);
end;
procedure TPanafallPanel.PushMainFlagAudioDevices;
var
Names: TStringList;
Indices: array[0..63] of Integer;
Cnt, I: Integer;
Idx: array of Integer;
begin
if (FMainFlag = nil) or (FController = nil) or
not Assigned(FController.FAudioOut) then Exit;
Names := TStringList.Create;
try
Cnt := 0;
FController.FAudioOut.EnumOutputDevices(Names, Indices, Cnt);
SetLength(Idx, Cnt);
for I := 0 to Cnt - 1 do Idx[I] := Indices[I];
FMainFlag.SetAudioDevices(Names, Idx, FController.FAudioOutDevName);
finally
Names.Free;
end;
end;
// Тик (~частота FSpectrumTimer хозяина): метр/частота главного флага, позиции
// всех флагов, троттленный S-метр слайсов.
procedure TPanafallPanel.TickFlags;
var I: Integer;
begin
if FController = nil then Exit;
if Assigned(FMainFlag) and FMainFlag.Visible then
begin
FMainFlag.UpdateSMeter(FController.FLastSMeter);
FMainFlag.UpdateVfo(FController.FVfoA);
PushMainFlagExtState;
LayoutFlags;
end;
if Length(FSliceFlags) > 0 then
begin
LayoutFlags; // держим слайс-флаги на частоте
// S-метр слайсов троттлим до ~10 Гц: каждое изменение метра = софтовый
// ре-рендер флага (дорого), 60 Гц там не нужно.
if GetTickCount64 - FLastSliceMeterMs >= 100 then
begin
FLastSliceMeterMs := GetTickCount64;
for I := 0 to High(FSliceFlags) do // S-метр каждого слайса из его канала
if FSliceFlags[I] <> nil then
FSliceFlags[I].UpdateSMeter(FController.SliceSMeter(FSliceFlags[I].SliceId));
end;
end;
end;
procedure TPanafallPanel.SetFlagsTheme(const T: TAppTheme);
var i: Integer;
begin
if Assigned(FMainFlag) then FMainFlag.SetTheme(T);
for i := 0 to High(FSliceFlags) do
if Assigned(FSliceFlags[i]) then FSliceFlags[i].SetTheme(T);
end;
// ---- Диспетчер мыши флагов: FActiveFlag выставляется на время Handle*, чтобы
// события флага (синхронные) роутились по CurSliceId. ----
function TPanafallPanel.DispatchFlagsMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
var i: Integer;
begin
Result := False;
if Assigned(FMainFlag) and FMainFlag.Visible then
begin
FActiveFlag := FMainFlag;
if FMainFlag.HandleMouseDown(Button, X, Y) then Exit(True);
end;
for i := 0 to High(FSliceFlags) do
if (FSliceFlags[i] <> nil) and FSliceFlags[i].Visible then
begin
FActiveFlag := FSliceFlags[i];
if FSliceFlags[i].HandleMouseDown(Button, X, Y) then Exit(True);
end;
FActiveFlag := nil;
end;
procedure TPanafallPanel.DispatchFlagsMouseMove(X, Y: Integer);
var i: Integer;
begin
if Assigned(FMainFlag) then
begin
FActiveFlag := FMainFlag;
FMainFlag.HandleMouseMove(X, Y);
end;
for i := 0 to High(FSliceFlags) do
if FSliceFlags[i] <> nil then
begin
FActiveFlag := FSliceFlags[i];
FSliceFlags[i].HandleMouseMove(X, Y);
end;
FActiveFlag := nil;
end;
function TPanafallPanel.DispatchFlagsMouseUp(X, Y: Integer): Boolean;
var i: Integer;
begin
Result := False;
if Assigned(FMainFlag) then
begin
FActiveFlag := FMainFlag;
if FMainFlag.HandleMouseUp(X, Y) then Result := True;
end;
for i := 0 to High(FSliceFlags) do
if FSliceFlags[i] <> nil then
begin
FActiveFlag := FSliceFlags[i];
if FSliceFlags[i].HandleMouseUp(X, Y) then Result := True;
end;
FActiveFlag := nil;
end;
procedure TPanafallPanel.DispatchFlagsMouseLeave;
var i: Integer;
begin
if Assigned(FMainFlag) then FMainFlag.HandleMouseLeave;
for i := 0 to High(FSliceFlags) do
if FSliceFlags[i] <> nil then FSliceFlags[i].HandleMouseLeave;
end;
end.