Files
ewsdr/PanDisplayPopup.pas
ew8bakandClaude Opus 4.8 9bb86b59b8 feat(slices): кастомные тематизированные popup-меню панов + фиксы позиционирования
Селекторы диапазона/samplerate панов N переведены с нативного TPopupMenu на
своё меню в стиле приложения (одинаково на всех платформах, в цветовой теме).

- FlatPopupMenu.pas (new): TFlatPopupMenu — owner-draw меню как ДОЧЕРНИЙ контрол
  формы (не top-level окно: Wayland центрирует свои top-level окна). Hover,
  галка текущего, клавиатура (↑↓/Enter/Esc), закрытие по клику-вне (MouseCapture)
  и потере фокуса. Позиционируется под лейблом-якорем в клиентских координатах.
- PanDisplayPopup: поповер «◑» тоже переведён с top-level формы на дочерний
  контрол (центрировался на Wayland) — открывается под кнопкой, закрытие «×»
  или повторным «◑».
- MainForm: band/rate-селекторы на FlatPopupMenu; свёртка повторяющегося
  выбора темы (9 инлайнов) в CurrentAppTheme.
- PanafallPanel: курсор-«палец» кликабельных лейблов шапки переприменяется в
  конце Build (флаги *Clickable могли выставляться до создания лейблов —
  samplerate-лейбл не получал crHandPoint).

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-07-13 15:02:08 +03:00

