mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 17:27:32 +00:00
Селекторы диапазона/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>
375 lines
13 KiB
ObjectPascal
375 lines
13 KiB
ObjectPascal
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.
|