Files
ewsdr/BeaconScopeForm.pas
T
ew8bakandClaude Opus 5 e82f573313 feat(beacon): окно лупы переживает перезапуск
Ширина, положение и состояние FOLLOW уезжали в дефолт при каждом открытии
окна: настроил 5 кГц вокруг маяка, закрыл — в следующий раз снова 40 кГц.

Положение хранится СДВИГОМ от опорной частоты маяка, а не абсолютом. Абсолют
протух бы от любой правки опорной частоты, а главное — калибровка LOError
копится от сеанса к сеансу и двигает шкалу, так что сохранённая абсолютная
частота через неделю указывала бы уже не туда.

- Settings: BeaconZoomSpanHz/OffsetHz/Follow в TGlobalSettings (ключи
  beacon_zoom_span/offset/follow), дефолты и чтение/запись по общему пути.
- RadioController: FBcnZoom* с клампом при загрузке (span 600..200000 Гц,
  сдвиг ±500 кГц) — руками испорченный JSON окно не сломает.
- BeaconScopeForm: RestoreZoomState в DoShow, StoreZoomState каждый тик из
  PollZoom. Раз состояние пишется в одном месте, оно не разъедется, каким бы
  путём ни менялось — колесом, drag'ом, кнопками или автоподтяжкой FOLLOW.
  Наведение декодера за краем восстановленного окна подтянет сам FOLLOW на
  первом тике, отдельной логики не потребовалось.

Сборка ewsdr (--ws=qt6) и ewsdrd — ОК.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
2026-08-14 12:03:13 +03:00

