Files
ewsdr/SpectrumView.pas
ew8bakandClaude Fable 5 bd2a6bc2ea ui: плашка ADC OVERLOAD — общий образ CPU/GL без пер-кадрового жора
AlertOverlay переписан в общий builder: BuildAlertImage строит RGBA-образ
плашки (попиксельная альфа, Canvas один раз на своём битмапе). GL грузит
образ текстурой (кэш как был), CPU блендит кэш в raw-кадр — убраны
canvas-путь в кадре и полный проход восстановления альфы битмапа.
GL-плашка теперь 1:1 с CPU (было: упрощённый бокс по центру), позиция —
правый верхний угол в обоих рендерах. Удалена мёртвая подсветочная линия
(перекрывалась рамкой).

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
2026-07-18 10:36:23 +03:00

1794 lines
76 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 SpectrumView;
{
SpectrumView.pas — рендеринг спектрограммы.
TSpectrumView инкапсулирует рисование спектра и агрегирует дочерние
компоненты: TWaterfallView, TSMeterView, TRulerView. MainForm создаёт один
экземпляр TSpectrumView и работает с ним единообразно: свойства/методы
водопада, S-метра и линейки делегируются в соответствующие sub-view.
Зависимости: нет обратной зависимости на MainForm.
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, Graphics, GraphType, ExtCtrls, Controls, Math,
AppTheme,
AlertOverlay, SampleRateOverlay, VfoOverlay, BandPlanOverlay,
WaterfallView, SMeterView, RulerView, RadioModes;
const
SV_CLR_BG = TColor($00101010);
type
// Кэш текстовой маски для raw-рендера: строка отрисована белым на чёрном
// (canvas — один раз при создании), при блите канал покрытия умножается
// на нужный цвет. Цвет в ключ не входит.
TRawTextMask = record
Key: string; // '<size>|<bold>|<text>'
Bmp: TBitmap;
LastUse: Int64;
end;
// Маркер 2TON/IMD-измерения на спектре: кружок на пике продукта + подпись.
// Все маркеры подписываются абсолютным уровнем шкалы (dBm); относительная
// величина IMD3 в dBc — в сводке слева от полосы фильтра.
TIMDMarker = record
FreqHz: Double; // абсолютная частота продукта
LevelDB: Double; // измеренный пик (шкала дисплея)
Caption: string;
IsTone: Boolean; // True = основной тон, False = IMD-продукт
end;
TSpectrumView = class
protected
// ── Off-screen bitmaps ────────────────────────────────────────────────────
FSpectrumBitmap: TBitmap;
FGridBitmap: TBitmap;
FGridBitmapW: Integer;
FGridBitmapH: Integer;
FFMGridLastCenter: Double;
FFMGridLastStepHz: Double;
FFMGridLastSpan: Double;
FSpPts: array of TPoint;
FSpPtsLen: Integer;
FFillSpectrum: Boolean;
// ── Full-raw рендер кадра (без Canvas на битмапе спектра) ────────────────
FRawBase: PByte; // база пикселей кадра; валидна между RawBegin/RawEnd
FRawBPL: Integer; // bytes per line (отрицателен при bottom-up DIB)
FRawW: Integer;
FRawH: Integer;
FTextMasks: array of TRawTextMask;
FTextTick: Int64;
// ── Тема ─────────────────────────────────────────────────────────────────
FTheme: TAppTheme;
FLightTheme: Boolean;
// ── Radio state ───────────────────────────────────────────────────────────
FVfoA: Double;
FVfoB: Double;
FActiveVfo: Integer;
FCenterFreq: Double;
FSpanHz: Double;
FMode: Integer;
FFilterBW: Integer;
FAGCTop: Integer;
FAGCThresh: Double;
FAGCHangLevel: Double;
FWDSPReady: Boolean;
// ── Display settings ──────────────────────────────────────────────────────
FSpecRefLevel: Double;
FSpecRange: Double;
FSpecGridStep: Double;
FFMGridStepHz: Double;
// ── TX overlay ────────────────────────────────────────────────────────────
FTXMode: Boolean;
FTXFreq: Double;
FTXSpanHz: Double;
FTXVfoIndex: Integer;
FTXOverlay: Boolean;
// ── ADC overload overlay ─────────────────────────────────────────────────
FADCOverloadVisible: Boolean;
FADCAlertImg: TAlertImage; // кэш образа плашки (BuildAlertImage, 1 раз)
FSampleRateOverlay: TSampleRateOverlay;
FVfoOverlay: TVfoOverlay;
FSliceOverlays: TFPList; // доп. слайс-флаги (B+); не владеет (владелец MainForm)
FBandPlanOverlay: TBandPlanOverlay;
// ── Marker ────────────────────────────────────────────────────────────────
FMarkerActive: Boolean;
FMarkerX: Integer;
// ── QO-100 beacon markers (диагностика лока) ──────────────────────────────
FBeaconMarkActive: Boolean;
FBeaconRefFreq: Double; // опорная частота маяка (где ДОЛЖЕН быть)
FBeaconTrkFreq: Double; // отслеживаемый центроид маяка сейчас
// узкий фильтр-маркер декодера (наведение пользователем)
FBeaconDecActive: Boolean;
FBeaconDecFreq: Double;
FBeaconDecHalf: Double; // полуширина фильтра, Гц
// ── 2TON/IMD-маркеры (пики тонов и продуктов IMD3 при двухтональнике) ────
FIMDActive: Boolean;
FIMDTone1Hz: Double; // абс. частоты тонов (TX freq + аудио-оффсет)
FIMDTone2Hz: Double;
FIMDSummary: string; // сводка «IMD3 −NN dBc» (обновляет ComputeIMDMarkers)
// ── Spectrum buffer ───────────────────────────────────────────────────────
FSpectrumBuf: array[0..WF_MAX_PIXELS-1] of Single;
FSpectrumBufCount: Integer;
FSpectrumDirty: Boolean;
// ── Sub-views ─────────────────────────────────────────────────────────────
FWaterfall: TWaterfallView;
FSMeter: TSMeterView;
FRuler: TRulerView;
// ── Приватные методы рендеринга ───────────────────────────────────────────
function ActiveVfoFreq: Double;
function ScaleX(X, Total, Width: Integer): Integer;
procedure SetFMGridStepHz(V: Double);
procedure SetCenterFreq(V: Double);
procedure SetSpanHz(V: Double);
procedure SetVfoA(V: Double);
procedure SetVfoB(V: Double);
procedure SetActiveVfo(V: Integer);
procedure SetTXMode(V: Boolean);
procedure SetTXFreq(V: Double);
procedure SetTXSpanHz(V: Double);
procedure SetMarkerActive(V: Boolean);
procedure SetMarkerX(V: Integer);
procedure SetFillSpectrum(V: Boolean);
procedure DrawSpectrumGradient(const SpPts: array of TPoint; W, H: Integer);
// Full-raw рендер кадра: ВСЕ операции на битмапе спектра идут через
// прямой доступ к пикселям (RawBegin/RawEnd), Canvas на нём не трогаем —
// на Qt6 каждый переход raw(ScanLine)<->canvas(QPainter) синкает весь
// битмап (~2мс), поэтому линии/пунктир/кривая рисуются вручную, а тексты
// блитятся из кэша масок (canvas-рендер строки один раз при изменении).
procedure RawBegin;
procedure RawEnd;
procedure RawVLine(X, Y1, Y2: Integer; Color: TColor; LineW: Integer = 1;
OnPx: Integer = 0; OffPx: Integer = 0);
procedure RawHLine(Y, X1, X2: Integer; Color: TColor;
OnPx: Integer = 0; OffPx: Integer = 0);
procedure RawFillRect(X1, Y1, X2, Y2: Integer; Color: TColor);
procedure RawTriangleDown(CX, HalfW, Hgt: Integer; Color: TColor);
procedure RawCurve(W: Integer; Color: TColor);
function GetTextMask(const S: string; FontSize: Integer;
Bold: Boolean): TBitmap;
function RawTextWidth(const S: string; FontSize: Integer;
Bold: Boolean): Integer;
procedure RawText(X, Y: Integer; const S: string; Color: TColor;
FontSize: Integer; Bold: Boolean; BgColor: TColor);
procedure DrawMarkerLineRaw(W, H: Integer);
procedure DrawSliceFilterBands(W, H: Integer);
procedure DrawSliceFilterLinesRaw(W, H: Integer);
procedure DrawBandLetterRaw(X1, X2: Integer; L: Char; Clr: TColor);
procedure DrawBeaconMarkersRaw(W, H: Integer);
// 2TON/IMD: замер пиков по TX-буферу (общий для CPU/GL рендеров).
// Возвращает число валидных маркеров в M (0 если измерять нечего):
// [0..1] тона, [2..3] IMD3 (2f1f2, 2f2f1). Обновляет FIMDSummary.
function ComputeIMDMarkers(var M: array of TIMDMarker): Integer;
procedure DrawIMDMarkersRaw(W, H: Integer; DBmax, InvRange: Double);
procedure RawCircle(CX, CY, R: Integer; Color: TColor);
procedure BlendBand(X1, X2, H: Integer; R, G, B, Alpha: Byte);
procedure FillBandRaw(X1, X2, H: Integer; Color: TColor);
procedure CopyGridToSpectrum(W, H: Integer);
procedure DrawADCOverloadRaw(W, H: Integer);
procedure CalcFilterBandX(VfoFreq: Double; W: Integer;
out X1, X2, VfoX: Integer);
procedure CalcFilterBandXFor(VfoFreq: Double; Mode, BW, W: Integer;
out X1, X2, VfoX: Integer);
function GetWaterfallDirty: Boolean;
procedure SetWaterfallDirty(V: Boolean);
// Waterfall sub-view delegating accessors
function GetWfAGCEnabled: Boolean;
procedure SetWfAGCEnabled(V: Boolean);
function GetWfNFEnabled: Boolean;
procedure SetWfNFEnabled(V: Boolean);
function GetWfManualHigh: Double;
procedure SetWfManualHigh(V: Double);
function GetWfManualLow: Double;
procedure SetWfManualLow(V: Double);
function GetWfAGCOffset: Double;
procedure SetWfAGCOffset(V: Double);
function GetWfFrameInterval: Integer;
procedure SetWfFrameInterval(V: Integer);
function GetWfPalette: Integer;
procedure SetWfPalette(V: Integer);
function GetWfGamma: Double;
procedure SetWfGamma(V: Double);
procedure SetPbWaterfall(V: TControl);
// SMeter sub-view delegating accessors
function GetLastSMeter: Double;
procedure SetLastSMeter(V: Double);
function GetSMeterPeak: Double;
procedure SetSMeterPeak(V: Double);
function GetSMeterMin: Double;
procedure SetSMeterMin(V: Double);
function GetLastFwdW: Double;
procedure SetLastFwdW(V: Double);
function GetLastSWR: Double;
procedure SetLastSWR(V: Double);
function GetPAMaxPower: Double;
procedure SetPAMaxPower(V: Double);
function GetTransmitting: Boolean;
procedure SetTransmitting(V: Boolean);
procedure SetPbSMeterRight(V: TPaintBox);
// Ruler sub-view delegating accessor
procedure SetPbRuler(V: TPaintBox);
public
constructor Create;
destructor Destroy; override;
// ── Состояние радио ───────────────────────────────────────────────────────
property VfoA: Double read FVfoA write SetVfoA;
property VfoB: Double read FVfoB write SetVfoB;
property ActiveVfo: Integer read FActiveVfo write SetActiveVfo;
property CenterFreq: Double read FCenterFreq write SetCenterFreq;
property SpanHz: Double read FSpanHz write SetSpanHz;
property Mode: Integer read FMode write FMode;
property FilterBW: Integer read FFilterBW write FFilterBW;
property AGCTop: Integer read FAGCTop write FAGCTop;
property AGCThresh: Double write FAGCThresh;
property AGCHangLevel: Double write FAGCHangLevel;
property WDSPReady: Boolean read FWDSPReady write FWDSPReady;
// ── Водопад ───────────────────────────────────────────────────────────────
property WfAGCEnabled: Boolean read GetWfAGCEnabled write SetWfAGCEnabled;
property WfNFEnabled: Boolean read GetWfNFEnabled write SetWfNFEnabled;
property WfManualHigh: Double read GetWfManualHigh write SetWfManualHigh;
property WfManualLow: Double read GetWfManualLow write SetWfManualLow;
property WfAGCOffset: Double read GetWfAGCOffset write SetWfAGCOffset;
// ── Отображение ───────────────────────────────────────────────────────────
property SpecRefLevel: Double read FSpecRefLevel write FSpecRefLevel;
property SpecRange: Double read FSpecRange write FSpecRange;
property SpecGridStep: Double read FSpecGridStep write FSpecGridStep;
property FMGridStepHz: Double read FFMGridStepHz write SetFMGridStepHz;
// ── TX overlay ────────────────────────────────────────────────────────────
property TXMode: Boolean read FTXMode write SetTXMode;
property TXFreq: Double read FTXFreq write SetTXFreq;
property TXSpanHz: Double read FTXSpanHz write SetTXSpanHz;
property TXVfoIndex: Integer read FTXVfoIndex write FTXVfoIndex;
property TXOverlay: Boolean read FTXOverlay write FTXOverlay;
property ADCOverloadVisible: Boolean read FADCOverloadVisible write FADCOverloadVisible;
// ── Маркер ────────────────────────────────────────────────────────────────
property MarkerActive: Boolean read FMarkerActive write SetMarkerActive;
property MarkerX: Integer read FMarkerX write SetMarkerX;
// QO-100 beacon-маркеры: опорная частота (зелёная) + позиция трекера (оранж).
// Спектр перерисовывается каждый кадр, поэтому отдельный invalidate не нужен.
procedure SetBeaconMarkers(Active: Boolean; RefHz, TrkHz: Double);
procedure SetBeaconDecMarker(Active: Boolean; FreqHz, HalfHz: Double);
// 2TON/IMD-маркеры: кружки с уровнями на пиках тонов и продуктов IMD3
// (замер линейности/PureSignal). Включает MainForm при 2TON+TX+DUP:
// дисплей на RX показывает СВОЙ сигнал после PA — настоящие IMD-плечи
// (на цифровом TX-спектре продуктов PA нет, там замер бессмыслен).
procedure SetIMDMarkers(Active: Boolean; Tone1Hz, Tone2Hz: Double);
// ── S-метр ────────────────────────────────────────────────────────────────
property LastSMeter: Double read GetLastSMeter write SetLastSMeter;
property SMeterPeak: Double read GetSMeterPeak write SetSMeterPeak;
property SMeterMin: Double read GetSMeterMin write SetSMeterMin;
property LastFwdW: Double read GetLastFwdW write SetLastFwdW;
property LastSWR: Double read GetLastSWR write SetLastSWR;
property PAMaxPower: Double read GetPAMaxPower write SetPAMaxPower;
property Transmitting: Boolean read GetTransmitting write SetTransmitting;
// ── Флаги обновления ──────────────────────────────────────────────────────
property SpectrumDirty: Boolean read FSpectrumDirty write FSpectrumDirty;
property FillSpectrum: Boolean read FFillSpectrum write SetFillSpectrum;
property WaterfallDirty: Boolean read GetWaterfallDirty write SetWaterfallDirty;
property WfFrameInterval: Integer read GetWfFrameInterval write SetWfFrameInterval;
property WfPalette: Integer read GetWfPalette write SetWfPalette;
property WfGamma: Double read GetWfGamma write SetWfGamma;
// ── Ссылки на PaintBox ────────────────────────────────────────────────────
property PbWaterfall: TControl write SetPbWaterfall;
property PbRuler: TPaintBox write SetPbRuler;
property PbSMeterRight: TPaintBox write SetPbSMeterRight;
property SampleRateOverlay: TSampleRateOverlay read FSampleRateOverlay write FSampleRateOverlay;
property VfoOverlay: TVfoOverlay read FVfoOverlay write FVfoOverlay;
// Доп. слайс-флаги (B+): рисуются поверх спектра после главного оверлея.
procedure AddSliceOverlay(O: TVfoOverlay);
procedure RemoveSliceOverlay(O: TVfoOverlay);
function SliceOverlayCount: Integer;
function SliceOverlayAt(Index: Integer): TVfoOverlay;
property BandPlanOverlay: TBandPlanOverlay read FBandPlanOverlay write FBandPlanOverlay;
// ── Данные от DSP ─────────────────────────────────────────────────────────
procedure SetSpectrumData(const Pixels: array of Single; Count: Integer); virtual;
procedure SetWaterfallData(const Pixels: array of Single; Count: Integer); virtual;
// ── Рендеринг ─────────────────────────────────────────────────────────────
procedure DrawSpectrum; virtual;
procedure DrawWaterfall; virtual;
procedure DrawRuler; virtual;
// ── Управление размером bitmap ────────────────────────────────────────────
procedure SetSpectrumBitmapSize(W, H: Integer); virtual;
procedure SetWaterfallBitmapSize(W, H: Integer); virtual;
procedure SetRulerSize(W, H: Integer); virtual;
function SpectrumBitmapWidth: Integer; virtual;
// ── Paint-обработчики ────────────────────────────────────────────────────
procedure PaintSpectrum(Sender: TObject); virtual;
procedure PaintWaterfall(Sender: TObject); virtual;
procedure PaintRuler(Sender: TObject); virtual;
procedure PaintSMeterRight(Sender: TObject); virtual;
// ── Утилиты ───────────────────────────────────────────────────────────────
procedure InvalidateGridCache; virtual;
procedure InvalidateOverlayCache; virtual;
// Инвалидация ТОЛЬКО текстуры главного VFO-флага (без band/samplerate/слайсов).
// Нужна для дешёвого обновления S-метра главного флага в GL-вьюхе.
procedure InvalidateVfoOverlay; virtual;
procedure SetTheme(const T: TAppTheme); virtual;
procedure InvalidateRulerCache; virtual;
procedure ResetSpectrumBuf; virtual;
procedure ResetWfAvgBuf; virtual;
procedure ClearWaterfall; // сброс истории водопада (смена палитры/gamma)
procedure FillDemoSpectrum; virtual;
function NeedsRulerRedraw: Boolean; virtual;
end;
implementation
const
// Полоса фильтра передающего тракта (главный VFO при TX / передающий слайс).
// TColor = $00BBGGRR, младший байт = R (как в BlendBand/RawPack).
CLR_TX_BAND = TColor($003030E0);
// Упаковка TColor в пиксель кадра (непрозрачный). Раскладка байтов как в
// BlendBand: non-Darwin = BGRA, Darwin = ARGB.
function RawPack(Color: TColor): LongWord; inline;
var R, G, B: Byte;
begin
R := Color and $FF; G := (Color shr 8) and $FF; B := (Color shr 16) and $FF;
{$IFDEF DARWIN}
Result := LongWord($FF) or (LongWord(R) shl 8) or (LongWord(G) shl 16) or
(LongWord(B) shl 24);
{$ELSE}
Result := LongWord(B) or (LongWord(G) shl 8) or (LongWord(R) shl 16) or
$FF000000;
{$ENDIF}
end;
// ════════════════════════════════════════════════════════════════════════════
// Вспомогательные функции
// ════════════════════════════════════════════════════════════════════════════
function FormatFreqSV(Hz: Double): string;
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 MixColorBGR(C1, C2: TColor; T: Double): TColor;
var
B1, G1, R1, B2, G2, R2, B, G, R: Integer;
begin
if T < 0.0 then T := 0.0 else if T > 1.0 then T := 1.0;
B1 := (C1 shr 16) and $FF; G1 := (C1 shr 8) and $FF; R1 := C1 and $FF;
B2 := (C2 shr 16) and $FF; G2 := (C2 shr 8) and $FF; R2 := C2 and $FF;
B := Round(B1 + (B2-B1)*T); G := Round(G1 + (G2-G1)*T); R := Round(R1 + (R2-R1)*T);
Result := TColor((B shl 16) or (G shl 8) or R);
end;
procedure PaintVerticalGradient(C: TCanvas; W, H: Integer; TopColor, BottomColor: TColor);
var Y: Integer; T: Double;
begin
if (W <= 0) or (H <= 0) then Exit;
C.Pen.Style := psClear; C.Brush.Style := bsSolid;
for Y := 0 to H - 1 do
begin
T := Y / Max(1, H - 1);
C.Brush.Color := MixColorBGR(TopColor, BottomColor, T);
C.FillRect(Rect(0, Y, W, Y + 1));
end;
C.Pen.Style := psSolid;
end;
// ════════════════════════════════════════════════════════════════════════════
// TSpectrumView
// ════════════════════════════════════════════════════════════════════════════
constructor TSpectrumView.Create;
begin
inherited Create;
FSpectrumBitmap := TBitmap.Create;
FSpectrumBitmap.PixelFormat := pf32bit;
FGridBitmap := TBitmap.Create;
FGridBitmap.PixelFormat := pf32bit;
FGridBitmapW := 0; FGridBitmapH := 0;
FFMGridLastCenter := -1.0; FFMGridLastStepHz := -1.0; FFMGridLastSpan := -1.0;
FFMGridStepHz := 0.0;
FSpPtsLen := 0;
// Spectrum display defaults
FSpecRefLevel := -20.0;
FSpecRange := 110.0;
FSpecGridStep := 10.0;
FSpanHz := 192000;
// TX overlay defaults
FTXMode := False;
FTXFreq := 0.0;
FTXSpanHz := 192000.0;
FTXVfoIndex := 0;
FTXOverlay := False;
FADCOverloadVisible := False;
FSpectrumBufCount := 1024;
FSpectrumDirty := True;
FLightTheme := False;
FFillSpectrum := True;
FTheme := DarkTheme;
// Sub-views
FWaterfall := TWaterfallView.Create;
FSMeter := TSMeterView.Create;
FRuler := TRulerView.Create;
FSliceOverlays := TFPList.Create;
ResetSpectrumBuf;
end;
destructor TSpectrumView.Destroy;
var i: Integer;
begin
for i := 0 to High(FTextMasks) do
FTextMasks[i].Bmp.Free;
FSpectrumBitmap.Free;
FGridBitmap.Free;
FWaterfall.Free;
FSMeter.Free;
FRuler.Free;
FSliceOverlays.Free; // не владеет флагами — только список
inherited;
end;
procedure TSpectrumView.AddSliceOverlay(O: TVfoOverlay);
begin
if (O <> nil) and (FSliceOverlays.IndexOf(O) < 0) then FSliceOverlays.Add(O);
end;
procedure TSpectrumView.RemoveSliceOverlay(O: TVfoOverlay);
begin
FSliceOverlays.Remove(O);
end;
function TSpectrumView.SliceOverlayCount: Integer;
begin
Result := FSliceOverlays.Count;
end;
function TSpectrumView.SliceOverlayAt(Index: Integer): TVfoOverlay;
begin
Result := TVfoOverlay(FSliceOverlays[Index]);
end;
// ────────────────────────────────────────────────────────────────────────────
// Setters with cascade to sub-views
// ────────────────────────────────────────────────────────────────────────────
procedure TSpectrumView.SetCenterFreq(V: Double);
begin
FCenterFreq := V;
FWaterfall.CenterFreq := V;
FRuler.CenterFreq := V;
end;
procedure TSpectrumView.SetSpanHz(V: Double);
begin
FSpanHz := V;
FWaterfall.SpanHz := V;
FRuler.SpanHz := V;
end;
procedure TSpectrumView.SetVfoA(V: Double);
begin
FVfoA := V;
FRuler.VfoA := V;
end;
procedure TSpectrumView.SetVfoB(V: Double);
begin
FVfoB := V;
FRuler.VfoB := V;
end;
procedure TSpectrumView.SetActiveVfo(V: Integer);
begin
FActiveVfo := V;
FRuler.ActiveVfo := V;
end;
procedure TSpectrumView.SetTXMode(V: Boolean);
begin
FTXMode := V;
FWaterfall.TXMode := V;
end;
procedure TSpectrumView.SetTXFreq(V: Double);
begin
FTXFreq := V;
FWaterfall.TXFreq := V;
end;
procedure TSpectrumView.SetTXSpanHz(V: Double);
begin
FTXSpanHz := V;
FWaterfall.TXSpanHz := V;
end;
procedure TSpectrumView.SetMarkerActive(V: Boolean);
begin
FMarkerActive := V;
FWaterfall.MarkerActive := V;
end;
procedure TSpectrumView.SetMarkerX(V: Integer);
begin
FMarkerX := V;
FWaterfall.MarkerX := V;
end;
procedure TSpectrumView.SetFillSpectrum(V: Boolean);
begin
if FFillSpectrum = V then Exit;
FFillSpectrum := V;
FSpectrumDirty := True;
end;
function TSpectrumView.GetWaterfallDirty: Boolean;
begin
Result := FWaterfall.WaterfallDirty;
end;
procedure TSpectrumView.SetWaterfallDirty(V: Boolean);
begin
FWaterfall.WaterfallDirty := V;
end;
function TSpectrumView.GetWfAGCEnabled: Boolean; begin Result := FWaterfall.WfAGCEnabled; end;
procedure TSpectrumView.SetWfAGCEnabled(V: Boolean); begin FWaterfall.WfAGCEnabled := V; end;
function TSpectrumView.GetWfNFEnabled: Boolean; begin Result := FWaterfall.WfNFEnabled; end;
procedure TSpectrumView.SetWfNFEnabled(V: Boolean); begin FWaterfall.WfNFEnabled := V; end;
function TSpectrumView.GetWfManualHigh: Double; begin Result := FWaterfall.WfManualHigh; end;
procedure TSpectrumView.SetWfManualHigh(V: Double); begin FWaterfall.WfManualHigh := V; end;
function TSpectrumView.GetWfManualLow: Double; begin Result := FWaterfall.WfManualLow; end;
procedure TSpectrumView.SetWfManualLow(V: Double); begin FWaterfall.WfManualLow := V; end;
function TSpectrumView.GetWfAGCOffset: Double; begin Result := FWaterfall.WfAGCOffset; end;
procedure TSpectrumView.SetWfAGCOffset(V: Double); begin FWaterfall.WfAGCOffset := V; end;
function TSpectrumView.GetWfFrameInterval: Integer; begin Result := FWaterfall.WfFrameInterval; end;
procedure TSpectrumView.SetWfFrameInterval(V: Integer); begin FWaterfall.WfFrameInterval := V; end;
function TSpectrumView.GetWfPalette: Integer; begin Result := FWaterfall.WfPalette; end;
procedure TSpectrumView.SetWfPalette(V: Integer); begin FWaterfall.WfPalette := V; end;
function TSpectrumView.GetWfGamma: Double; begin Result := FWaterfall.WfGamma; end;
procedure TSpectrumView.SetWfGamma(V: Double); begin FWaterfall.WfGamma := V; end;
procedure TSpectrumView.SetPbWaterfall(V: TControl); begin FWaterfall.PbWaterfall := V; end;
function TSpectrumView.GetLastSMeter: Double; begin Result := FSMeter.LastSMeter; end;
procedure TSpectrumView.SetLastSMeter(V: Double); begin FSMeter.LastSMeter := V; end;
function TSpectrumView.GetSMeterPeak: Double; begin Result := FSMeter.SMeterPeak; end;
procedure TSpectrumView.SetSMeterPeak(V: Double); begin FSMeter.SMeterPeak := V; end;
function TSpectrumView.GetSMeterMin: Double; begin Result := FSMeter.SMeterMin; end;
procedure TSpectrumView.SetSMeterMin(V: Double); begin FSMeter.SMeterMin := V; end;
function TSpectrumView.GetLastFwdW: Double; begin Result := FSMeter.LastFwdW; end;
procedure TSpectrumView.SetLastFwdW(V: Double); begin FSMeter.LastFwdW := V; end;
function TSpectrumView.GetLastSWR: Double; begin Result := FSMeter.LastSWR; end;
procedure TSpectrumView.SetLastSWR(V: Double); begin FSMeter.LastSWR := V; end;
function TSpectrumView.GetPAMaxPower: Double; begin Result := FSMeter.PAMaxPower; end;
procedure TSpectrumView.SetPAMaxPower(V: Double); begin FSMeter.PAMaxPower := V; end;
function TSpectrumView.GetTransmitting: Boolean; begin Result := FSMeter.Transmitting; end;
procedure TSpectrumView.SetTransmitting(V: Boolean); begin FSMeter.Transmitting := V; end;
procedure TSpectrumView.SetPbSMeterRight(V: TPaintBox); begin FSMeter.PbSMeterRight := V; end;
procedure TSpectrumView.SetPbRuler(V: TPaintBox); begin FRuler.PbRuler := V; end;
// ────────────────────────────────────────────────────────────────────────────
// Приватные вспомогательные методы
// ────────────────────────────────────────────────────────────────────────────
function TSpectrumView.ActiveVfoFreq: Double;
begin
if FActiveVfo = 0 then Result := FVfoA else Result := FVfoB;
end;
function TSpectrumView.ScaleX(X, Total, Width: Integer): Integer;
begin
if Total = 0 then Result := 0
else Result := Round(X / Total * Width);
end;
procedure TSpectrumView.SetFMGridStepHz(V: Double);
begin
if Abs(FFMGridStepHz - V) > 0.5 then
begin
FFMGridStepHz := V;
FRuler.FMGridStepHz := V;
InvalidateGridCache;
FRuler.InvalidateRulerCache;
end;
end;
procedure TSpectrumView.DrawMarkerLineRaw(W, H: Integer);
const
MARK_CLR = TColor($004444FF);
var
MX, LblW: Integer;
MarkerFreq: Double;
MarkerLbl: string;
begin
MX := Round(FMarkerX / 1000.0 * W);
if (MX < 0) or (MX >= W) then Exit;
MarkerFreq := (FCenterFreq - FSpanHz / 2) + FMarkerX / 1000.0 * FSpanHz;
MarkerLbl := FormatFreqSV(Round(MarkerFreq));
RawVLine(MX, 0, H - 1, MARK_CLR);
LblW := RawTextWidth(MarkerLbl, 7, False);
if MX + 4 + LblW < W then
RawText(MX + 4, 4, MarkerLbl, MARK_CLR, 7, False, clNone)
else
RawText(MX - 4 - LblW, 4, MarkerLbl, MARK_CLR, 7, False, clNone);
end;
procedure TSpectrumView.SetBeaconMarkers(Active: Boolean; RefHz, TrkHz: Double);
begin
FBeaconMarkActive := Active;
FBeaconRefFreq := RefHz;
FBeaconTrkFreq := TrkHz;
end;
procedure TSpectrumView.SetBeaconDecMarker(Active: Boolean; FreqHz, HalfHz: Double);
begin
FBeaconDecActive := Active;
FBeaconDecFreq := FreqHz;
FBeaconDecHalf := HalfHz;
end;
procedure TSpectrumView.DrawBeaconMarkersRaw(W, H: Integer);
// Две вертикали: опорная частота маяка (зелёная пунктир) и отслеживаемый
// центроид (оранжевая сплошная). Расхождение видно глазом → понятно, сел ли
// контур на пик маяка или на шум.
procedure Vline(FreqHz: Double; Col: TColor; Dotted: Boolean);
var x: Integer;
begin
if FSpanHz <= 0 then Exit;
x := Round((FreqHz - (FCenterFreq - FSpanHz / 2)) / FSpanHz * W);
if (x < 0) or (x >= W) then Exit;
if Dotted then RawVLine(x, 0, H - 1, Col, 1, 1, 2)
else RawVLine(x, 0, H - 1, Col);
end;
begin
if FBeaconMarkActive then
begin
Vline(FBeaconRefFreq, clLime, True); // где маяк ДОЛЖЕН быть
Vline(FBeaconTrkFreq, TColor($000AA5FF), False); // отслеживаемый центроид (оранж)
end;
// Узкий фильтр-маркер декодера: грани полосы + центральная линия. Три линии без
// полупрозрачной заливки (как в GL-рендере) — единый вид и дешевле для CPU.
if FBeaconDecActive and (FSpanHz > 0) then
begin
Vline(FBeaconDecFreq - FBeaconDecHalf, TColor($0020D0FF), False); // грань фильтра
Vline(FBeaconDecFreq + FBeaconDecHalf, TColor($0020D0FF), False);
Vline(FBeaconDecFreq, TColor($0020D0FF), False); // центр наведения
end;
end;
procedure TSpectrumView.SetIMDMarkers(Active: Boolean; Tone1Hz, Tone2Hz: Double);
begin
FIMDActive := Active;
FIMDTone1Hz := Tone1Hz;
FIMDTone2Hz := Tone2Hz;
if not Active then FIMDSummary := '';
end;
function TSpectrumView.ComputeIMDMarkers(var M: array of TIMDMarker): Integer;
// Пики меряются по FSpectrumBuf. Основной сценарий — DUP: дисплей на RX
// (TXMode=False), буфер покрывает видимое окно FCenterFreq ± FSpanHz/2, и мы
// видим СВОЙ сигнал после PA (реальные IMD-плечи). При TXMode буфер покрывает
// FTXFreq ± FTXSpanHz/2 (цифровой TX-тракт — оставлено для общности).
// Окно поиска ±250 Гц вокруг ожидаемой частоты — ловим пик независимо от
// джиттера FFT.
var
SrcCount, i: Integer;
ToneAvg, MapLo, MapSpan: Double;
function PeakDB(FreqHz: Double): Double;
var C, Win, k, i1, i2: Integer;
begin
Result := -999.0;
C := Round((FreqHz - MapLo) / MapSpan * (SrcCount - 1));
// Ожидаемая частота вне окна буфера (зум/узкий span) — маркер невалиден,
// иначе намеряли бы уровень краевого бина.
if (C < 0) or (C > SrcCount - 1) then Exit;
Win := Max(2, Round(250.0 * (SrcCount - 1) / MapSpan));
i1 := Max(0, C - Win);
i2 := Min(SrcCount - 1, C + Win);
for k := i1 to i2 do
if FSpectrumBuf[k] > Result then Result := FSpectrumBuf[k];
end;
begin
Result := 0;
FIMDSummary := '';
if not FIMDActive then Exit;
if (FSpectrumBufCount < 2) or (Length(M) < 4) then Exit;
if FTXMode then
begin
if FTXSpanHz <= 0 then Exit;
MapLo := FTXFreq - FTXSpanHz * 0.5;
MapSpan := FTXSpanHz;
end
else
begin
if FSpanHz <= 0 then Exit;
MapLo := FCenterFreq - FSpanHz * 0.5;
MapSpan := FSpanHz;
end;
SrcCount := EnsureRange(FSpectrumBufCount, 2, WF_MAX_PIXELS);
M[0].FreqHz := FIMDTone1Hz; M[0].IsTone := True;
M[1].FreqHz := FIMDTone2Hz; M[1].IsTone := True;
M[2].FreqHz := 2 * FIMDTone1Hz - FIMDTone2Hz; M[2].IsTone := False;
M[3].FreqHz := 2 * FIMDTone2Hz - FIMDTone1Hz; M[3].IsTone := False;
for i := 0 to 3 do
M[i].LevelDB := PeakDB(M[i].FreqHz);
ToneAvg := (M[0].LevelDB + M[1].LevelDB) * 0.5;
// Все маркеры — абсолютный уровень шкалы (dBm, как в Thetis); относительная
// величина в dBc есть в сводке FIMDSummary, чтобы не путать единицы.
for i := 0 to 3 do
M[i].Caption := Format('%.0f', [M[i].LevelDB]);
// Сводка только когда оба тона и хотя бы один продукт в окне буфера
if (M[0].LevelDB > -500) and (M[1].LevelDB > -500) and
(Max(M[2].LevelDB, M[3].LevelDB) > -500) then
FIMDSummary := Format('IMD3 %.0f dBc',
[Max(M[2].LevelDB, M[3].LevelDB) - ToneAvg]);
Result := 4;
end;
procedure TSpectrumView.RawCircle(CX, CY, R: Integer; Color: TColor);
// Залитый кружок радиуса R: по строкам, ширина из уравнения окружности.
var
DY, HalfW, Y, X1, X2, K: Integer;
Px: LongWord;
P: PLongWord;
begin
if FRawBase = nil then Exit;
Px := RawPack(Color);
for DY := -R to R do
begin
Y := CY + DY;
if (Y < 0) or (Y >= FRawH) then Continue;
HalfW := Round(Sqrt(R * R - DY * DY));
X1 := Max(0, CX - HalfW);
X2 := Min(FRawW - 1, CX + HalfW);
if X2 < X1 then Continue;
P := PLongWord(FRawBase + Y * FRawBPL + X1 * 4);
for K := X1 to X2 do begin P^ := Px; Inc(P); end;
end;
end;
procedure TSpectrumView.DrawIMDMarkersRaw(W, H: Integer; DBmax, InvRange: Double);
const
CLR_TONE = TColor($0050FF50); // зелёный — основные тона
CLR_IMD = TColor($000A8CFF); // оранжевый — продукты IMD3
var
M: array[0..3] of TIMDMarker;
N, i, X, Y, TY, TW, BX1, BX2, BVX: Integer;
Col: TColor;
begin
if FSpanHz <= 0 then Exit;
N := ComputeIMDMarkers(M);
if N = 0 then Exit;
for i := 0 to N - 1 do
begin
if M[i].LevelDB < -500 then Continue; // частота вне окна буфера
X := Round((M[i].FreqHz - (FCenterFreq - FSpanHz / 2)) / FSpanHz * W);
if (X < 0) or (X >= W) then Continue;
Y := Max(0, Min(H - 1, Round((DBmax - M[i].LevelDB) * InvRange * H)));
// Все маркеры зелёные (dBm-замеры); оранжевый — только вычисленная
// сводка dBc, чтобы цвета не путались.
Col := CLR_TONE;
RawCircle(X, Y, 4, Col);
// Подпись по центру над своим кружком; у верхней кромки — под ним.
TW := RawTextWidth(M[i].Caption, 7, True);
TY := Y - 16;
if TY < 2 then TY := Y + 8;
RawText(Max(2, Min(W - TW - 2, X - TW div 2)), TY,
M[i].Caption, Col, 7, True, clNone);
end;
// Сводка слева от полосы фильтра, чтобы не прятаться за SampleRateOverlay
// в левом верхнем углу и сразу бросаться в глаза рядом с сигналом.
if FIMDSummary <> '' then
begin
TW := RawTextWidth(FIMDSummary, 11, True);
if FActiveVfo = 0 then CalcFilterBandX(FVfoA, W, BX1, BX2, BVX)
else CalcFilterBandX(FVfoB, W, BX1, BX2, BVX);
X := Max(2, Min(W - TW - 2, BX1 - TW - 8));
RawText(X, 6, FIMDSummary, CLR_IMD, 11, True, clNone);
end;
end;
// ════════════════════════════════════════════════════════════════════════════
// Full-raw примитивы кадра (валидны только между RawBegin/RawEnd)
// ════════════════════════════════════════════════════════════════════════════
procedure TSpectrumView.RawBegin;
var RI: TRawImage;
begin
FSpectrumBitmap.BeginUpdate(False);
RI := FSpectrumBitmap.RawImage;
FRawW := FSpectrumBitmap.Width;
FRawH := FSpectrumBitmap.Height;
FRawBPL := RI.Description.BytesPerLine;
FRawBase := RI.Data;
if (FRawBase <> nil) and
(RI.Description.LineOrder = riloBottomToTop) then
begin
// win32 DIB: строки снизу вверх — идём с последней с отрицательным шагом
FRawBase := FRawBase + (FRawH - 1) * FRawBPL;
FRawBPL := -FRawBPL;
end;
end;
procedure TSpectrumView.RawEnd;
begin
FRawBase := nil;
FSpectrumBitmap.EndUpdate(False);
end;
procedure TSpectrumView.RawVLine(X, Y1, Y2: Integer; Color: TColor;
LineW: Integer; OnPx: Integer; OffPx: Integer);
var
P: PLongWord;
RowP: PByte;
Y, K, Period: Integer;
Px: LongWord;
begin
if FRawBase = nil then Exit;
if X < 0 then begin Inc(LineW, X); X := 0; end;
if X + LineW > FRawW then LineW := FRawW - X;
if LineW <= 0 then Exit;
if Y1 < 0 then Y1 := 0;
if Y2 > FRawH - 1 then Y2 := FRawH - 1;
if Y2 < Y1 then Exit;
Px := RawPack(Color);
Period := OnPx + OffPx;
RowP := FRawBase + Y1 * FRawBPL + X * 4;
for Y := Y1 to Y2 do
begin
if (Period = 0) or ((Y mod Period) < OnPx) then
begin
P := PLongWord(RowP);
for K := 1 to LineW do begin P^ := Px; Inc(P); end;
end;
Inc(RowP, FRawBPL);
end;
end;
procedure TSpectrumView.RawHLine(Y, X1, X2: Integer; Color: TColor;
OnPx: Integer; OffPx: Integer);
var
P: PLongWord;
X, Period: Integer;
Px: LongWord;
begin
if FRawBase = nil then Exit;
if (Y < 0) or (Y >= FRawH) then Exit;
if X1 < 0 then X1 := 0;
if X2 > FRawW then X2 := FRawW;
if X2 <= X1 then Exit;
Px := RawPack(Color);
Period := OnPx + OffPx;
P := PLongWord(FRawBase + Y * FRawBPL + X1 * 4);
for X := X1 to X2 - 1 do
begin
if (Period = 0) or ((X mod Period) < OnPx) then P^ := Px;
Inc(P);
end;
end;
procedure TSpectrumView.RawFillRect(X1, Y1, X2, Y2: Integer; Color: TColor);
var
Y: Integer;
Px: LongWord;
begin
if FRawBase = nil then Exit;
if X1 < 0 then X1 := 0;
if Y1 < 0 then Y1 := 0;
if X2 > FRawW then X2 := FRawW;
if Y2 > FRawH then Y2 := FRawH;
if (X2 <= X1) or (Y2 <= Y1) then Exit;
Px := RawPack(Color);
for Y := Y1 to Y2 - 1 do
FillDWord((FRawBase + Y * FRawBPL + X1 * 4)^, X2 - X1, Px);
end;
// Треугольник остриём вниз (курсор VFO): вершина основания на Y=0.
procedure TSpectrumView.RawTriangleDown(CX, HalfW, Hgt: Integer; Color: TColor);
var
Y, Half: Integer;
begin
for Y := 0 to Hgt do
begin
Half := Round(HalfW * (Hgt - Y) / Hgt);
RawHLine(Y, CX - Half, CX + Half + 1, Color);
end;
end;
// Кривая спектра: вертикальный сегмент в каждой колонке от Y предыдущей
// точки до текущей — классический connected-line без Canvas.Polyline.
procedure TSpectrumView.RawCurve(W: Integer; Color: TColor);
var
X, Cur, Prev, Y0, Y1, Y: Integer;
Px: LongWord;
P: PByte;
begin
if (FRawBase = nil) or (W < 1) or (Length(FSpPts) < W) then Exit;
if W > FRawW then W := FRawW;
Px := RawPack(Color);
Prev := FSpPts[0].Y;
for X := 0 to W - 1 do
begin
Cur := FSpPts[X].Y;
if Cur < Prev then begin Y0 := Cur; Y1 := Prev; end
else begin Y0 := Prev; Y1 := Cur; end;
if Y0 < 0 then Y0 := 0;
if Y1 > FRawH - 1 then Y1 := FRawH - 1;
P := FRawBase + Y0 * FRawBPL + X * 4;
for Y := Y0 to Y1 do
begin
PLongWord(P)^ := Px;
Inc(P, FRawBPL);
end;
Prev := Cur;
end;
end;
function TSpectrumView.GetTextMask(const S: string; FontSize: Integer;
Bold: Boolean): TBitmap;
const
MAX_MASKS = 48;
var
i, Oldest: Integer;
Key: string;
B: TBitmap;
TW, TH: Integer;
procedure ApplyFont(Cv: TCanvas);
begin
Cv.Font.Name := 'Courier New';
Cv.Font.Size := FontSize;
if Bold then Cv.Font.Style := [fsBold] else Cv.Font.Style := [];
end;
begin
Inc(FTextTick);
Key := Format('%d|%d|%s', [FontSize, Ord(Bold), S]);
for i := 0 to High(FTextMasks) do
if FTextMasks[i].Key = Key then
begin
FTextMasks[i].LastUse := FTextTick;
Exit(FTextMasks[i].Bmp);
end;
// Рендер маски: белый текст на чёрном (единственное место, где текст
// проходит через Canvas — на собственном маленьком битмапе, один раз).
B := TBitmap.Create;
B.PixelFormat := pf32bit;
B.SetSize(4, 4);
ApplyFont(B.Canvas);
TW := Max(1, B.Canvas.TextWidth(S));
TH := Max(1, B.Canvas.TextHeight(S));
B.SetSize(TW, TH);
ApplyFont(B.Canvas);
B.Canvas.Brush.Color := clBlack; B.Canvas.Brush.Style := bsSolid;
B.Canvas.FillRect(Rect(0, 0, TW, TH));
B.Canvas.Font.Color := clWhite;
B.Canvas.Brush.Style := bsClear;
B.Canvas.TextOut(0, 0, S);
if Length(FTextMasks) >= MAX_MASKS then
begin
// LRU-вытеснение (маркерная метка при drag плодит новые строки)
Oldest := 0;
for i := 1 to High(FTextMasks) do
if FTextMasks[i].LastUse < FTextMasks[Oldest].LastUse then Oldest := i;
FTextMasks[Oldest].Bmp.Free;
FTextMasks[Oldest].Key := Key;
FTextMasks[Oldest].Bmp := B;
FTextMasks[Oldest].LastUse := FTextTick;
end else
begin
SetLength(FTextMasks, Length(FTextMasks) + 1);
FTextMasks[High(FTextMasks)].Key := Key;
FTextMasks[High(FTextMasks)].Bmp := B;
FTextMasks[High(FTextMasks)].LastUse := FTextTick;
end;
Result := B;
end;
function TSpectrumView.RawTextWidth(const S: string; FontSize: Integer;
Bold: Boolean): Integer;
begin
Result := GetTextMask(S, FontSize, Bold).Width;
end;
procedure TSpectrumView.RawText(X, Y: Integer; const S: string; Color: TColor;
FontSize: Integer; Bold: Boolean; BgColor: TColor);
var
M: TBitmap;
MX, MY, TY, A, InvA: Integer;
SrcRow, P: PByte;
CR, CG, CB: Byte;
begin
if FRawBase = nil then Exit;
M := GetTextMask(S, FontSize, Bold);
if BgColor <> clNone then
RawFillRect(X, Y, X + M.Width, Y + M.Height, BgColor);
CR := Color and $FF; CG := (Color shr 8) and $FF; CB := (Color shr 16) and $FF;
M.BeginUpdate(False);
try
for MY := 0 to M.Height - 1 do
begin
TY := Y + MY;
if (TY < 0) or (TY >= FRawH) then Continue;
SrcRow := PByte(M.ScanLine[MY]);
if SrcRow = nil then Continue;
for MX := 0 to M.Width - 1 do
begin
if (X + MX >= 0) and (X + MX < FRawW) then
begin
{$IFDEF DARWIN}
A := SrcRow[2]; // G-канал маски (текст белый ⇒ покрытие)
{$ELSE}
A := SrcRow[1];
{$ENDIF}
if A > 0 then
begin
InvA := 255 - A;
P := FRawBase + TY * FRawBPL + (X + MX) * 4;
{$IFDEF DARWIN}
P[1] := Byte((CR * A + P[1] * InvA) div 255);
P[2] := Byte((CG * A + P[2] * InvA) div 255);
P[3] := Byte((CB * A + P[3] * InvA) div 255);
P[0] := $FF;
{$ELSE}
P[0] := Byte((CB * A + P[0] * InvA) div 255);
P[1] := Byte((CG * A + P[1] * InvA) div 255);
P[2] := Byte((CR * A + P[2] * InvA) div 255);
P[3] := $FF;
{$ENDIF}
end;
end;
Inc(SrcRow, 4);
end;
end;
finally
M.EndUpdate(False);
end;
end;
procedure TSpectrumView.BlendBand(X1, X2, H: Integer; R, G, B, Alpha: Byte);
var
Y, X, InvA: Integer;
Row: PByte;
W: Integer;
begin
if (FSpectrumBitmap = nil) or (Alpha = 0) then Exit;
W := FSpectrumBitmap.Width;
if X1 < 0 then X1 := 0;
if X2 > W then X2 := W;
if X2 <= X1 then Exit;
InvA := 255 - Alpha;
FSpectrumBitmap.BeginUpdate(False);
try
for Y := 0 to H - 1 do
begin
Row := PByte(FSpectrumBitmap.ScanLine[Y]);
if Row = nil then Continue;
Inc(Row, X1 * 4);
for X := X1 to X2 - 1 do
begin
{$IFDEF DARWIN}
Row[1] := Byte((Alpha * R + InvA * Row[1]) div 255);
Row[2] := Byte((Alpha * G + InvA * Row[2]) div 255);
Row[3] := Byte((Alpha * B + InvA * Row[3]) div 255);
{$ELSE}
Row[0] := Byte((Alpha * B + InvA * Row[0]) div 255);
Row[1] := Byte((Alpha * G + InvA * Row[1]) div 255);
Row[2] := Byte((Alpha * R + InvA * Row[2]) div 255);
{$ENDIF}
Inc(Row, 4);
end;
end;
finally
FSpectrumBitmap.EndUpdate(False);
end;
end;
// Непрозрачная вертикальная полоса через raw-доступ (ScanLine) — замена
// Canvas.FillRect для полосы фильтра в DrawSpectrum: полоса рисуется в
// raw-фазе (между memcpy сетки и градиентом), а FillRect дёргал бы Canvas
// и форсил лишнюю синхронизацию битмапа на Qt6.
procedure TSpectrumView.FillBandRaw(X1, X2, H: Integer; Color: TColor);
var
Y, W: Integer;
Row: PLongWord;
Px: LongWord;
R, G, B: Byte;
begin
if FSpectrumBitmap = nil then Exit;
W := FSpectrumBitmap.Width;
if X1 < 0 then X1 := 0;
if X2 > W then X2 := W;
if X2 <= X1 then Exit;
R := Color and $FF; G := (Color shr 8) and $FF; B := (Color shr 16) and $FF;
{$IFDEF DARWIN}
// ARGB в памяти (см. BlendBand): байт 0 = альфа, дальше R,G,B.
Px := LongWord($FF) or (LongWord(R) shl 8) or (LongWord(G) shl 16) or
(LongWord(B) shl 24);
{$ELSE}
// BGRA в памяти: байты B,G,R,A.
Px := LongWord(B) or (LongWord(G) shl 8) or (LongWord(R) shl 16) or $FF000000;
{$ENDIF}
FSpectrumBitmap.BeginUpdate(False);
try
for Y := 0 to H - 1 do
begin
Row := PLongWord(FSpectrumBitmap.ScanLine[Y]);
if Row = nil then Continue;
Inc(Row, X1);
FillDWord(Row^, X2 - X1, Px);
end;
finally
FSpectrumBitmap.EndUpdate(False);
end;
end;
// Маркер фильтра каждого слайса (B+) на спектре — полупрозрачная полоса
// пропускания + края + центральная несущая. Янтарный цвет, как в GL-вьюхе
// (SpectrumViewOpengl.DrawSliceFilterMarkers). Полосы (raw ScanLine-блендинг)
// и линии/буквы (canvas) разнесены по разным процедурам — их зовут из разных
// фаз DrawSpectrum, чтобы не чередовать режимы доступа к битмапу.
procedure TSpectrumView.DrawSliceFilterBands(W, H: Integer);
var
i, SX1, SX2, SVfoX: Integer;
O: TVfoOverlay;
Clr: TColor;
begin
for i := 0 to FSliceOverlays.Count - 1 do
begin
O := TVfoOverlay(FSliceOverlays[i]);
if (O = nil) or (not O.Visible) then Continue;
// Передающий слайс — красная полоса (как у главного при TX), иначе бейдж-цвет.
if O.TxActive then Clr := CLR_TX_BAND
else Clr := SliceColor(O.SliceLetter); // $00BBGGRR
CalcFilterBandXFor(O.DisplayVfoHz, O.DisplayMode, O.DisplayBW, W, SX1, SX2, SVfoX);
if SX2 > SX1 then
BlendBand(SX1, SX2, H, Clr and $FF, (Clr shr 8) and $FF, (Clr shr 16) and $FF,
IfThen(O.TxActive, 100, 60));
end;
end;
procedure TSpectrumView.DrawSliceFilterLinesRaw(W, H: Integer);
var
i, SX1, SX2, SVfoX: Integer;
O: TVfoOverlay;
Clr: TColor;
begin
for i := 0 to FSliceOverlays.Count - 1 do
begin
O := TVfoOverlay(FSliceOverlays[i]);
if (O = nil) or (not O.Visible) then Continue;
if O.TxActive then Clr := CLR_TX_BAND // передающий слайс
else Clr := SliceColor(O.SliceLetter); // оттенок бейджа слайса
CalcFilterBandXFor(O.DisplayVfoHz, O.DisplayMode, O.DisplayBW, W, SX1, SX2, SVfoX);
RawVLine(SX1, 0, H - 1, Clr);
RawVLine(SX2, 0, H - 1, Clr);
RawVLine(SVfoX, 0, H - 13, Clr, 2); // несущая (жирнее)
// Буква слайса внутри полосы фильтра сверху — привязка полосы к флагу,
// цвет = цвет слайса (совпадает с бейджем во флаге).
DrawBandLetterRaw(SX1, SX2, O.SliceLetter, SliceColor(O.SliceLetter));
end;
end;
// Буква слайса (A/B/…) по центру полосы фильтра, у самого верха — чтобы
// понять, какому флагу принадлежит полоса, даже когда флаги стоят рядом.
procedure TSpectrumView.DrawBandLetterRaw(X1, X2: Integer; L: Char; Clr: TColor);
var
cx: Integer;
begin
if (L < 'A') or (L > 'Z') then Exit;
cx := (X1 + X2) div 2;
RawText(cx - RawTextWidth(L, 8, True) div 2, 0, L, Clr, 8, True, clNone);
end;
procedure TSpectrumView.CopyGridToSpectrum(W, H: Integer);
var
Y: Integer;
Src, Dst: PByte;
begin
if (FSpectrumBitmap = nil) or (FGridBitmap = nil) then Exit;
if (W <= 0) or (H <= 0) then Exit;
{$IFDEF DARWIN}
// On macOS/Cocoa, Canvas writes into a CGBitmapContext; ScanLine reads the
// raw backing buffer which is not synced until BeginUpdate is called on the
// source bitmap. Canvas.Draw goes through CoreGraphics and sees the live
// CGContext, so use it instead of the direct ScanLine copy.
FSpectrumBitmap.Canvas.Draw(0, 0, FGridBitmap);
{$ELSE}
FSpectrumBitmap.BeginUpdate(False);
try
for Y := 0 to H - 1 do
begin
Src := PByte(FGridBitmap.ScanLine[Y]);
Dst := PByte(FSpectrumBitmap.ScanLine[Y]);
if (Src <> nil) and (Dst <> nil) then
Move(Src^, Dst^, W * 4);
end;
finally
FSpectrumBitmap.EndUpdate(False);
end;
{$ENDIF}
end;
procedure TSpectrumView.DrawADCOverloadRaw(W, H: Integer);
// Плашка ADC OVERLOAD: общий с GL-рендером образ (AlertOverlay.BuildAlertImage,
// строится один раз и кэшируется), в кадре — только straight-alpha бленд
// внутри RawBegin/RawEnd: без Canvas (дорогой raw↔canvas синк Qt6) и без
// пофреймового восстановления альфы всего битмапа.
begin
if not FADCOverloadVisible then Exit;
if (W < 220) or (H < 60) or (FRawBase = nil) then Exit;
if FADCAlertImg.W = 0 then
BuildAlertImage('ADC OVERLOAD', 'Input clipping detected', FADCAlertImg);
BlendAlertImage(FADCAlertImg, FRawBase, FRawBPL, FRawW, FRawH,
W - ALERT_PAD - FADCAlertImg.W, ALERT_PAD);
end;
procedure TSpectrumView.CalcFilterBandX(VfoFreq: Double; W: Integer;
out X1, X2, VfoX: Integer);
begin
CalcFilterBandXFor(VfoFreq, FMode, FFilterBW, W, X1, X2, VfoX);
end;
// То же, но для произвольного режима/полосы (маркеры слайсов).
procedure TSpectrumView.CalcFilterBandXFor(VfoFreq: Double; Mode, BW, W: Integer;
out X1, X2, VfoX: Integer);
var
Lo_Hz, Hi_Hz, Half: Double;
begin
Half := BW / 2;
VfoX := Round((VfoFreq - FCenterFreq + FSpanHz / 2) / FSpanHz * W);
case Mode of
MODE_LSB: begin Lo_Hz := -BW; Hi_Hz := -100; end;
MODE_USB: begin Lo_Hz := 100; Hi_Hz := BW; end;
MODE_DIGL: begin Lo_Hz := -BW; Hi_Hz := 0; end; // полоса от нуля
MODE_DIGU: begin Lo_Hz := 0; Hi_Hz := BW; end;
else begin Lo_Hz := -Half; Hi_Hz := Half; end;
end;
X1 := Max(0, Min(W - 1, VfoX + Round(Lo_Hz / FSpanHz * W)));
X2 := Max(0, Min(W - 1, VfoX + Round(Hi_Hz / FSpanHz * W)));
end;
procedure TSpectrumView.DrawSpectrumGradient(const SpPts: array of TPoint; W, H: Integer);
// Дворд-блендинг: цвет и альфа постоянны в пределах строки → произведения
// source-лейнов считаются один раз на строку, в пиксельном цикле остаются
// два умножения на dst-лейны (/256 вместо /200-базы оригинала, кривая
// прозрачности та же — квадратичная). Побайтовый вариант стоил ~1.6мс/кадр.
var
Row, Col, Alpha, YMin, A256, I256: Integer;
RowPtr: PLongWord;
GradB, GradG, GradR: Byte;
SrcPx, SrcLo, SrcHi, D: LongWord;
begin
if FSpectrumBitmap = nil then Exit;
if (W <= 0) or (H <= 0) then Exit;
YMin := H;
for Col := 0 to W - 1 do
if SpPts[Col].Y < YMin then YMin := SpPts[Col].Y;
if YMin >= H then Exit;
FSpectrumBitmap.BeginUpdate(False);
for Row := YMin to H - 1 do
begin
Alpha := Round((1.0 - Sqr((Row - YMin) / Max(1.0, H - YMin - 1.0))) * 200);
if Alpha <= 0 then Continue;
if Alpha > 200 then Alpha := 200;
GradB := Byte(FTheme.SpecGradB * Alpha div 200);
GradG := Byte(FTheme.SpecGradG * Alpha div 200);
GradR := Byte(FTheme.SpecGradR * Alpha div 200);
// Альфа 0..200 → 0..256; source-лейны умножаются здесь, один раз на строку
A256 := (Alpha * 256 + 100) div 200;
I256 := 256 - A256;
SrcPx := RawPack(TColor(GradR or (LongWord(GradG) shl 8) or
(LongWord(GradB) shl 16)));
SrcLo := (SrcPx and $00FF00FF) * LongWord(A256);
SrcHi := ((SrcPx shr 8) and $00FF00FF) * LongWord(A256);
RowPtr := PLongWord(FSpectrumBitmap.ScanLine[Row]);
for Col := 0 to W - 1 do
begin
if SpPts[Col].Y <= Row then
begin
D := RowPtr^;
RowPtr^ := (((SrcLo + (D and $00FF00FF) * LongWord(I256)) shr 8)
and $00FF00FF)
or ((SrcHi + ((D shr 8) and $00FF00FF) * LongWord(I256))
and $FF00FF00)
{$IFDEF DARWIN}
or $000000FF;
{$ELSE}
or $FF000000;
{$ENDIF}
end;
Inc(RowPtr);
end;
end;
FSpectrumBitmap.EndUpdate(False);
end;
// ────────────────────────────────────────────────────────────────────────────
// Публичные методы данных
// ────────────────────────────────────────────────────────────────────────────
procedure TSpectrumView.SetSpectrumData(const Pixels: array of Single; Count: Integer);
var i, N: Integer;
begin
N := Min(Count, WF_MAX_PIXELS);
for i := 0 to N - 1 do FSpectrumBuf[i] := Pixels[i];
FSpectrumBufCount := N;
FSpectrumDirty := True;
end;
procedure TSpectrumView.SetWaterfallData(const Pixels: array of Single; Count: Integer);
begin
FWaterfall.SetWaterfallData(Pixels, Count);
end;
// ────────────────────────────────────────────────────────────────────────────
// Размеры bitmap
// ────────────────────────────────────────────────────────────────────────────
procedure TSpectrumView.SetSpectrumBitmapSize(W, H: Integer);
begin
if (W <= 0) or (H <= 0) then Exit;
FSpectrumBitmap.SetSize(W, H);
FSpectrumBitmap.Canvas.Brush.Color := FTheme.BG;
FSpectrumBitmap.Canvas.FillRect(Rect(0, 0, W, H));
InvalidateGridCache;
FSpPtsLen := 0;
end;
procedure TSpectrumView.SetWaterfallBitmapSize(W, H: Integer);
begin
FWaterfall.SetWaterfallBitmapSize(W, H);
end;
procedure TSpectrumView.SetRulerSize(W, H: Integer);
begin
FRuler.SetRulerSize(W, H);
end;
function TSpectrumView.SpectrumBitmapWidth: Integer;
begin
Result := FSpectrumBitmap.Width;
end;
// ────────────────────────────────────────────────────────────────────────────
// Утилиты
// ────────────────────────────────────────────────────────────────────────────
procedure TSpectrumView.InvalidateGridCache;
begin
FGridBitmapW := 0; FGridBitmapH := 0;
FSpectrumDirty := True;
end;
procedure TSpectrumView.InvalidateOverlayCache;
begin
FSpectrumDirty := True;
end;
procedure TSpectrumView.InvalidateVfoOverlay;
begin
// База (CPU-путь) перерисовывает флаг по FCacheDirty/FMeterDirty оверлея — здесь
// достаточно пометить спектр грязным. GL-подкласс переопределяет.
FSpectrumDirty := True;
end;
procedure TSpectrumView.SetTheme(const T: TAppTheme);
begin
FTheme := T;
FLightTheme := T.BG > TColor($00808080);
InvalidateGridCache;
FWaterfall.SetTheme(T);
FSMeter.SetTheme(T);
FRuler.SetTheme(T);
end;
procedure TSpectrumView.InvalidateRulerCache;
begin
FRuler.InvalidateRulerCache;
end;
procedure TSpectrumView.ResetSpectrumBuf;
var i: Integer;
begin
for i := 0 to High(FSpectrumBuf) do FSpectrumBuf[i] := -130.0;
FWaterfall.ResetWfBuf;
end;
procedure TSpectrumView.ResetWfAvgBuf;
begin
FWaterfall.ResetWfAvgBuf;
end;
procedure TSpectrumView.ClearWaterfall;
// Сброс истории водопада (GL: пересоздать текстуру). Нужен при смене палитры/
// gamma: GL-водопад хранит УЖЕ раскрашенные пиксели, старые строки иначе
// остаются в прежней палитре, и смена/сброс выглядят как «не сработало».
begin
FWaterfall.ResetWfBuf;
end;
procedure TSpectrumView.FillDemoSpectrum;
var i: Integer; FreqOff, Noise, Sig: Double; W: Integer;
begin
W := FSpectrumBitmap.Width;
if W <= 0 then W := 1024;
for i := 0 to W - 1 do
begin
if W > 1 then FreqOff := (i / (W - 1) - 0.5) * FSpanHz
else FreqOff := 0;
Noise := -110 + (Random - 0.5) * 6;
if Abs(FreqOff) < 2000 then Sig := -50 - Abs(FreqOff) / 200
else Sig := -999;
FSpectrumBuf[i mod WF_MAX_PIXELS] := Max(Noise, Sig);
end;
end;
function TSpectrumView.NeedsRulerRedraw: Boolean;
begin
Result := FRuler.NeedsRulerRedraw;
end;
// ────────────────────────────────────────────────────────────────────────────
// DrawSpectrum
// ────────────────────────────────────────────────────────────────────────────
procedure TSpectrumView.DrawSpectrum;
var
C, GC: TCanvas;
i, Yp, W, H, GX: Integer;
{$IFNDEF DARWIN}
RowLW: PLongWord;
{$ENDIF}
DBmin, DBmax, dB: Double;
VfoX, X1, X2: Integer;
TXVfoX, TXX1, TXX2: Integer;
AGCy, AGCHangY: Integer;
SrcF, Frac, dBv: Double;
S0, S1: Integer;
InvRange: Double;
LabelBandW, SrcCount: Integer;
GridFreqS, GridLine, pixPerStep: Double;
N, gridMult: Integer;
begin
if FSpectrumBitmap = nil then Exit;
W := FSpectrumBitmap.Width; H := FSpectrumBitmap.Height;
if (W <= 0) or (H <= 0) then Exit;
C := FSpectrumBitmap.Canvas;
DBmax := FSpecRefLevel;
DBmin := FSpecRefLevel - FSpecRange;
InvRange := 1.0 / (DBmax - DBmin);
// ── 1. Фон+сетка из кэша ──────────────────────────────────────────────────
if (FGridBitmapW <> W) or (FGridBitmapH <> H) or
((FFMGridStepHz > 0) and
((Abs(FCenterFreq - FFMGridLastCenter) > 0.5) or
(FFMGridStepHz <> FFMGridLastStepHz) or
(Abs(FSpanHz - FFMGridLastSpan) > 1.0))) then
begin
FGridBitmapW := W; FGridBitmapH := H;
FFMGridLastCenter := FCenterFreq;
FFMGridLastStepHz := FFMGridStepHz;
FFMGridLastSpan := FSpanHz;
FGridBitmap.SetSize(W, H);
GC := FGridBitmap.Canvas;
PaintVerticalGradient(GC, W, H, FTheme.SpecGradTop, FTheme.SpecGradBot);
LabelBandW := 28;
GC.Pen.Style := psClear; GC.Brush.Style := bsSolid;
GC.Brush.Color := FTheme.SpecLabelBand;
GC.FillRect(Rect(0, 0, LabelBandW, H));
GC.Pen.Style := psSolid;
GC.Font.Size := 7; GC.Font.Name := 'Courier New';
GC.Font.Color := FTheme.SpecLabelText;
GC.Brush.Style := bsClear;
dB := DBmax - FSpecGridStep;
while dB >= DBmin do
begin
Yp := Round((DBmax - dB) * InvRange * H);
GC.Pen.Color := FTheme.SpecGrid; GC.Pen.Width := 1;
GC.MoveTo(0, Yp); GC.LineTo(W-1, Yp);
GC.TextOut(1, Yp - 9, Format('%4.0f', [dB]));
dB := dB - FSpecGridStep;
end;
if FFMGridStepHz > 0 then
begin
GridFreqS := FCenterFreq - FSpanHz / 2;
pixPerStep := W * FFMGridStepHz / FSpanHz;
if pixPerStep >= 1.0 then
gridMult := Max(1, Ceil(4.0 / pixPerStep))
else
gridMult := 0;
if gridMult > 0 then
begin
N := Ceil(GridFreqS / FFMGridStepHz);
GridLine := N * FFMGridStepHz;
while GridLine <= FCenterFreq + FSpanHz / 2 + 0.5 do
begin
if (N mod gridMult) = 0 then
begin
GX := Round((GridLine - GridFreqS) / FSpanHz * W);
if (GX >= 0) and (GX < W) then
begin
GC.Pen.Color := FTheme.SpecGrid;
GC.MoveTo(GX, 0); GC.LineTo(GX, H);
end;
end;
Inc(N);
GridLine := GridLine + FFMGridStepHz;
end;
end;
end else
begin
for i := 0 to 8 do
begin
GX := ScaleX(i, 8, W);
GC.Pen.Color := FTheme.SpecGrid;
GC.MoveTo(GX, 0); GC.LineTo(GX, H);
end;
end;
{$IFNDEF DARWIN}
// Альфа кэша сетки → $FF один раз после ребилда: canvas-текст/AA на Qt6
// оставляют битую альфу, а кадр копирует её memcpy как есть. Пофреймовый
// OR-проход по кадру удалён — на битмапе кадра Canvas больше не бывает.
FGridBitmap.BeginUpdate(False);
for i := 0 to H - 1 do
begin
RowLW := PLongWord(FGridBitmap.ScanLine[i]);
if RowLW = nil then Continue;
for Yp := 0 to W - 1 do
begin
RowLW^ := RowLW^ or $FF000000;
Inc(RowLW);
end;
end;
FGridBitmap.EndUpdate(False);
{$ENDIF}
end;
// ═══ Фаза 0: чистые вычисления — битмап не трогаем ═══════════════════════
// Дальше битмап обрабатывается тремя непрерывными фазами: raw (ScanLine) →
// canvas (QPainter) → raw. Чередование режимов доступа на Qt6 форсит
// дорогую синхронизацию всего битмапа на каждом переходе (замерено: полоса
// фильтра в пару тысяч пикселей стоила 4× дороже полного memcpy кадра),
// поэтому порядок операций здесь важнее «логичной» группировки по смыслу.
// Полоса фильтра (X-координаты главного и TX-VFO)
if FActiveVfo = 0 then CalcFilterBandX(FVfoA, W, X1, X2, VfoX)
else CalcFilterBandX(FVfoB, W, X1, X2, VfoX);
TXX1 := 0; TXX2 := 0; TXVfoX := 0;
if FTXOverlay and (FTXVfoIndex <> FActiveVfo) then
begin
if FTXVfoIndex = 0 then CalcFilterBandX(FVfoA, W, TXX1, TXX2, TXVfoX)
else CalcFilterBandX(FVfoB, W, TXX1, TXX2, TXVfoX);
end;
// Точки кривой спектра
if FSpPtsLen <> W + 2 then
begin SetLength(FSpPts, W + 2); FSpPtsLen := W + 2; end;
SrcCount := EnsureRange(FSpectrumBufCount, 2, WF_MAX_PIXELS);
if FTXMode and (FTXSpanHz > 0) and (FSpanHz > 0) then
begin
for i := 0 to W - 1 do
begin
SrcF := FCenterFreq - FSpanHz * 0.5 + i * FSpanHz / Max(1, W - 1);
Frac := SrcF - FTXFreq;
if (Frac < -FTXSpanHz * 0.5) or (Frac > FTXSpanHz * 0.5) then
dBv := -200.0
else
begin
SrcF := (Frac + FTXSpanHz * 0.5) / FTXSpanHz * (SrcCount - 1);
S0 := Min(Trunc(SrcF), SrcCount - 1);
S1 := Min(S0 + 1, SrcCount - 1);
Frac := SrcF - S0;
dBv := FSpectrumBuf[S0] * (1.0 - Frac) + FSpectrumBuf[S1] * Frac;
end;
FSpPts[i] := Point(i, Max(0, Min(H-1, Round((DBmax - dBv) * InvRange * H))));
end;
end else
for i := 0 to W - 1 do
begin
SrcF := i * (SrcCount - 1.0) / Max(1, W - 1);
S0 := Min(Trunc(SrcF), SrcCount - 1);
S1 := Min(S0 + 1, SrcCount - 1);
Frac := SrcF - S0;
dBv := FSpectrumBuf[S0] * (1.0 - Frac) + FSpectrumBuf[S1] * Frac;
FSpPts[i] := Point(i, Max(0, Min(H-1, Round((DBmax - dBv) * InvRange * H))));
end;
FSpPts[W] := Point(W-1, H); FSpPts[W+1] := Point(0, H);
// ═══ Фаза 1: raw — весь кадр одним локом ═════════════════════════════════
{$IFDEF DARWIN}
// Cocoa-вариант CopyGridToSpectrum идёт через Canvas.Draw — до RawBegin.
CopyGridToSpectrum(W, H);
{$ENDIF}
RawBegin;
try
{$IFNDEF DARWIN}
CopyGridToSpectrum(W, H);
{$ENDIF}
// Полосы фильтра
if FTXOverlay then
begin
if FTXVfoIndex <> FActiveVfo then
begin
if X2 > X1 then BlendBand(X1, X2, H, $30, $C0, $30, 100);
if TXX2 > TXX1 then BlendBand(TXX1, TXX2, H, $E0, $30, $30, 100);
end else
if X2 > X1 then BlendBand(X1, X2, H, $E0, $30, $30, 100);
end else
if X2 > X1 then FillBandRaw(X1, X2, H, FTheme.SpecFilter);
// Полосы фильтра слайсов (B+) — под градиентом/кривой, как в GL-вьюхе.
DrawSliceFilterBands(W, H);
// Градиент (заливка под кривой)
if FFillSpectrum then
DrawSpectrumGradient(FSpPts, W, H);
// Буква главного флага (A) на его полосе — только когда есть слайсы,
// иначе одиночный приём не засоряем.
if (FSliceOverlays <> nil) and (FSliceOverlays.Count > 0) and
(FActiveVfo = 0) and Assigned(FVfoOverlay) then
DrawBandLetterRaw(X1, X2, FVfoOverlay.SliceLetter,
SliceColor(FVfoOverlay.SliceLetter));
// Края/несущие/буквы слайсов (полосы уже нарисованы выше).
DrawSliceFilterLinesRaw(W, H);
// AGC линии. Подпись с фоном цвета полосы фильтра — как рисовал старый
// canvas-TextOut с кистью bsSolid/SpecFilter.
if FWDSPReady then
begin
AGCy := Round((DBmax - FAGCThresh) * InvRange * H);
if (AGCy >= 0) and (AGCy < H) then
begin
RawHLine(AGCy, 0, W, FTheme.SpecAgcColor, 4, 2); // psDash
RawText(4, AGCy - 9, 'AGC T', FTheme.SpecAgcColor, 6, False,
FTheme.SpecFilter);
end;
AGCHangY := Round((DBmax - FAGCHangLevel) * InvRange * H);
if (AGCHangY >= 0) and (AGCHangY < H) and (Abs(AGCHangY - AGCy) > 4) then
begin
RawHLine(AGCHangY, 0, W, FTheme.SpecAgcHangColor, 1, 2); // psDot
RawText(4, AGCHangY + 2, 'AGC H', FTheme.SpecAgcHangColor, 6, False,
FTheme.SpecFilter);
end;
end else begin
AGCy := Round((DBmax - (-FAGCTop)) * InvRange * H);
if (AGCy >= 0) and (AGCy < H) then
begin
RawHLine(AGCy, 0, W, FTheme.SpecAgcColor, 4, 2); // psDash
RawText(4, AGCy - 9, Format('AGC -%ddB', [FAGCTop]),
FTheme.SpecAgcColor, 6, False, FTheme.SpecFilter);
end;
end;
// Линия спектра
RawCurve(W, FTheme.SpecLine);
// Края фильтра + VFO
RawVLine(X1, 0, H - 1, FTheme.SpecFilterEdge);
RawVLine(X2, 0, H - 1, FTheme.SpecFilterEdge);
RawVLine(VfoX, 0, H - 13, FTheme.SpecVfoCursor, 2);
RawTriangleDown(VfoX, 5, 8, FTheme.SpecVfoCursor);
if FTXOverlay and (FTXVfoIndex <> FActiveVfo) then
begin
RawVLine(TXX1, 0, H - 1, TColor($002030E0));
RawVLine(TXX2, 0, H - 1, TColor($002030E0));
RawVLine(TXVfoX, 0, H - 13, TColor($002030E0), 2);
RawTriangleDown(TXVfoX, 5, 8, TColor($002030E0));
end;
if FMarkerActive then DrawMarkerLineRaw(W, H);
if FBeaconMarkActive or FBeaconDecActive then DrawBeaconMarkersRaw(W, H);
// 2TON: кружки с уровнями на пиках тонов/IMD3 (активирует MainForm при
// 2TON+TX+DUP — реальный сигнал после PA виден на RX-спектре)
if FIMDActive then DrawIMDMarkersRaw(W, H, DBmax, InvRange);
// Композиты оверлеев — внутри внешнего лока: их собственные BeginUpdate/
// EndUpdate становятся вложенными (только счётчик), иначе каждая пара на
// верхнем уровне заново дёргает handle-менеджмент битмапа (~0.3-0.4мс на
// пару — замерено 1.8мс на кадр при пиксельной работе на ~0.15мс).
// Spectrum-канва внутри не трогается: SampleRateOverlay меряет текст на
// собственном скретч-битмапе (параметр C — рудимент), кэши флагов
// рендерятся на своих битмапах.
// Бэндплан QO-100 — полоска внизу спектра, под панелями оверлеев.
if Assigned(FBandPlanOverlay) then
FBandPlanOverlay.DrawOverlay(FSpectrumBitmap, W, H);
if Assigned(FSampleRateOverlay) then
FSampleRateOverlay.DrawOverlay(FSpectrumBitmap, C, W, H);
if Assigned(FVfoOverlay) then
FVfoOverlay.DrawOverlay(FSpectrumBitmap, W, H);
// Доп. слайс-флаги (B+) поверх главного.
for i := 0 to FSliceOverlays.Count - 1 do
TVfoOverlay(FSliceOverlays[i]).DrawOverlay(FSpectrumBitmap, W, H);
DrawADCOverloadRaw(W, H);
finally
RawEnd;
end;
end;
// ────────────────────────────────────────────────────────────────────────────
// Делегирование к sub-views
// ────────────────────────────────────────────────────────────────────────────
procedure TSpectrumView.DrawWaterfall;
begin
FWaterfall.DrawWaterfall;
end;
procedure TSpectrumView.DrawRuler;
begin
FRuler.DrawRuler;
end;
// ────────────────────────────────────────────────────────────────────────────
// Paint-обработчики
// ────────────────────────────────────────────────────────────────────────────
procedure TSpectrumView.PaintSpectrum(Sender: TObject);
var
PB: TPaintBox;
begin
PB := TPaintBox(Sender);
PB.Canvas.Draw(0, 0, FSpectrumBitmap);
end;
procedure TSpectrumView.PaintWaterfall(Sender: TObject);
begin
FWaterfall.PaintWaterfall(Sender);
end;
procedure TSpectrumView.PaintRuler(Sender: TObject);
begin
FRuler.PaintRuler(Sender);
end;
procedure TSpectrumView.PaintSMeterRight(Sender: TObject);
begin
FSMeter.PaintSMeterRight(Sender);
end;
end.