refactor(slices): этап 3.0A — панадаптер выделен в TPanafallPanel

PanafallPanel.pas: view (CPU/GL), контролы стека (спектр/линейка/сплиттер/
водопад/пан-зум/кнопки зума), геометрия Layout, drag сплиттера и мышь
пан/зум-полосы. MainForm работает через алиасы (FSpecView/PbSpectrum/… =
FPan.*), размеры областей — FPan.SpectrumWidth/SpectrumHeight/WaterfallHeight.
Семантика мыши/флаги/тик пока в MainForm (фаза B). GL-аудит per-instance
пройден (глобальных GL-ресурсов нет). План: doc/SLICES_PLAN.md.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
2026-07-10 22:41:32 +03:00
co-authored by Claude Fable 5
parent cdbdfec792
commit c125e5978e
3 changed files with 905 additions and 608 deletions
+518
View File
@@ -0,0 +1,518 @@
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, сплиттер).
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, Math, Controls, ExtCtrls, Graphics, Forms,
LCLIntf, LCLType,
OpenGLContextEx,
SpectrumView, SpectrumViewOpengl, PanZoomBar, FlatButton;
type
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;
FOnSplitterMoved: TNotifyEvent;
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(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;
constructor Create(AOwner: TComponent; AUseOpenGL: Boolean); reintroduce;
destructor Destroy; override;
// Создаёт контролы в AParent и подвешивает обработчики (см. поля выше).
procedure Build(AParent: TWinControl; AMSAA: Integer);
// Полная раскладка стека. ATopOffset — высота wideband-блока хозяина
// над спектром. Show-флаги приходят от контроллера (FShowSpectrum/
// FShowWaterfall).
procedure Layout(ATopOffset: Integer; AShowSpectrum, AShowWaterfall: Boolean);
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;
// Пользователь отпустил сплиттер (ratio уже обновлён) — хозяин делает
// полный пересчёт (у него wideband/S-метр/оверлеи).
property OnSplitterMoved: TNotifyEvent read FOnSplitterMoved write FOnSplitterMoved;
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;
end;
destructor TPanafallPanel.Destroy;
begin
// Порядок как в прежнем FormDestroy: view/зум-бар первыми, контролы
// (Owner=Self) освободит inherited.
FreeAndNil(FZoomBar);
FreeAndNil(FView);
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;
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;
// ---- Панель пана/зума под водопадом ----
// Кнопки создаём с дефолтными цветами; финальная тема — у хозяина
// (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);
end;
procedure TPanafallPanel.PositionPanZoomBar(BottomY, RW, H: Integer;
AVisible: Boolean);
var BtnW, Gap, StripW, X: Integer;
begin
if (FPbPanZoom = nil) or (FBtnZoomIn = nil) then Exit;
FPbPanZoom.Visible := AVisible;
FBtnZoomIn.Visible := AVisible;
FBtnZoomDef.Visible := AVisible;
FBtnZoomOut.Visible := AVisible;
if not AVisible then Exit;
Gap := MulDiv(2, Screen.PixelsPerInch, 96);
BtnW := H; // квадратные кнопки в высоту строки
StripW := RW - 3 * BtnW - 4 * Gap;
if StripW < 20 then StripW := 20;
FPbPanZoom.SetBounds(0, BottomY, StripW, H);
X := 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);
FPbPanZoom.Invalidate;
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: Integer;
AvailH: Integer;
RULER_H: Integer;
PANZOOM_H: Integer;
ShowPZ: Boolean;
begin
if (FParent = nil) or (FPbSpectrum = nil) then Exit;
FShowSpectrum := AShowSpectrum;
FShowWaterfall := AShowWaterfall;
RULER_H := MulDiv(18, Screen.PixelsPerInch, 96);
RW := FParent.ClientWidth;
RH := FParent.ClientHeight;
// Резервируем низ под панель пана/зума (видна, если виден спектр или водопад).
PANZOOM_H := MulDiv(22, Screen.PixelsPerInch, 96);
ShowPZ := AShowSpectrum or AShowWaterfall;
PositionPanZoomBar(RH - PANZOOM_H, RW, PANZOOM_H, ShowPZ);
if ShowPZ then RH := RH - PANZOOM_H;
TopOff := ATopOffset;
// ---- Оба скрыты ----
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(0, TopOff, RW, SH);
FPbSpectrum.Visible := True;
FPbRuler.SetBounds(0, 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(0, TopOff, RW, WH);
FPbWaterfall.Visible := True;
FPbRuler.SetBounds(0, 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;
// Ограничиваем соотношение, чтобы каждая зона имела минимальный размер
if FSplitterRatio < MIN_SH / AvailH then
FSplitterRatio := MIN_SH / AvailH;
if FSplitterRatio > 1.0 - MIN_WH / AvailH then
FSplitterRatio := 1.0 - MIN_WH / AvailH;
SH := Round(AvailH * FSplitterRatio);
WH := AvailH - SH;
if WH < MIN_WH then WH := MIN_WH;
// Спектр
FPbSpectrum.SetBounds(0, TopOff, RW, SH);
// Линейка частот — всегда прижата к низу спектра
FPbRuler.SetBounds(0, TopOff + SH, RW, RULER_H);
// Сплиттер — между линейкой и водопадом
FSplitter.SetBounds(0, TopOff + SH + RULER_H, RW, SPLITTER_H);
// Водопад — под сплиттером
FPbWaterfall.SetBounds(0, 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;
P := FParent.ScreenToClient(FSplitter.ClientToScreen(Point(X, Y)));
DeltaY := P.Y - FSplitterDragY0;
TopOff := 0;
// Низ зарезервирован под панель пана/зума (она видна, пока виден водопад).
AvailH := FParent.ClientHeight - TopOff - RULER_H - SPLITTER_H
- MulDiv(22, Screen.PixelsPerInch, 96);
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;
// Только двигаем сплиттер визуально — без пересчёта битмапов
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;
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;
FSplitterDrag := False;
{$IFDEF WINDOWS}
ReleaseCapture;
{$ENDIF}
FSplitter.Color := TColor($00303030); // обычный цвет
P := FParent.ScreenToClient(FSplitter.ClientToScreen(Point(X, Y)));
DeltaY := P.Y - FSplitterDragY0;
TopOff := 0;
// Низ зарезервирован под панель пана/зума (она видна, пока виден водопад).
AvailH := FParent.ClientHeight - TopOff - RULER_H - SPLITTER_H
- MulDiv(22, Screen.PixelsPerInch, 96);
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;
end.