1458 lines
54 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 BeaconScopeForm;
{ TBeaconScopeForm — окно QO-100 beacon-декодера.
Три части сверху вниз:
1. ЛУПА НАВЕДЕНИЯ (BEACON TUNING) — узкий кусок спектра вокруг маяка в
высоком разрешении + мини-водопад. На общей спектрограмме (полоса
захвата 576к и шире) центральный маяк занимает пару пикселей, и ткнуть
в него мышью почти нельзя; здесь то же наведение делается по широкому
следу. Клик = TRadioController.BeaconSeedAtHz, ровно как по главному
спектру — способ навестись со спектрограммы никуда не девался.
Увеличение делает САМ WDSP: у лупы свой analyzer со своим FFT и своим
span-clip (см. TWDSPEngine.SetBeaconZoom), поэтому окно детальное, а не
растянутые бины главного дисплея.
2. Констелляция BPSK + метрики захвата (carrier/symbol lock, SNR, скорость,
снос NCO) — смотровое окно демодулятора.
3. Декодированный бюллетень (кадры AO-40).
Открывается из RX-блока MainForm (ПКМ по BEACON). Данные тянутся из
TRadioController по таймеру (~25 Гц). }
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Math, StrUtils, Types,
Forms, Controls, Graphics, ExtCtrls, StdCtrls,
AppTheme, BeaconDecoder, BeaconFEC, RadioController, DpiUtils, FlatMemo,
FlatButton, WaterfallView;
const
// Потолок точек в кадре лупы (движок отдаёт BCN_ZOOM_PIXELS = 1024).
BCN_MAX_PIX = 4096;
// Границы ширины окна лупы. Ниже 300 Гц смысла нет — маяк BPSK 400 Bd
// занимает ~800 Гц; выше 200 кГц лупа перестаёт быть лупой.
BCN_SPAN_MIN = 600.0;
BCN_SPAN_MAX = 200000.0;
BCN_SPAN_DEF = 40000.0;
BCN_ZOOM_STEP = 1.6;
// Полоса приёма декодера (± от несущей) — та же цифра, что у маркера на
// главном спектре в MainForm.UpdateBeaconButton.
BCN_DEC_BW_HZ = 450.0;
// Цвета маркеров — ровно те же, что на главном спектре
// (SpectrumView.DrawBeaconMarkersRaw / SpectrumViewOpengl.DrawBeaconMarkersGL),
// чтобы лупа и панорама читались как одна картинка.
BCN_CLR_REF = TColor($0000FF00); // clLime — где маяк ДОЛЖЕН быть (пунктир)
BCN_CLR_TRK = TColor($000AA5FF); // отслеживаемый центроид (оранж)
BCN_CLR_DEC = TColor($0020D0FF); // грани полосы приёма + центр наведения
type
TBeaconScopeForm = class(TForm)
private
FCtl: TRadioController;
FHeader: TPanel;
FTitle: TLabel;
FSubtitle: TLabel;
FBox: TPaintBox;
FBulletin: TPanel;
FBulletinTitle: TLabel;
FBulletinHint: TLabel;
FMemo: TFlatMemo; // декодированный текст бюллетеня (AO-40 кадры)
FTimer: TTimer;
FTheme: TAppTheme;
FLastFrames: Int64; // счётчик кадров на прошлом тике (детект нового)
// Констелляция+метрики: кадр в офскрине, статичная обвязка — в отдельном
// кэше (идиома TSpectrumView.FGridBitmap).
FScope: TBitmap;
FScopeChrome: TBitmap;
FChromeW, FChromeH: Integer; // размер, под который собрана обвязка
FScopeValid: Boolean; // в FScope лежит актуальный кадр
// --- Лупа наведения ---
FTune: TPanel; // карточка BEACON TUNING
FTuneTitle: TLabel;
FTuneHint: TLabel;
FSpecBox: TPaintBox; // спектр лупы + линейка частот
FWfBox: TPaintBox; // мини-водопад лупы
FWf: TWaterfallView;
FStrip: TBitmap; // офскрин спектра (без него мигает)
FBtnZoomIn, FBtnZoomOut, FBtnReset, FBtnFollow: TFlatButton;
FCenterHz: Double; // центр окна лупы (display Hz), 0 = ещё не задан
FSpanHz: Double; // ширина окна лупы
FFollow: Boolean; // держать наведение декодера в окне
FViewLo, FViewHi: Double; // фактическое окно последнего кадра (display Hz)
FPix: array[0..BCN_MAX_PIX - 1] of Single;
FPixCount: Integer;
FWfPix: array[0..BCN_MAX_PIX - 1] of Single;
FHaveFrame: Boolean;
FSpecLo, FSpecHi: Double; // сглаженные границы шкалы дБ
// Рендер как во всей программе: кадр собирается в офскрин ТОЛЬКО когда есть
// что перерисовывать (FZoomDirty), а OnPaint лишь блитит битмап и кладёт
// сверху курсор. Иначе expose-события и движения мыши гоняли бы полную
// сборку кадра.
FZoomDirty: Boolean;
FStripValid: Boolean; // в FStrip лежит кадр под текущий размер
FLastRefHz, FLastTrkHz, FLastDecHz: Double; // детект сдвига маркеров
FCursorX: Integer; // -1 = курсор вне лупы
FDragging: Boolean; // ЛКМ зажата в лупе
FDragMoved: Boolean; // увели мышь → это панорамирование, не клик
FDragX: Integer;
FDragCenter: Double;
procedure DoTick(Sender: TObject);
procedure ScopeLayout(W, H: Integer; out GraphR, MetricsR, PlotR: TRect;
out cx, cy, r: Integer; out Wide: Boolean);
function MetricTileRect(const MetricsR: TRect; Wide: Boolean;
n: Integer): TRect;
procedure BuildScopeChrome(W, H: Integer); // статичная обвязка в кэш
procedure DrawScope; // кадр констелляции в офскрин
procedure DoPaint(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure PollFrame;
function FrameToText(const Frame: TBeaconFrame): string;
// --- Лупа ---
procedure BuildTunePanel;
procedure LayoutTunePanel;
procedure PollZoom; // забрать кадр лупы у контроллера
procedure ClampWindow; // окно не вылезает из полосы захвата
procedure RestoreZoomState; // окно лупы из настроек
procedure StoreZoomState; // окно лупы в настройки
function DefaultCenterHz: Double; // куда смотреть, пока не выбрали
function XToFreq(X, W: Integer): Double;
function FreqToX(F: Double; W: Integer): Integer;
procedure ZoomBy(Factor: Double; AnchorX, W: Integer);
procedure DrawZoomStrip; // сборка кадра лупы в офскрин
procedure PaintSpec(Sender: TObject);
procedure PaintWf(Sender: TObject);
procedure SpecMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SpecMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure SpecMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SpecMouseLeave(Sender: TObject);
procedure SpecWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure SpecDblClick(Sender: TObject);
procedure BtnZoomInClick(Sender: TObject);
procedure BtnZoomOutClick(Sender: TObject);
procedure BtnResetClick(Sender: TObject);
procedure BtnFollowClick(Sender: TObject);
procedure StyleTuneButtons;
protected
procedure DoShow; override;
procedure DoHide; override;
public
constructor CreateWith(AOwner: TComponent; ACtl: TRadioController);
destructor Destroy; override;
procedure ApplyTheme(const T: TAppTheme);
end;
implementation
constructor TBeaconScopeForm.CreateWith(AOwner: TComponent; ACtl: TRadioController);
var
WorkArea: TRect;
MaxW, MaxH: Integer;
begin
inherited CreateNew(AOwner);
FCtl := ACtl;
FTheme := DarkTheme;
// Геометрия формы задаётся ниже уже в DPI-aware координатах.
Scaled := False;
Caption := 'QO-100 Beacon';
BorderStyle := bsSizeable;
if AOwner is TCustomForm then
begin
WorkArea := TCustomForm(AOwner).BoundsRect;
WorkArea := Screen.MonitorFromRect(WorkArea).WorkareaRect;
Position := poOwnerFormCenter;
end
else
begin
WorkArea := Screen.PrimaryMonitor.WorkareaRect;
Position := poScreenCenter;
end;
MaxW := WorkArea.Right - WorkArea.Left - DpiScale(48);
MaxH := WorkArea.Bottom - WorkArea.Top - DpiScale(48);
Width := Min(DpiScale(820), MaxW);
Height := Min(DpiScale(940), MaxH);
Constraints.MinWidth := Min(DpiScale(560), Width);
Constraints.MinHeight := Min(DpiScale(700), Height);
Color := FTheme.BG;
FCenterHz := 0.0; // задастся первым тиком (DefaultCenterHz)
FSpanHz := BCN_SPAN_DEF;
FFollow := True;
FCursorX := -1;
FSpecLo := -130.0;
FSpecHi := -60.0;
FHeader := TPanel.Create(Self);
FHeader.Parent := Self;
FHeader.Align := alTop;
FHeader.Height := DpiScale(72);
FHeader.BevelOuter := bvNone;
FHeader.Color := FTheme.Panel;
FTitle := TLabel.Create(Self);
FTitle.Parent := FHeader;
FTitle.Caption := 'QO-100 BEACON DECODER';
FTitle.AutoSize := False;
FTitle.SetBounds(DpiScale(20), DpiScale(12),
DpiScale(520), DpiScale(26));
FTitle.Font.Size := 15;
FTitle.Font.Style := [fsBold];
FTitle.Font.Color := FTheme.Text;
FSubtitle := TLabel.Create(Self);
FSubtitle.Parent := FHeader;
FSubtitle.Caption :=
'Zoomed tuning window, BPSK constellation and AO-40 telemetry';
FSubtitle.AutoSize := False;
FSubtitle.SetBounds(DpiScale(20), DpiScale(40),
DpiScale(620), DpiScale(20));
FSubtitle.Font.Size := 9;
FSubtitle.Font.Color := FTheme.TextDim;
BuildTunePanel;
FBulletin := TPanel.Create(Self);
FBulletin.Parent := Self;
FBulletin.Align := alBottom;
FBulletin.Height := DpiScale(236);
FBulletin.BevelOuter := bvNone;
FBulletin.Color := FTheme.Panel;
FBulletinTitle := TLabel.Create(Self);
FBulletinTitle.Parent := FBulletin;
FBulletinTitle.Caption := 'DECODED BULLETIN';
FBulletinTitle.AutoSize := False;
FBulletinTitle.SetBounds(DpiScale(16), DpiScale(9),
DpiScale(220), DpiScale(20));
FBulletinTitle.Font.Size := 9;
FBulletinTitle.Font.Style := [fsBold];
FBulletinTitle.Font.Color := FTheme.MeterOn;
FBulletinHint := TLabel.Create(Self);
FBulletinHint.Parent := FBulletin;
FBulletinHint.Caption := 'latest AO-40 frames · read-only';
FBulletinHint.AutoSize := False;
FBulletinHint.SetBounds(DpiScale(250), DpiScale(9),
DpiScale(300), DpiScale(20));
FBulletinHint.Anchors := [akTop, akRight];
FBulletinHint.Left := FBulletin.ClientWidth - DpiScale(316);
FBulletinHint.Alignment := taRightJustify;
FBulletinHint.Font.Size := 8;
FBulletinHint.Font.Color := FTheme.TextDim;
// Бюллетень остаётся обычным read-only memo: текст можно выделить и скопировать.
FMemo := TFlatMemo.Create(Self);
FMemo.Parent := FBulletin;
FMemo.Align := alClient;
FMemo.BorderSpacing.Left := DpiScale(12);
FMemo.BorderSpacing.Top := DpiScale(36);
FMemo.BorderSpacing.Right := DpiScale(12);
FMemo.BorderSpacing.Bottom := DpiScale(12);
FMemo.ReadOnly := True;
FMemo.WordWrap := False;
FMemo.Font.Size := 9;
FMemo.SetAppTheme(FTheme);
FBox := TPaintBox.Create(Self);
FBox.Parent := Self;
FBox.Align := alClient;
FBox.OnPaint := @DoPaint;
FScope := TBitmap.Create;
FScope.PixelFormat := pf32bit;
FScopeChrome := TBitmap.Create;
FScopeChrome.PixelFormat := pf32bit;
FChromeW := 0;
FChromeH := 0;
OnResize := @FormResize;
FormResize(nil);
FTimer := TTimer.Create(Self);
FTimer.Interval := 40; // ~25 Гц
FTimer.OnTimer := @DoTick;
FTimer.Enabled := True;
end;
// ===========================================================================
// Лупа наведения: построение
// ===========================================================================
procedure TBeaconScopeForm.BuildTunePanel;
begin
FTune := TPanel.Create(Self);
FTune.Parent := Self;
FTune.Top := FHeader.Height + 1; // ставим ПОД шапкой до Align (LCL сортирует по Top)
FTune.Align := alTop;
FTune.Height := DpiScale(252);
FTune.BevelOuter := bvNone;
FTune.Color := FTheme.BG;
FTuneTitle := TLabel.Create(Self);
FTuneTitle.Parent := FTune;
FTuneTitle.Caption := 'BEACON TUNING';
FTuneTitle.AutoSize := False;
FTuneTitle.SetBounds(DpiScale(20), DpiScale(10), DpiScale(300), DpiScale(18));
FTuneTitle.Font.Size := 8;
FTuneTitle.Font.Style := [fsBold];
FTuneTitle.Font.Color := FTheme.MeterOn;
FTuneHint := TLabel.Create(Self);
FTuneHint.Parent := FTune;
FTuneHint.Caption := 'click the beacon to point the decoder · wheel zooms · drag pans';
FTuneHint.AutoSize := False;
FTuneHint.SetBounds(DpiScale(120), DpiScale(11), DpiScale(360), DpiScale(16));
FTuneHint.Font.Size := 8;
FTuneHint.Font.Color := FTheme.TextDim;
FBtnFollow := MakeFlatBtn(FTune, 'FOLLOW', 0, 0,
DpiScale(66), DpiScale(22), @BtnFollowClick);
FBtnReset := MakeFlatBtn(FTune, 'RESET', 0, 0,
DpiScale(58), DpiScale(22), @BtnResetClick);
FBtnZoomOut := MakeFlatBtn(FTune, '', 0, 0,
DpiScale(30), DpiScale(22), @BtnZoomOutClick);
FBtnZoomIn := MakeFlatBtn(FTune, '+', 0, 0,
DpiScale(30), DpiScale(22), @BtnZoomInClick);
StyleTuneButtons;
FSpecBox := TPaintBox.Create(Self);
FSpecBox.Parent := FTune;
FSpecBox.OnPaint := @PaintSpec;
FSpecBox.OnMouseDown := @SpecMouseDown;
FSpecBox.OnMouseMove := @SpecMouseMove;
FSpecBox.OnMouseUp := @SpecMouseUp;
FSpecBox.OnMouseLeave := @SpecMouseLeave;
FSpecBox.OnMouseWheel := @SpecWheel;
FSpecBox.OnDblClick := @SpecDblClick;
FSpecBox.Cursor := crCross;
FWfBox := TPaintBox.Create(Self);
FWfBox.Parent := FTune;
FWfBox.OnPaint := @PaintWf;
FWfBox.OnMouseDown := @SpecMouseDown;
FWfBox.OnMouseMove := @SpecMouseMove;
FWfBox.OnMouseUp := @SpecMouseUp;
FWfBox.OnMouseLeave := @SpecMouseLeave;
FWfBox.OnMouseWheel := @SpecWheel;
FWfBox.OnDblClick := @SpecDblClick;
FWfBox.Cursor := crCross;
// Водопад лупы — тот же движок, что у главного окна: своя палитра, свой
// гистограммный AGC. Кадры идут по одному (интервал 1): у лупы окно узкое,
// накапливать max-hold нечего.
FWf := TWaterfallView.Create;
FWf.PbWaterfall := FWfBox;
FWf.WfFrameInterval := 1;
FWf.WfAGCEnabled := True;
FWf.SetTheme(FTheme);
FStrip := TBitmap.Create;
FStrip.PixelFormat := pf32bit;
LayoutTunePanel;
end;
procedure TBeaconScopeForm.StyleTuneButtons;
procedure Style(B: TFlatButton);
begin
if B = nil then Exit;
B.ClrNorm := FTheme.BtnNorm;
B.ClrActive := FTheme.BtnActive;
B.ClrHot := FTheme.BtnHot;
B.ClrBorder := FTheme.BtnBorderNorm;
B.ClrText := FTheme.BtnText;
B.ClrTextAct := FTheme.BtnTextActive;
B.Font.Size := 8;
B.Invalidate;
end;
begin
Style(FBtnZoomIn);
Style(FBtnZoomOut);
Style(FBtnReset);
Style(FBtnFollow);
if FBtnFollow <> nil then FBtnFollow.Active := FFollow;
end;
procedure TBeaconScopeForm.LayoutTunePanel;
// Ряд кнопок справа в строке заголовка, под ним спектр, под ним водопад.
var
W, X, Y, SpecTop, SpecH, WfTop, WfH, Pad: Integer;
begin
if FTune = nil then Exit;
W := FTune.ClientWidth;
Pad := DpiScale(14);
Y := DpiScale(8);
X := W - Pad;
Dec(X, FBtnFollow.Width); FBtnFollow.SetBounds(X, Y, FBtnFollow.Width, FBtnFollow.Height);
Dec(X, DpiScale(6) + FBtnReset.Width);
FBtnReset.SetBounds(X, Y, FBtnReset.Width, FBtnReset.Height);
Dec(X, DpiScale(10) + FBtnZoomIn.Width);
FBtnZoomIn.SetBounds(X, Y, FBtnZoomIn.Width, FBtnZoomIn.Height);
Dec(X, DpiScale(4) + FBtnZoomOut.Width);
FBtnZoomOut.SetBounds(X, Y, FBtnZoomOut.Width, FBtnZoomOut.Height);
FTuneTitle.SetBounds(DpiScale(20), DpiScale(10), DpiScale(96), DpiScale(18));
FTuneHint.SetBounds(DpiScale(122), DpiScale(11),
Max(0, X - DpiScale(132)), DpiScale(16));
SpecTop := DpiScale(36);
WfH := DpiScale(64);
WfTop := FTune.ClientHeight - DpiScale(10) - WfH;
SpecH := Max(DpiScale(60), WfTop - SpecTop - DpiScale(2));
FSpecBox.SetBounds(Pad, SpecTop, Max(DpiScale(40), W - 2 * Pad), SpecH);
FWfBox.SetBounds(Pad, WfTop, Max(DpiScale(40), W - 2 * Pad), WfH);
if FWf <> nil then
FWf.SetWaterfallBitmapSize(FWfBox.Width, FWfBox.Height);
end;
procedure TBeaconScopeForm.ApplyTheme(const T: TAppTheme);
begin
FTheme := T;
Color := T.BG;
if FHeader <> nil then FHeader.Color := T.Panel;
if FTitle <> nil then FTitle.Font.Color := T.Text;
if FSubtitle <> nil then FSubtitle.Font.Color := T.TextDim;
if FBulletin <> nil then FBulletin.Color := T.Panel;
if FBulletinTitle <> nil then FBulletinTitle.Font.Color := T.MeterOn;
if FBulletinHint <> nil then FBulletinHint.Font.Color := T.TextDim;
if FMemo <> nil then
FMemo.SetAppTheme(T);
if FTune <> nil then FTune.Color := T.BG;
if FTuneTitle <> nil then FTuneTitle.Font.Color := T.MeterOn;
if FTuneHint <> nil then FTuneHint.Font.Color := T.TextDim;
StyleTuneButtons;
if FWf <> nil then FWf.SetTheme(T);
FStripValid := False;
FChromeW := 0; // тема поменялась — обвязку пересобрать
FScopeValid := False;
if FSpecBox <> nil then FSpecBox.Invalidate;
if FWfBox <> nil then FWfBox.Invalidate;
if FBox <> nil then FBox.Invalidate;
end;
procedure TBeaconScopeForm.FormResize(Sender: TObject);
var
BulletinH, MaxBulletinH, TuneH: Integer;
begin
TuneH := 0;
if FTune <> nil then TuneH := FTune.Height;
if (FHeader <> nil) and (FBulletin <> nil) then
begin
MaxBulletinH := ClientHeight - FHeader.Height - TuneH - DpiScale(270);
BulletinH := Min(DpiScale(236),
Max(DpiScale(150), MaxBulletinH));
if FBulletin.Height <> BulletinH then
FBulletin.Height := BulletinH;
end;
LayoutTunePanel;
if FTitle <> nil then
FTitle.Width := Max(0, FHeader.ClientWidth - DpiScale(40));
if FSubtitle <> nil then
FSubtitle.Width := Max(0, FHeader.ClientWidth - DpiScale(40));
if FBulletinHint <> nil then
begin
FBulletinHint.Left := DpiScale(250);
FBulletinHint.Width := Max(0,
FBulletin.ClientWidth - DpiScale(266));
end;
FStripValid := False;
FChromeW := 0; // размер поменялся — обвязку пересобрать
FScopeValid := False;
if FBox <> nil then FBox.Invalidate;
end;
procedure TBeaconScopeForm.DoTick(Sender: TObject);
begin
if not Visible then Exit;
PollFrame;
PollZoom;
// Констелляция и метрики обновляются каждый тик по существу — но сборка
// кадра идёт в офскрин из DrawScope, а Paint только копирует.
FScopeValid := False;
if FBox <> nil then FBox.Invalidate;
end;
// ===========================================================================
// Лупа наведения: данные и геометрия окна
// ===========================================================================
function TBeaconScopeForm.DefaultCenterHz: Double;
// Куда смотреть, пока пользователь не выбрал сам: на наведение декодера, если
// оно есть, иначе на измеренную частоту маяка, иначе на опорную (10489.750).
begin
Result := 0;
if FCtl = nil then Exit;
Result := FCtl.BeaconDecodeFreqHz;
if Result > 0 then Exit;
Result := FCtl.BeaconTrackedFreqHz;
if Result > 0 then Exit;
Result := FCtl.BeaconRefHz;
end;
procedure TBeaconScopeForm.ClampWindow;
// Окно лупы живёт внутри полосы захвата: за её краем анализатору нечего резать.
var
CapLo, CapHi, Half: Double;
begin
if FCtl = nil then Exit;
FCtl.GetCaptureWindow(CapLo, CapHi);
if CapHi - CapLo <= 0 then Exit;
FSpanHz := EnsureRange(FSpanHz, BCN_SPAN_MIN, Min(BCN_SPAN_MAX, CapHi - CapLo));
Half := FSpanHz / 2.0;
FCenterHz := EnsureRange(FCenterHz, CapLo + Half, CapHi - Half);
end;
procedure TBeaconScopeForm.RestoreZoomState;
// Окно лупы переживает перезапуск: ширина, положение и FOLLOW лежат в
// глобальных настройках (персист — общий SaveGlobalSettings при выходе).
// Положение хранится сдвигом от опорной частоты маяка, поэтому восстановление
// не зависит от накопленной калибровки LOError.
begin
if FCtl = nil then Exit;
FSpanHz := EnsureRange(FCtl.FBcnZoomSpanHz, BCN_SPAN_MIN, BCN_SPAN_MAX);
FFollow := FCtl.FBcnZoomFollow;
if FCtl.BeaconRefHz > 0 then
FCenterHz := FCtl.BeaconRefHz + FCtl.FBcnZoomOffsetHz
else
FCenterHz := DefaultCenterHz;
if FBtnFollow <> nil then FBtnFollow.Active := FFollow;
ClampWindow;
// Наведение декодера могло остаться за краем восстановленного окна — его
// подтянет FOLLOW на первом же тике (PollZoom), отдельной логики не нужно.
FZoomDirty := True;
FStripValid := False;
end;
procedure TBeaconScopeForm.StoreZoomState;
// Зовётся каждый тик: так последнее состояние окна попадает в настройки, каким
// бы путём оно ни поменялось (колесо, drag, кнопки, авто-подтяжка FOLLOW).
begin
if FCtl = nil then Exit;
FCtl.FBcnZoomSpanHz := FSpanHz;
FCtl.FBcnZoomFollow := FFollow;
if FCtl.BeaconRefHz > 0 then
FCtl.FBcnZoomOffsetHz := FCenterHz - FCtl.BeaconRefHz;
end;
procedure TBeaconScopeForm.PollZoom;
// Раз/тик: держим окно на месте (или тянем за декодером), просим у контроллера
// свежий кадр лупы и отдаём водопаду.
var
Cnt: Integer;
Lo, Hi, Dec_: Double;
GotWf: Boolean;
begin
if FCtl = nil then Exit;
if FCenterHz <= 0 then FCenterHz := DefaultCenterHz;
// FOLLOW не «ведёт» окно постоянно (картинка ездила бы под рукой), а лишь не
// даёт потерять наведение: подтягивает окно, когда маркер ушёл за край.
if FFollow and not FDragging then
begin
Dec_ := FCtl.BeaconDecodeFreqHz;
if (Dec_ > 0) and (Abs(Dec_ - FCenterHz) > FSpanHz * 0.45) then
begin
FCenterHz := Dec_;
FZoomDirty := True;
end;
end;
ClampWindow;
StoreZoomState;
FCtl.SetBeaconZoomWindow(True, FCenterHz, FSpanHz);
// Кадр анализатора приходит реже таймера (BCN_ZOOM_FPS) — пересобираем
// картинку ТОЛЬКО на свежем кадре либо когда переехали маркеры/окно.
// «Несвежий» кадр всё равно забираем: он нужен как последний нарисованный,
// пока анализатор наполняет FFT-окно после переарма.
// Возврат GetBeaconZoomSpectrum = «в кэше был НЕпрочитанный кадр»; это и есть
// главный триггер перерисовки трассы. Границы окна тут не помощник: пока
// никто не панорамирует, они не меняются, а пиксели — каждый кадр.
if FCtl.GetBeaconZoomSpectrum(FPix, Cnt, Lo, Hi) then
FZoomDirty := True;
if Cnt > 0 then
begin
if (Cnt <> FPixCount) or (Abs(Lo - FViewLo) > 0.01)
or (Abs(Hi - FViewHi) > 0.01) then
FZoomDirty := True;
FPixCount := Cnt;
FViewLo := Lo;
FViewHi := Hi;
FHaveFrame := True;
end
else
FPixCount := 0;
if FCtl.BeaconRefHz <> FLastRefHz then FZoomDirty := True;
if FCtl.BeaconTrackedFreqHz <> FLastTrkHz then FZoomDirty := True;
if FCtl.BeaconDecodeFreqHz <> FLastDecHz then FZoomDirty := True;
FLastRefHz := FCtl.BeaconRefHz;
FLastTrkHz := FCtl.BeaconTrackedFreqHz;
FLastDecHz := FCtl.BeaconDecodeFreqHz;
GotWf := FCtl.GetBeaconZoomWaterfall(FWfPix, Cnt);
if GotWf and (Cnt > 0) and (FWf <> nil) then
begin
FWf.CenterFreq := (FViewLo + FViewHi) / 2.0;
FWf.SpanHz := Max(1.0, FViewHi - FViewLo);
FWf.SetWaterfallData(FWfPix, Cnt);
if FWf.WaterfallDirty then
begin
FWf.DrawWaterfall; // новая строка в кольцо — только тогда и рисуем
FWf.WaterfallDirty := False;
if FWfBox <> nil then FWfBox.Invalidate;
end;
end;
if FZoomDirty then
begin
FZoomDirty := False;
FStripValid := False;
if FSpecBox <> nil then FSpecBox.Invalidate; // сборку кадра сделает PaintSpec
end;
end;
function TBeaconScopeForm.XToFreq(X, W: Integer): Double;
var Lo, Hi: Double;
begin
if FHaveFrame then begin Lo := FViewLo; Hi := FViewHi; end
else begin Lo := FCenterHz - FSpanHz / 2; Hi := FCenterHz + FSpanHz / 2; end;
if W <= 1 then Exit(Lo);
Result := Lo + (Hi - Lo) * X / (W - 1);
end;
function TBeaconScopeForm.FreqToX(F: Double; W: Integer): Integer;
var Lo, Hi: Double;
begin
if FHaveFrame then begin Lo := FViewLo; Hi := FViewHi; end
else begin Lo := FCenterHz - FSpanHz / 2; Hi := FCenterHz + FSpanHz / 2; end;
if Hi - Lo <= 0 then Exit(-1);
Result := Round((F - Lo) / (Hi - Lo) * (W - 1));
end;
procedure TBeaconScopeForm.ZoomBy(Factor: Double; AnchorX, W: Integer);
// Зум вокруг точки под курсором: частота под ней остаётся на месте.
var
FAnchor, NewSpan, Frac: Double;
begin
NewSpan := EnsureRange(FSpanHz * Factor, BCN_SPAN_MIN, BCN_SPAN_MAX);
if Abs(NewSpan - FSpanHz) < 1E-6 then Exit;
if (AnchorX >= 0) and (W > 1) then
begin
FAnchor := XToFreq(AnchorX, W);
Frac := AnchorX / (W - 1);
FCenterHz := FAnchor - (Frac - 0.5) * NewSpan;
end;
FSpanHz := NewSpan;
ClampWindow;
FZoomDirty := True;
end;
function TBeaconScopeForm.FrameToText(const Frame: TBeaconFrame): string;
// AO-40 кадр QO-100 = ASCII-текст (space-padded), последние 2 байта = CRC-16.
// Как gr-satellites qo100.parse: отбрасываем CRC, печатные ASCII, строки по 64.
var
i, b: Integer;
line: string;
begin
Result := '';
i := 0;
while i <= 253 do
begin
line := '';
for b := i to Min(i + 63, 253) do
if (Frame[b] >= 32) and (Frame[b] < 127) then line := line + Chr(Frame[b])
else line := line + ' ';
Result := Result + TrimRight(line) + LineEnding;
Inc(i, 64);
end;
end;
// ===========================================================================
// Лупа наведения: мышь и кнопки
// ===========================================================================
procedure TBeaconScopeForm.SpecMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button <> mbLeft then Exit;
FDragging := True;
FDragMoved := False;
FDragX := X;
FDragCenter := FCenterHz;
FCursorX := X;
end;
procedure TBeaconScopeForm.SpecMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
// Тянем с зажатой ЛКМ — панорамируем окно; отпустили не сдвинув — это клик
// наведения (см. SpecMouseUp).
var
W: Integer;
Lo, Hi: Double;
begin
FCursorX := X;
W := TControl(Sender).Width;
if FDragging then
begin
if Abs(X - FDragX) > DpiScale(3) then FDragMoved := True;
if FDragMoved and (W > 1) then
begin
if FHaveFrame then begin Lo := FViewLo; Hi := FViewHi; end
else begin Lo := FCenterHz - FSpanHz / 2; Hi := FCenterHz + FSpanHz / 2; end;
FCenterHz := FDragCenter - (X - FDragX) * (Hi - Lo) / (W - 1);
ClampWindow;
FZoomDirty := True;
end;
end;
if FSpecBox <> nil then FSpecBox.Invalidate;
if FWfBox <> nil then FWfBox.Invalidate;
end;
procedure TBeaconScopeForm.SpecMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
// Клик = навести декодер на эту частоту. Ровно тот же путь, что у клика по
// главному спектру (MainForm.PbSpectrumMouseDown): BeaconSeedAtHz сам включит
// лок, если он был выключен.
var W: Integer;
begin
if Button <> mbLeft then Exit;
W := TControl(Sender).Width;
if FDragging and not FDragMoved and (FCtl <> nil) and (W > 1) then
FCtl.BeaconSeedAtHz(XToFreq(X, W));
FDragging := False;
FDragMoved := False;
end;
procedure TBeaconScopeForm.SpecMouseLeave(Sender: TObject);
begin
FCursorX := -1;
FDragging := False;
if FSpecBox <> nil then FSpecBox.Invalidate;
if FWfBox <> nil then FWfBox.Invalidate;
end;
procedure TBeaconScopeForm.SpecWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
// MousePos у колеса — экранные координаты, поэтому якорь берём из последнего
// MouseMove (FCursorX), он всегда в координатах виджета.
begin
if WheelDelta = 0 then Exit;
if WheelDelta > 0 then
ZoomBy(1.0 / BCN_ZOOM_STEP, FCursorX, TControl(Sender).Width)
else
ZoomBy(BCN_ZOOM_STEP, FCursorX, TControl(Sender).Width);
Handled := True;
if FSpecBox <> nil then FSpecBox.Invalidate;
end;
procedure TBeaconScopeForm.SpecDblClick(Sender: TObject);
// Двойной клик — центрировать окно на точке под курсором.
var W: Integer;
begin
W := TControl(Sender).Width;
if (FCursorX >= 0) and (W > 1) then
begin
FCenterHz := XToFreq(FCursorX, W);
ClampWindow;
FZoomDirty := True;
end;
end;
procedure TBeaconScopeForm.BtnZoomInClick(Sender: TObject);
begin
ZoomBy(1.0 / BCN_ZOOM_STEP, -1, 0);
end;
procedure TBeaconScopeForm.BtnZoomOutClick(Sender: TObject);
begin
ZoomBy(BCN_ZOOM_STEP, -1, 0);
end;
procedure TBeaconScopeForm.BtnResetClick(Sender: TObject);
begin
FSpanHz := BCN_SPAN_DEF;
FCenterHz := DefaultCenterHz;
ClampWindow;
FZoomDirty := True;
end;
procedure TBeaconScopeForm.BtnFollowClick(Sender: TObject);
begin
FFollow := not FFollow;
if FBtnFollow <> nil then FBtnFollow.Active := FFollow;
end;
procedure TBeaconScopeForm.DoShow;
begin
inherited DoShow;
RestoreZoomState;
// Палитра/гамма водопада — те же, что выбраны для главного (настройки живут
// в контроллере), иначе лупа выглядела бы чужой панелью.
if (FWf <> nil) and (FCtl <> nil) then
begin
FWf.WfPalette := FCtl.FWfPalette;
FWf.WfGamma := FCtl.FWfGamma;
end;
LayoutTunePanel;
FZoomDirty := True;
FStripValid := False;
if FTimer <> nil then FTimer.Enabled := True;
end;
procedure TBeaconScopeForm.DoHide;
begin
// Окно закрыли — гасим analyzer лупы: он второй по счёту на том же IQ,
// держать его без зрителя незачем. Таймер тоже стоп: MainForm освобождает
// контроллер раньше, чем эту форму, и тик по мёртвому FCtl был бы фатален.
if FTimer <> nil then FTimer.Enabled := False;
if FCtl <> nil then FCtl.SetBeaconZoomWindow(False, 0, 0);
inherited DoHide;
end;
destructor TBeaconScopeForm.Destroy;
// Контроллер здесь НЕ трогаем: форму владелец (MainForm) освобождает уже после
// своего FormDestroy, где FController освобождён — analyzer лупы к этому моменту
// умер вместе с движком. Гасит лупу DoHide, он же отрабатывает при закрытии окна.
begin
FWf.Free;
FStrip.Free;
FScope.Free;
FScopeChrome.Free;
inherited Destroy;
end;
procedure TBeaconScopeForm.PollFrame;
// Раз/тик: если декодер выдал НОВЫЙ кадр (S.Frames вырос) — печатаем бюллетень.
var
S: TBeaconScope;
Frame: TBeaconFrame;
rs: Integer;
begin
if FCtl = nil then Exit;
if not FCtl.GetBeaconScope(S) then Exit;
if S.Frames <= FLastFrames then Exit;
FLastFrames := S.Frames;
if not FCtl.GetBeaconFrame(Frame, rs) then Exit;
FMemo.Append(Format('--- frame %d (RS err %d) ---', [S.Frames, rs]));
FMemo.Append(FrameToText(Frame));
while FMemo.Lines.Count > 400 do FMemo.Lines.Delete(0); // ограничиваем рост
FMemo.SelStart := Length(FMemo.Text); // автоскролл вниз
end;
// ===========================================================================
// Лупа наведения: отрисовка
// ===========================================================================
function FormatBcnFreq(Hz: Double): string;
// 10489750123 → '10489.750.123'
var MHz: Int64; KHz, Rest: Integer;
begin
MHz := Trunc(Hz / 1000000);
KHz := Trunc((Hz - MHz * 1000000) / 1000);
Rest := Trunc(Hz) mod 1000;
Result := Format('%d.%3.3d.%3.3d', [MHz, KHz, Rest]);
end;
function FormatTick(Hz: Double; StepHz: Double): string;
// Подпись деления линейки: килогерцы (+ герцы на мелком шаге). Полная частота
// висит в углу карточки, так что здесь важны только младшие разряды.
var KHz, Rest: Integer;
begin
KHz := (Trunc(Hz) div 1000) mod 1000;
Rest := Trunc(Hz) mod 1000;
if StepHz >= 1000 then Result := Format('%3.3d', [KHz])
else Result := Format('%3.3d.%3.3d', [KHz, Rest]);
end;
function NiceStep(SpanHz: Double; WantTicks: Integer): Double;
// Ближайший «круглый» шаг (1/2/5·10^k), дающий примерно WantTicks делений.
var Raw, Mag, Norm: Double;
begin
Raw := SpanHz / Max(1, WantTicks);
if Raw <= 0 then Exit(1.0);
Mag := Power(10, Floor(Log10(Raw)));
Norm := Raw / Mag;
if Norm < 1.5 then Result := Mag
else if Norm < 3.5 then Result := 2 * Mag
else if Norm < 7.5 then Result := 5 * Mag
else Result := 10 * Mag;
end;
procedure TBeaconScopeForm.DrawZoomStrip;
// Полная сборка кадра лупы в офскрин FStrip. Зовётся ТОЛЬКО по FZoomDirty
// (новый кадр анализатора, сдвиг маркеров/окна, ресайз, смена темы) — так же,
// как MainForm гоняет FSpecView.DrawSpectrum по FSpectrumDirty. Курсор сюда не
// входит: он живёт в PaintSpec, чтобы движение мыши не пересобирало кадр.
var
C: TCanvas;
W, H, PlotH, RulerH, i, X, Y, Cnt: Integer;
Pts: array of TPoint;
Lo, Hi, Span, dB, MaxDB, Step, F, T: Double;
DecHz, RefHz, TrkHz: Double;
Txt: string;
Sorted: array of Double;
TmpD: Double;
a, b: Integer;
procedure SetFont(ASize: Integer; AStyle: TFontStyles = []);
begin
C.Font.Assign(Self.Font);
C.Font.Size := ASize;
C.Font.Style := AStyle;
end;
procedure VLine(FreqHz: Double; AColor: TColor; Dotted: Boolean);
begin
X := FreqToX(FreqHz, W);
if (X < 0) or (X >= W) then Exit;
C.Pen.Color := AColor;
C.Pen.Width := 1;
if Dotted then C.Pen.Style := psDot else C.Pen.Style := psSolid;
C.MoveTo(X, 0);
C.LineTo(X, PlotH);
C.Pen.Style := psSolid;
end;
begin
W := FSpecBox.Width;
H := FSpecBox.Height;
if (W <= 4) or (H <= 8) then Exit;
if (FStrip.Width <> W) or (FStrip.Height <> H) then
FStrip.SetSize(W, H);
C := FStrip.Canvas;
RulerH := DpiScale(15);
PlotH := H - RulerH;
// Фон + рамка
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.SpecGradBot;
C.FillRect(0, 0, W, H);
C.Brush.Color := FTheme.Panel;
C.FillRect(0, PlotH, W, H);
if FHaveFrame then begin Lo := FViewLo; Hi := FViewHi; end
else begin Lo := FCenterHz - FSpanHz / 2; Hi := FCenterHz + FSpanHz / 2; end;
Span := Hi - Lo;
Cnt := FPixCount;
// --- Шкала дБ: верх по максимуму кадра, низ по медиане (шумовой пол) ---
// Границы тянутся к цели плавно: иначе шкала прыгала бы на каждой посылке
// соседней SSB-станции, а маяк — то, что должно стоять на месте.
if Cnt > 1 then
begin
MaxDB := -400;
for i := 0 to Cnt - 1 do
if FPix[i] > MaxDB then MaxDB := FPix[i];
// Медиана считается по прореженной выборке (каждая 8-я точка кадра) —
// сортировка вставками по ~128 значениям дешевле полной по 1024.
SetLength(Sorted, (Cnt + 7) div 8);
for i := 0 to High(Sorted) do
Sorted[i] := FPix[Min(i * 8, Cnt - 1)];
for a := 1 to High(Sorted) do
begin
TmpD := Sorted[a];
b := a - 1;
while (b >= 0) and (Sorted[b] > TmpD) do
begin
Sorted[b + 1] := Sorted[b];
Dec(b);
end;
Sorted[b + 1] := TmpD;
end;
dB := Sorted[Length(Sorted) div 2]; // ≈ шумовой пол
if MaxDB - dB < 30 then MaxDB := dB + 30;
FSpecHi := FSpecHi + 0.2 * ((MaxDB + 6) - FSpecHi);
FSpecLo := FSpecLo + 0.2 * ((dB - 12) - FSpecLo);
if FSpecHi - FSpecLo < 25 then FSpecHi := FSpecLo + 25;
end;
// --- Сетка ---
C.Pen.Style := psSolid;
C.Pen.Width := 1;
C.Pen.Color := FTheme.SpecGrid;
for i := 1 to 3 do
begin
Y := PlotH * i div 4;
C.MoveTo(0, Y); C.LineTo(W, Y);
end;
Step := NiceStep(Span, 6);
F := Ceil(Lo / Step) * Step;
while F < Hi do
begin
X := FreqToX(F, W);
if (X > 0) and (X < W) then
begin
C.Pen.Color := FTheme.SpecGrid;
C.MoveTo(X, 0); C.LineTo(X, PlotH);
end;
F := F + Step;
end;
DecHz := 0; RefHz := 0; TrkHz := 0;
if FCtl <> nil then
begin
DecHz := FCtl.BeaconDecodeFreqHz;
RefHz := FCtl.BeaconRefHz;
TrkHz := FCtl.BeaconTrackedFreqHz;
end;
// --- Трасса ---
if Cnt > 1 then
begin
SetLength(Pts, W + 2);
for X := 0 to W - 1 do
begin
// Кадр лупы (1024 точки) шире полотна — берём максимум группы, чтобы
// узкая несущая маяка не потерялась между пикселями.
a := Trunc(X * Cnt / W);
b := Trunc((X + 1) * Cnt / W);
if b <= a then b := a + 1;
if b > Cnt then b := Cnt;
dB := FPix[a];
for i := a + 1 to b - 1 do
if FPix[i] > dB then dB := FPix[i];
T := (dB - FSpecLo) / Max(1.0, FSpecHi - FSpecLo);
Y := PlotH - 1 - Round(EnsureRange(T, 0.0, 1.0) * (PlotH - 2));
Pts[X] := Point(X, Y);
end;
// Заливка под трассой
Pts[W] := Point(W - 1, PlotH);
Pts[W + 1] := Point(0, PlotH);
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.SpecGradTop;
C.Pen.Style := psClear;
C.Polygon(Pts);
C.Pen.Style := psSolid;
C.Pen.Color := FTheme.SpecLine;
C.Pen.Width := 1;
C.MoveTo(Pts[0].X, Pts[0].Y);
for X := 1 to W - 1 do
C.LineTo(Pts[X].X, Pts[X].Y);
end
else
begin
SetFont(9);
C.Brush.Style := bsClear;
C.Font.Color := FTheme.TextDim;
Txt := 'waiting for IQ…';
C.TextOut((W - C.TextWidth(Txt)) div 2, PlotH div 2 - DpiScale(8), Txt);
end;
// --- Маркеры: один в один с главным спектром (DrawBeaconMarkersRaw/GL) ---
// Опорная (пунктир) + центроид, и три линии полосы приёма декодера. Заливки
// полосы намеренно нет: там так же — «дешевле для CPU и единый вид с GL».
if RefHz > 0 then VLine(RefHz, BCN_CLR_REF, True);
if TrkHz > 0 then VLine(TrkHz, BCN_CLR_TRK, False);
if DecHz > 0 then
begin
VLine(DecHz - BCN_DEC_BW_HZ, BCN_CLR_DEC, False);
VLine(DecHz + BCN_DEC_BW_HZ, BCN_CLR_DEC, False);
VLine(DecHz, BCN_CLR_DEC, False);
end;
// --- Линейка частот ---
SetFont(7);
C.Brush.Style := bsClear;
C.Pen.Color := FTheme.Border;
C.MoveTo(0, PlotH); C.LineTo(W, PlotH);
F := Ceil(Lo / Step) * Step;
while F < Hi do
begin
X := FreqToX(F, W);
if (X > 0) and (X < W) then
begin
C.Pen.Color := FTheme.Border;
C.MoveTo(X, PlotH); C.LineTo(X, PlotH + DpiScale(3));
Txt := FormatTick(F, Step);
C.Font.Color := FTheme.RulerText;
a := X - C.TextWidth(Txt) div 2;
if (a > 0) and (a + C.TextWidth(Txt) < W) then
C.TextOut(a, PlotH + DpiScale(2), Txt);
end;
F := F + Step;
end;
// --- Показания в углах ---
SetFont(8, [fsBold]);
C.Brush.Style := bsClear;
C.Font.Color := FTheme.Text;
C.TextOut(DpiScale(6), DpiScale(4), FormatBcnFreq((Lo + Hi) / 2));
SetFont(7);
C.Font.Color := FTheme.TextDim;
if (FCtl <> nil) and (FCtl.BeaconZoomBinHz > 0) then
Txt := Format('span %s · %.1f Hz/bin',
[IfThen(Span >= 10000, Format('%.0f kHz', [Span / 1000]),
Format('%.1f kHz', [Span / 1000])),
FCtl.BeaconZoomBinHz])
else
Txt := Format('span %.1f kHz', [Span / 1000]);
C.TextOut(W - DpiScale(6) - C.TextWidth(Txt), DpiScale(5), Txt);
// Рамка карточки поверх всего
C.Brush.Style := bsClear;
C.Pen.Style := psSolid;
C.Pen.Color := FTheme.Border;
C.Rectangle(0, 0, W, H);
FStripValid := True;
end;
procedure TBeaconScopeForm.PaintSpec(Sender: TObject);
// Только блит готового кадра + курсор поверх. Курсор рисуется здесь (а не в
// DrawZoomStrip) по образцу TWaterfallView.PaintWaterfall/DrawMarkerLine:
// движение мыши стоит блит и одну линию, а не пересборку кадра.
var
C: TCanvas;
W, H, PlotH, TxtX: Integer;
Txt: string;
begin
W := FSpecBox.Width;
H := FSpecBox.Height;
if (W <= 4) or (H <= 8) then Exit;
if (not FStripValid) or (FStrip.Width <> W) or (FStrip.Height <> H) then
DrawZoomStrip;
C := FSpecBox.Canvas;
C.Draw(0, 0, FStrip);
if (FCursorX < 0) or (FCursorX >= W) then Exit;
PlotH := H - DpiScale(15);
C.Pen.Color := FTheme.SpecVfoCursor;
C.Pen.Style := psDot;
C.MoveTo(FCursorX, 0); C.LineTo(FCursorX, PlotH);
C.Pen.Style := psSolid;
C.Font.Assign(Self.Font);
C.Font.Size := 7;
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.Panel;
C.Font.Color := FTheme.Text;
Txt := ' ' + FormatBcnFreq(XToFreq(FCursorX, W)) + ' ';
TxtX := FCursorX + DpiScale(4);
if TxtX + C.TextWidth(Txt) > W then
TxtX := FCursorX - DpiScale(4) - C.TextWidth(Txt);
C.TextOut(TxtX, PlotH - DpiScale(14), Txt);
C.Brush.Style := bsClear;
end;
procedure TBeaconScopeForm.PaintWf(Sender: TObject);
var
C: TCanvas;
W, H, X: Integer;
DecHz: Double;
begin
if FWf = nil then Exit;
FWf.PaintWaterfall(Sender);
C := FWfBox.Canvas;
W := FWfBox.Width;
H := FWfBox.Height;
if (W <= 0) or (H <= 0) then Exit;
// Маркер наведения продолжается на водопад — так видно, держится ли след
// маяка под полосой приёма.
DecHz := 0;
if FCtl <> nil then DecHz := FCtl.BeaconDecodeFreqHz;
if DecHz > 0 then
begin
X := FreqToX(DecHz, W);
if (X >= 0) and (X < W) then
begin
C.Pen.Style := psDot;
C.Pen.Color := BCN_CLR_DEC;
C.MoveTo(X, 0); C.LineTo(X, H);
C.Pen.Style := psSolid;
end;
end;
if (FCursorX >= 0) and (FCursorX < W) then
begin
C.Pen.Style := psDot;
C.Pen.Color := FTheme.SpecVfoCursor;
C.MoveTo(FCursorX, 0); C.LineTo(FCursorX, H);
C.Pen.Style := psSolid;
end;
C.Brush.Style := bsClear;
C.Pen.Color := FTheme.Border;
C.Rectangle(0, 0, W, H);
end;
// ===========================================================================
// Констелляция и метрики: геометрия / статичная подложка / кадр
// ===========================================================================
// Рендер разложен на три слоя по образцу TSpectrumView (FGridBitmap → кадр →
// блит): неподвижная обвязка (карточки, оси, кружки, рамки и подписи плиток)
// живёт в отдельном битмапе и пересобирается только на ресайз/смену темы,
// кадр собирается по FScopeValid, а OnPaint лишь копирует готовое. Раньше вся
// эта геометрия — два RoundRect карточек, восемь RoundRect плиток и десяток
// TextOut — рисовалась заново 25 раз в секунду прямо в обработчике Paint.
procedure TBeaconScopeForm.ScopeLayout(W, H: Integer;
out GraphR, MetricsR, PlotR: TRect; out cx, cy, r: Integer;
out Wide: Boolean);
var
M, Gap, GraphSize: Integer;
begin
M := DpiScale(16);
Gap := DpiScale(14);
Wide := W >= DpiScale(600);
if Wide then
begin
GraphSize := Min(H - 2 * M, (W - 3 * M) div 2);
GraphR := Rect(M, M, M + GraphSize, H - M);
MetricsR := Rect(GraphR.Right + Gap, M, W - M, H - M);
end
else
begin
GraphSize := Max(DpiScale(74), H - DpiScale(154) - 3 * M);
GraphR := Rect(M, M, W - M, M + GraphSize);
MetricsR := Rect(M, GraphR.Bottom + Gap, W - M, H - M);
end;
// Квадрат констелляции центрируется внутри своей карточки.
GraphSize := Min(GraphR.Right - GraphR.Left - DpiScale(28),
GraphR.Bottom - GraphR.Top - DpiScale(48));
GraphSize := Max(DpiScale(40), GraphSize);
PlotR.Left := GraphR.Left +
(GraphR.Right - GraphR.Left - GraphSize) div 2;
PlotR.Top := GraphR.Top + DpiScale(34) +
(GraphR.Bottom - GraphR.Top - DpiScale(40) - GraphSize) div 2;
PlotR.Right := PlotR.Left + GraphSize;
PlotR.Bottom := PlotR.Top + GraphSize;
cx := (PlotR.Left + PlotR.Right) div 2;
cy := (PlotR.Top + PlotR.Bottom) div 2;
r := GraphSize div 2 - DpiScale(8);
end;
function TBeaconScopeForm.MetricTileRect(const MetricsR: TRect; Wide: Boolean;
n: Integer): TRect;
var
Cols, Rows, Col, Row, TileW, TileH, X, Y, CardGap: Integer;
begin
if Wide then begin Cols := 2; Rows := 4; end
else begin Cols := 4; Rows := 2; end;
CardGap := DpiScale(8);
TileW := (MetricsR.Right - MetricsR.Left - DpiScale(28)
- (Cols - 1) * CardGap) div Cols;
TileH := (MetricsR.Bottom - MetricsR.Top - DpiScale(70)
- (Rows - 1) * CardGap) div Rows;
Col := n mod Cols;
Row := n div Cols;
X := MetricsR.Left + DpiScale(14) + Col * (TileW + CardGap);
Y := MetricsR.Top + DpiScale(34) + Row * (TileH + CardGap);
Result := Rect(X, Y, X + TileW, Y + TileH);
end;
procedure TBeaconScopeForm.BuildScopeChrome(W, H: Integer);
// Всё, что не меняется от кадра к кадру. Значения метрик и точки констелляции
// сюда НЕ входят — они ложатся поверх в DrawScope.
const
LABELS: array[0..7] of string =
('CARRIER', 'SYMBOL', 'SNR', 'SYMBOL RATE',
'TUNE OFFSET', 'RESIDUAL', 'FRAMES', 'FEC');
var
C: TCanvas;
GraphR, MetricsR, PlotR, TileR: TRect;
cx, cy, r, n: Integer;
Wide: Boolean;
procedure SetUIFont(ASize: Integer; AStyle: TFontStyles = []);
begin
C.Font.Assign(Self.Font);
C.Font.Size := ASize;
C.Font.Style := AStyle;
end;
procedure DrawCard(const AR: TRect; const ATitle: string);
begin
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.Panel;
C.Pen.Style := psSolid;
C.Pen.Width := 1;
C.Pen.Color := FTheme.Border;
C.RoundRect(AR.Left, AR.Top, AR.Right, AR.Bottom,
DpiScale(8), DpiScale(8));
SetUIFont(8, [fsBold]);
C.Font.Color := FTheme.TextDim;
C.Brush.Style := bsClear;
C.TextOut(AR.Left + DpiScale(14), AR.Top + DpiScale(10), ATitle);
end;
begin
FScopeChrome.SetSize(W, H);
FChromeW := W;
FChromeH := H;
C := FScopeChrome.Canvas;
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.BG;
C.FillRect(0, 0, W, H);
ScopeLayout(W, H, GraphR, MetricsR, PlotR, cx, cy, r, Wide);
DrawCard(GraphR, 'CONSTELLATION');
DrawCard(MetricsR, 'DECODER STATUS');
// Поле констелляции: рамка, оси, единичная/половинная окружности и две
// «идеальные» точки BPSK на оси I.
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.BG;
C.Pen.Style := psSolid;
C.Pen.Color := FTheme.Border;
C.Rectangle(PlotR.Left, PlotR.Top, PlotR.Right, PlotR.Bottom);
C.Pen.Color := FTheme.SpecGrid;
C.Line(cx - r, cy, cx + r, cy);
C.Line(cx, cy - r, cx, cy + r);
C.Brush.Style := bsClear;
C.Ellipse(cx - r, cy - r, cx + r, cy + r);
C.Ellipse(cx - r div 2, cy - r div 2, cx + r div 2, cy + r div 2);
C.Pen.Color := FTheme.TextDim;
C.Ellipse(cx + r div 2 - DpiScale(3), cy - DpiScale(3),
cx + r div 2 + DpiScale(3), cy + DpiScale(3));
C.Ellipse(cx - r div 2 - DpiScale(3), cy - DpiScale(3),
cx - r div 2 + DpiScale(3), cy + DpiScale(3));
// Плитки метрик: фон, рамка и подпись. Значение — динамика, поверх.
for n := 0 to 7 do
begin
TileR := MetricTileRect(MetricsR, Wide, n);
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.BG;
C.Pen.Style := psSolid;
C.Pen.Color := FTheme.Border;
C.RoundRect(TileR.Left, TileR.Top, TileR.Right, TileR.Bottom,
DpiScale(5), DpiScale(5));
C.Brush.Style := bsClear;
SetUIFont(8);
C.Font.Color := FTheme.TextDim;
C.TextOut(TileR.Left + DpiScale(9), TileR.Top + DpiScale(6), LABELS[n]);
end;
end;
procedure TBeaconScopeForm.DrawScope;
var
C: TCanvas;
W, H, cx, cy, r, i, px, py, n: Integer;
GraphR, MetricsR, PlotR, TileR: TRect;
S: TBeaconScope;
ok, Wide: Boolean;
Values: array[0..7] of string;
Colors: array[0..7] of TColor;
TechText: string;
procedure SetUIFont(ASize: Integer; AStyle: TFontStyles = []);
begin
C.Font.Assign(Self.Font);
C.Font.Size := ASize;
C.Font.Style := AStyle;
end;
begin
W := FBox.Width; H := FBox.Height;
if (W <= 0) or (H <= 0) then Exit;
if (FScope.Width <> W) or (FScope.Height <> H) then FScope.SetSize(W, H);
if (FChromeW <> W) or (FChromeH <> H) then BuildScopeChrome(W, H);
C := FScope.Canvas;
C.Draw(0, 0, FScopeChrome); // подложка = заодно стирание прошлого кадра
ScopeLayout(W, H, GraphR, MetricsR, PlotR, cx, cy, r, Wide);
ok := (FCtl <> nil) and FCtl.GetBeaconScope(S);
// --- Точки констелляции ---
if ok and S.Enabled then
begin
C.Pen.Style := psClear;
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.MeterOn;
for i := 0 to S.Count - 1 do
begin
px := cx + Round(S.PtI[i] * (r / 2));
py := cy - Round(S.PtQ[i] * (r / 2));
if (px >= cx - r) and (px <= cx + r) and (py >= cy - r) and (py <= cy + r) then
C.FillRect(px - DpiScale(1), py - DpiScale(1),
px + DpiScale(2), py + DpiScale(2));
end;
end;
// --- Значения метрик ---
for n := 0 to 7 do Colors[n] := FTheme.Text;
if not ok then
begin
Values[0] := 'UNAVAILABLE'; Values[1] := 'UNAVAILABLE';
Values[2] := '--'; Values[3] := '--';
Values[4] := '--'; Values[5] := '--';
Values[6] := '--'; Values[7] := '--';
TechText := 'Decoder data unavailable';
Colors[0] := FTheme.TextDim;
Colors[1] := FTheme.TextDim;
end
else if not S.Enabled then
begin
Values[0] := 'OFF'; Values[1] := 'OFF';
Values[2] := '--'; Values[3] := '--';
Values[4] := '--'; Values[5] := '--';
Values[6] := IntToStr(S.Frames);
Values[7] := '--';
TechText := 'Enable BEACON and click the beacon in the tuning window';
Colors[0] := FTheme.TextDim;
Colors[1] := FTheme.TextDim;
end
else
begin
Values[0] := IfThen(S.CarrierLock, 'LOCKED', 'SEARCH');
Values[1] := IfThen(S.SymbolLock, 'LOCKED', 'SEARCH');
if S.SNRdB > -50 then Values[2] := Format('%.1f dB', [S.SNRdB])
else Values[2] := '--';
Values[3] := Format('%.1f Bd', [S.SymRate]);
Values[4] := Format('%.0f Hz', [S.OffsetHz]);
Values[5] := Format('%.0f Hz', [S.ResidHz]);
Values[6] := IntToStr(S.Frames);
Values[7] := Format('RS %d · P%d', [S.LastRSErr, S.ManPhase]);
TechText := Format('INV %s · PROM %.0f · Fs %.0f · Fd %.0f · SPS %.1f',
[IfThen(FCtl.BeaconDecodeInvert, 'ON', 'OFF'), S.CarProm,
S.FsHz, S.FdecHz, S.Sps]);
if S.CarrierLock then Colors[0] := FTheme.MeterOn
else Colors[0] := FTheme.TextDim;
if S.SymbolLock then Colors[1] := FTheme.MeterOn
else Colors[1] := FTheme.TextDim;
if S.HasFrame then
begin
Colors[6] := FTheme.MeterOn;
Colors[7] := FTheme.MeterOn;
end;
end;
C.Brush.Style := bsClear;
SetUIFont(9, [fsBold]);
for n := 0 to 7 do
begin
TileR := MetricTileRect(MetricsR, Wide, n);
C.Font.Color := Colors[n];
C.TextOut(TileR.Left + DpiScale(9), TileR.Top + DpiScale(21), Values[n]);
end;
SetUIFont(7);
C.Font.Color := FTheme.TextDim;
C.TextOut(MetricsR.Left + DpiScale(14),
MetricsR.Bottom - DpiScale(20), TechText);
FScopeValid := True;
end;
procedure TBeaconScopeForm.DoPaint(Sender: TObject);
begin
if (FBox.Width <= 0) or (FBox.Height <= 0) then Exit;
if (not FScopeValid) or (FScope.Width <> FBox.Width)
or (FScope.Height <> FBox.Height) then
DrawScope;
FBox.Canvas.Draw(0, 0, FScope);
end;
end.