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; // '||' 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 (2f1−f2, 2f2−f1). Обновляет 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.