375 lines
13 KiB
ObjectPascal
Raw Permalink 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 PanDisplayPopup;
{
TPanDisplayPopup — компактный поповер per-pan настроек отображения
(палитра / gamma / уровни спектра и водопада), открывается кнопкой «◑» в
шапке пана. Правки применяются к P.View живьём; после каждой изменения зовётся
OnApplied(P) — хозяин (MainForm) инвалидирует пан, ставит override-флаг и
зеркалит глобальные (для пана 0). Кнопки «Сброс к дефолту» / «Применить ко
всем» — через OnResetDefault / OnApplyAll.
Реализован как ДОЧЕРНИЙ контрол верхнеуровневой формы (не отдельное окно):
Wayland не даёт клиенту позиционировать свои top-level окна — они
центрируются компоновщиком. Дочерний контрол позиционируется в клиентских
координатах под кнопкой «◑». Закрытие — крестиком «×» или повторным «◑».
Этап 3.6 плана мультислайсов (doc/SLICES_PLAN.md), per-pan дисплей.
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, Math, Types, Controls, ExtCtrls, StdCtrls, Graphics, Forms,
AppTheme, PanafallPanel,
FlatButton, FlatComboBox, FlatCheckBox, FlatSpinEdit, FlatFloatSpinEdit;
type
TPanDisplayEvent = procedure(P: TPanafallPanel) of object;
// FullRefresh=True ⇒ смена палитры/gamma/авто: чистим историю водопада.
TPanDisplayApplyEvent = procedure(P: TPanafallPanel; FullRefresh: Boolean) of object;
TPanDisplayPopup = class(TCustomControl)
private
FPan: TPanafallPanel; // пан, чьи настройки правим (не владеем)
FLoading: Boolean; // подавляет OnApplied при программной заливке
FBg: TPanel;
FTitle: TLabel;
FCbPalette: TFlatComboBox;
FSeGamma: TFlatFloatSpinEdit;
FSeRef: TFlatSpinEdit;
FSeRange: TFlatSpinEdit;
FChkAuto: TFlatCheckBox;
FSeOffset: TFlatSpinEdit;
FSeMin: TFlatSpinEdit;
FSeMax: TFlatSpinEdit;
FLbOffset: TLabel;
FLbMin: TLabel;
FLbMax: TLabel;
FHint: TLabel;
FBtnClose: TFlatButton;
FBtnReset: TFlatButton;
FBtnAll: TFlatButton;
FOnApplied: TPanDisplayApplyEvent;
FOnResetDefault: TPanDisplayEvent;
FOnApplyAll: TPanDisplayEvent;
function MakeLbl(const Cap: string; ALeft, ATop, AW: Integer): TLabel;
procedure Apply(FullRefresh: Boolean);
procedure CtlChange(Sender: TObject);
procedure PaletteChange(Sender: TObject);
procedure AutoChange(Sender: TObject);
procedure CloseClick(Sender: TObject);
procedure ResetClick(Sender: TObject);
procedure AllClick(Sender: TObject);
procedure UpdateWfRowEnable;
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
procedure LoadFrom(P: TPanafallPanel);
// Показать под контролом-якорем (кнопкой «◑») как дочерний контрол формы.
procedure PopupBelow(P: TPanafallPanel; Anchor: TControl);
property OnApplied: TPanDisplayApplyEvent read FOnApplied write FOnApplied;
property OnResetDefault: TPanDisplayEvent read FOnResetDefault write FOnResetDefault;
property OnApplyAll: TPanDisplayEvent read FOnApplyAll write FOnApplyAll;
end;
implementation
const
{$IFDEF WINDOWS}
UI_FONT = 'Segoe UI';
{$ELSE}
UI_FONT = 'Sans';
{$ENDIF}
CLR_BG = TColor($00303030); // рамка (1px кайма формы)
CLR_PANEL = TColor($001A1A1A);
CLR_TEXT = TColor($00E0E0E0);
CLR_TEXTDIM = TColor($00888888);
CLR_ACCENT = TColor($0040FF80);
CLR_INPUT = TColor($00FFFFFF);
CLR_INPUT_TEXT = TColor($00202020);
POP_W = 244;
PAD = 10;
LBLW = 66;
CTLX = 84;
ROWH = 24;
WF_PALETTE_NAMES: array[0..2] of string = ('Classic', 'Inferno', 'Turbo');
constructor TPanDisplayPopup.Create(AOwner: TComponent);
var
Y: Integer;
function NextRow: Integer;
begin
Result := Y;
Inc(Y, ROWH + 4);
end;
function MakeIntSpin(ATop, AMin, AMax, AInc: Integer): TFlatSpinEdit;
begin
Result := TFlatSpinEdit.Create(Self);
Result.Parent := FBg;
Result.SetBounds(CTLX, ATop, POP_W - CTLX - PAD, ROWH - 2);
Result.MinValue := AMin;
Result.MaxValue := AMax;
Result.Increment := AInc;
Result.Color := CLR_INPUT;
Result.Font.Color := CLR_INPUT_TEXT;
Result.Font.Name := UI_FONT;
Result.Font.Size := 9;
Result.OnChange := CtlChange;
end;
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
Visible := False;
Color := CLR_BG;
Font.Name := UI_FONT;
Font.Size := 9;
Font.Color := CLR_TEXT;
FLoading := False;
FBg := TPanel.Create(Self);
FBg.Parent := Self;
FBg.BevelOuter := bvNone;
FBg.Color := CLR_PANEL;
// 1px рамка = зазор до края формы (цвет формы = CLR_BG).
FBg.SetBounds(1, 1, POP_W - 2, 10);
Y := PAD;
FTitle := MakeLbl('Display', PAD, NextRow + 2, POP_W - 2 * PAD - 18);
FTitle.Font.Color := CLR_ACCENT;
FTitle.Font.Style := [fsBold];
// Крестик закрытия в правом верхнем углу («готово» — правки сохраняются сами).
FBtnClose := MakeFlatBtn(FBg, '×', POP_W - PAD - 16, PAD, 16, 16, CloseClick);
FBtnClose.ClrText := CLR_TEXTDIM;
FBtnClose.ClrTextAct := CLR_TEXT;
// Хинты на кнопках поповера отключены: THintWindow в этой borderless-форме
// позиционирует подсказку не у элемента (у левой панели). Лейблы и так ясны.
// ---- Палитра ----
MakeLbl('Palette', PAD, Y + 3, LBLW);
FCbPalette := TFlatComboBox.Create(Self);
FCbPalette.Parent := FBg;
FCbPalette.SetBounds(CTLX, Y, POP_W - CTLX - PAD, ROWH - 2);
FCbPalette.Items.Add(WF_PALETTE_NAMES[0]);
FCbPalette.Items.Add(WF_PALETTE_NAMES[1]);
FCbPalette.Items.Add(WF_PALETTE_NAMES[2]);
FCbPalette.Color := CLR_INPUT;
FCbPalette.Font.Color := CLR_INPUT_TEXT;
FCbPalette.Font.Name := UI_FONT;
FCbPalette.Font.Size := 9;
FCbPalette.OnChange := PaletteChange; // смена палитры чистит историю водопада
NextRow;
// ---- Gamma ----
MakeLbl('Gamma', PAD, Y + 3, LBLW);
FSeGamma := TFlatFloatSpinEdit.Create(Self);
FSeGamma.Parent := FBg;
FSeGamma.SetBounds(CTLX, Y, POP_W - CTLX - PAD, ROWH - 2);
FSeGamma.MinValue := 0.30;
FSeGamma.MaxValue := 3.00;
FSeGamma.Increment := 0.05;
FSeGamma.DecimalPlaces := 2;
FSeGamma.Color := CLR_INPUT;
FSeGamma.Font.Color := CLR_INPUT_TEXT;
FSeGamma.Font.Name := UI_FONT;
FSeGamma.Font.Size := 9;
// gamma — непрерывный спин: чистить историю на каждый тик = мерцание;
// применяем к новым строкам (как ref/range), без сброса водопада.
FSeGamma.OnChange := CtlChange;
NextRow;
MakeLbl('— Spectrum —', PAD, Y + 3, POP_W - 2 * PAD).Font.Color := CLR_TEXTDIM;
NextRow;
// ---- Ref level / Range ----
MakeLbl('Ref, dBm', PAD, Y + 3, LBLW);
FSeRef := MakeIntSpin(Y, -200, 30, 5);
NextRow;
MakeLbl('Range, dB', PAD, Y + 3, LBLW);
FSeRange := MakeIntSpin(Y, 20, 200, 5);
NextRow;
MakeLbl('— Waterfall —', PAD, Y + 3, POP_W - 2 * PAD).Font.Color := CLR_TEXTDIM;
NextRow;
// ---- Авто-уровень водопада ----
FChkAuto := TFlatCheckBox.Create(Self);
FChkAuto.Parent := FBg;
FChkAuto.SetBounds(PAD, Y + 2, POP_W - 2 * PAD, ROWH - 4);
FChkAuto.Caption := 'Auto level';
FChkAuto.Font.Color := CLR_TEXT;
FChkAuto.Font.Name := UI_FONT;
FChkAuto.Font.Size := 9;
FChkAuto.OnChange := AutoChange;
NextRow;
FLbOffset := MakeLbl('Offset, dB', PAD, Y + 3, LBLW);
FSeOffset := MakeIntSpin(Y, -60, 60, 1);
NextRow;
FLbMin := MakeLbl('Min, dBm', PAD, Y + 3, LBLW);
FSeMin := MakeIntSpin(Y, -200, 0, 5);
NextRow;
FLbMax := MakeLbl('Max, dBm', PAD, Y + 3, LBLW);
FSeMax := MakeIntSpin(Y, -160, 30, 5);
NextRow;
// ---- Подсказка: правки применяются и сохраняются сами (не нужно «сохранять») ----
FHint := MakeLbl('Changes apply & save automatically', PAD, Y + 2, POP_W - 2 * PAD);
FHint.Font.Color := CLR_TEXTDIM;
Inc(Y, 18);
// ---- Кнопки действий (обе — вторичные, не «сохранение») ----
FBtnReset := MakeFlatBtn(FBg, '⟳ Reset', PAD, Y, (POP_W - 3 * PAD) div 2, ROWH, ResetClick);
FBtnReset.ClrText := CLR_TEXT;
FBtnReset.ClrTextAct := CLR_ACCENT;
FBtnAll := MakeFlatBtn(FBg, '⇄ Copy to all',
PAD + (POP_W - 3 * PAD) div 2 + PAD, Y, (POP_W - 3 * PAD) div 2, ROWH, AllClick);
FBtnAll.ClrText := CLR_TEXT;
FBtnAll.ClrTextAct := CLR_ACCENT;
Inc(Y, ROWH + PAD);
FBg.Height := Y - 1;
Width := POP_W;
Height := Y + 1;
end;
procedure TPanDisplayPopup.Paint;
begin
// 1px рамка вокруг FBg (FBg = CLR_PANEL перекрывает нутро).
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := CLR_BG;
Canvas.Pen.Style := psClear;
Canvas.FillRect(0, 0, Width, Height);
end;
function TPanDisplayPopup.MakeLbl(const Cap: string; ALeft, ATop, AW: Integer): TLabel;
begin
Result := TLabel.Create(Self);
Result.Parent := FBg;
Result.Caption := Cap;
Result.Left := ALeft;
Result.Top := ATop;
if AW > 0 then Result.Width := AW;
Result.Font.Color := CLR_TEXT;
Result.Font.Name := UI_FONT;
Result.Font.Size := 9;
end;
procedure TPanDisplayPopup.UpdateWfRowEnable;
var Man: Boolean;
begin
Man := not FChkAuto.Checked;
FLbOffset.Enabled := not Man; FSeOffset.Enabled := not Man;
FLbMin.Enabled := Man; FSeMin.Enabled := Man;
FLbMax.Enabled := Man; FSeMax.Enabled := Man;
end;
procedure TPanDisplayPopup.LoadFrom(P: TPanafallPanel);
begin
FPan := P;
if P = nil then Exit;
FLoading := True;
try
if P.PanId = 0 then FTitle.Caption := 'Display · PAN 0'
else FTitle.Caption := Format('Display · PAN %d', [P.PanId]);
FCbPalette.ItemIndex := EnsureRange(P.View.WfPalette, 0, 2);
FSeGamma.Value := EnsureRange(P.View.WfGamma, 0.30, 3.00);
FSeRef.Value := Round(P.View.SpecRefLevel);
FSeRange.Value := Round(P.View.SpecRange);
FChkAuto.Checked := P.View.WfAGCEnabled;
FSeOffset.Value := Round(P.View.WfAGCOffset);
FSeMin.Value := Round(P.View.WfManualLow);
FSeMax.Value := Round(P.View.WfManualHigh);
// Сброс к дефолту осмыслен только для панов N (пан 0 = сам дефолт).
FBtnReset.Visible := P.PanId > 0;
UpdateWfRowEnable;
finally
FLoading := False;
end;
end;
procedure TPanDisplayPopup.Apply(FullRefresh: Boolean);
begin
if FLoading or (FPan = nil) then Exit;
FPan.View.WfPalette := FCbPalette.ItemIndex;
FPan.View.WfGamma := FSeGamma.Value;
FPan.View.SpecRefLevel := FSeRef.Value;
FPan.View.SpecRange := FSeRange.Value;
FPan.View.WfAGCEnabled := FChkAuto.Checked;
FPan.View.WfAGCOffset := FSeOffset.Value;
FPan.View.WfManualLow := FSeMin.Value;
FPan.View.WfManualHigh := FSeMax.Value;
if Assigned(FOnApplied) then FOnApplied(FPan, FullRefresh);
end;
procedure TPanDisplayPopup.CtlChange(Sender: TObject);
begin
Apply(False); // ref/range/offset/min/max: применяются к новым строкам
end;
procedure TPanDisplayPopup.PaletteChange(Sender: TObject);
begin
Apply(True); // палитра (дискретный выбор): перекрасить весь водопад
end;
procedure TPanDisplayPopup.AutoChange(Sender: TObject);
begin
UpdateWfRowEnable;
Apply(True); // смена режима уровня меняет отображение всей истории
end;
procedure TPanDisplayPopup.CloseClick(Sender: TObject);
begin
Hide;
end;
procedure TPanDisplayPopup.ResetClick(Sender: TObject);
begin
if (FPan = nil) or not Assigned(FOnResetDefault) then Exit;
FOnResetDefault(FPan);
LoadFrom(FPan); // перезалить контролы значениями глобального дефолта
end;
procedure TPanDisplayPopup.AllClick(Sender: TObject);
begin
if (FPan = nil) or not Assigned(FOnApplyAll) then Exit;
FOnApplyAll(FPan);
end;
procedure TPanDisplayPopup.PopupBelow(P: TPanafallPanel; Anchor: TControl);
var
Root: TCustomForm;
L, T: Integer;
Cl: TPoint;
begin
if Anchor = nil then Exit;
Root := GetParentForm(Anchor);
if Root = nil then Exit;
LoadFrom(P);
// Позиция под якорем в КЛИЕНТСКИХ координатах формы (не top-level окно!).
Cl := Root.ScreenToClient(Anchor.ClientToScreen(Point(0, Anchor.Height + 2)));
L := Cl.X;
T := Cl.Y;
if L + Width > Root.ClientWidth then L := Root.ClientWidth - Width;
if L < 0 then L := 0;
if T + Height > Root.ClientHeight then
T := Root.ScreenToClient(Anchor.ClientToScreen(Point(0, 0))).Y - Height; // вверх
if T < 0 then T := 0;
Parent := Root;
SetBounds(L, T, Width, Height);
Visible := True;
BringToFront;
end;
end.