unit SpectrumView; { SpectrumView.pas — рендеринг спектрограммы. TSpectrumView инкапсулирует рисование спектра и агрегирует дочерние компоненты: TWaterfallView, TSMeterView, TRulerView. MainForm создаёт один экземпляр TSpectrumView и работает с ним единообразно: свойства/методы водопада, S-метра и линейки делегируются в соответствующие sub-view. Зависимости: нет обратной зависимости на MainForm. } {$IFDEF FPC} {$MODE Delphi} {$ENDIF} interface uses Classes, SysUtils, Graphics, ExtCtrls, Controls, Math, AppTheme, AlertOverlay, SampleRateOverlay, VfoOverlay, WaterfallView, SMeterView, RulerView; const SV_CLR_BG = TColor($00101010); type 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; // ── Тема ───────────────────────────────────────────────────────────────── 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; FSampleRateOverlay: TSampleRateOverlay; FVfoOverlay: TVfoOverlay; // ── Marker ──────────────────────────────────────────────────────────────── FMarkerActive: Boolean; FMarkerX: Integer; // ── Spectrum buffer ─────────────────────────────────────────────────────── FSpectrumBuf: array[0..1023] 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 DrawSpectrumGradient(const SpPts: array of TPoint; W, H: Integer); procedure DrawMarkerLine(C: TCanvas; W, H: Integer); procedure BlendBand(X1, X2, H: Integer; R, G, B, Alpha: Byte); procedure CopyGridToSpectrum(W, H: Integer); procedure DrawADCOverloadOverlay(C: TCanvas; W, H: Integer); procedure CalcFilterBandX(VfoFreq: Double; 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); 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; // ── 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 WaterfallDirty: Boolean read GetWaterfallDirty write SetWaterfallDirty; property WfFrameInterval: Integer read GetWfFrameInterval write SetWfFrameInterval; // ── Ссылки на 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; // ── Данные от 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; procedure SetTheme(const T: TAppTheme); virtual; procedure InvalidateRulerCache; virtual; procedure ResetSpectrumBuf; virtual; procedure ResetWfAvgBuf; virtual; procedure FillDemoSpectrum; virtual; function NeedsRulerRedraw: Boolean; virtual; end; implementation // ════════════════════════════════════════════════════════════════════════════ // Вспомогательные функции // ════════════════════════════════════════════════════════════════════════════ 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; FTheme := DarkTheme; // Sub-views FWaterfall := TWaterfallView.Create; FSMeter := TSMeterView.Create; FRuler := TRulerView.Create; ResetSpectrumBuf; end; destructor TSpectrumView.Destroy; begin FSpectrumBitmap.Free; FGridBitmap.Free; FWaterfall.Free; FSMeter.Free; FRuler.Free; inherited; 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; 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; 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.DrawMarkerLine(C: TCanvas; W, H: Integer); var MX: 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)); C.Pen.Color := TColor($004444FF); C.Pen.Width := 1; C.Pen.Style := psSolid; C.MoveTo(MX, 0); C.LineTo(MX, H); C.Font.Color := TColor($004444FF); C.Font.Size := 7; C.Font.Name := 'Courier New'; if MX + 4 + C.TextWidth(MarkerLbl) < W then C.TextOut(MX + 4, 4, MarkerLbl) else C.TextOut(MX - 4 - C.TextWidth(MarkerLbl), 4, MarkerLbl); 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; 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.DrawADCOverloadOverlay(C: TCanvas; W, H: Integer); begin if not FADCOverloadVisible then Exit; DrawAlertOverlay(FSpectrumBitmap, C, W, H, 'ADC OVERLOAD', 'Input clipping detected'); end; procedure TSpectrumView.CalcFilterBandX(VfoFreq: Double; W: Integer; out X1, X2, VfoX: Integer); var Lo_Hz, Hi_Hz, Half: Double; begin Half := FFilterBW / 2; VfoX := Round((VfoFreq - FCenterFreq + FSpanHz / 2) / FSpanHz * W); case FMode of 0: begin Lo_Hz := -FFilterBW; Hi_Hz := -100; end; 1: begin Lo_Hz := 100; Hi_Hz := FFilterBW; 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); var Row, Col, Alpha, YMin, Off: Integer; RowPtr: PByte; GradB, GradG, GradR: Byte; 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); RowPtr := PByte(FSpectrumBitmap.ScanLine[Row]); for Col := 0 to W - 1 do if SpPts[Col].Y <= Row then begin Off := Col * 4; {$IFDEF DARWIN} RowPtr[Off+1] := (GradR * Alpha + RowPtr[Off+1] * (200 - Alpha)) div 200; RowPtr[Off+2] := (GradG * Alpha + RowPtr[Off+2] * (200 - Alpha)) div 200; RowPtr[Off+3] := (GradB * Alpha + RowPtr[Off+3] * (200 - Alpha)) div 200; {$ELSE} RowPtr[Off] := (GradB * Alpha + RowPtr[Off] * (200 - Alpha)) div 200; RowPtr[Off+1] := (GradG * Alpha + RowPtr[Off+1] * (200 - Alpha)) div 200; RowPtr[Off+2] := (GradR * Alpha + RowPtr[Off+2] * (200 - Alpha)) div 200; {$ENDIF} end; end; FSpectrumBitmap.EndUpdate(False); end; // ──────────────────────────────────────────────────────────────────────────── // Публичные методы данных // ──────────────────────────────────────────────────────────────────────────── procedure TSpectrumView.SetSpectrumData(const Pixels: array of Single; Count: Integer); var i, N: Integer; begin N := Min(Count, 1024); 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.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 1023 do FSpectrumBuf[i] := -130.0; FWaterfall.ResetWfBuf; end; procedure TSpectrumView.ResetWfAvgBuf; begin FWaterfall.ResetWfAvgBuf; 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 1024] := 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; RowLW: PLongWord; AMask: LongWord; 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; end; CopyGridToSpectrum(W, H); // ── 2. Полоса фильтра ───────────────────────────────────────────────────── if FActiveVfo = 0 then CalcFilterBandX(FVfoA, W, X1, X2, VfoX) else CalcFilterBandX(FVfoB, W, X1, X2, VfoX); if FTXOverlay then begin if FTXVfoIndex <> FActiveVfo then begin if X2 > X1 then BlendBand(X1, X2, H, $30, $C0, $30, 100); if FTXVfoIndex = 0 then CalcFilterBandX(FVfoA, W, TXX1, TXX2, TXVfoX) else CalcFilterBandX(FVfoB, W, TXX1, TXX2, TXVfoX); 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 begin C.Brush.Color := FTheme.SpecFilter; C.Brush.Style := bsSolid; C.Pen.Style := psClear; if X2 > X1 then C.FillRect(Rect(X1, 0, X2, H)); C.Pen.Style := psSolid; end; // ── 3. AGC линии ────────────────────────────────────────────────────────── if FWDSPReady then begin AGCy := Round((DBmax - FAGCThresh) * InvRange * H); if (AGCy >= 0) and (AGCy < H) then begin C.Pen.Color := FTheme.SpecAgcColor; C.Pen.Width := 1; C.Pen.Style := psDash; C.MoveTo(0, AGCy); C.LineTo(W, AGCy); C.Pen.Style := psSolid; C.Font.Color := FTheme.SpecAgcColor; C.Font.Size := 6; C.TextOut(4, AGCy - 9, 'AGC T'); end; AGCHangY := Round((DBmax - FAGCHangLevel) * InvRange * H); if (AGCHangY >= 0) and (AGCHangY < H) and (Abs(AGCHangY - AGCy) > 4) then begin C.Pen.Color := FTheme.SpecAgcHangColor; C.Pen.Width := 1; C.Pen.Style := psDot; C.MoveTo(0, AGCHangY); C.LineTo(W, AGCHangY); C.Pen.Style := psSolid; C.Font.Color := FTheme.SpecAgcHangColor; C.Font.Size := 6; C.TextOut(4, AGCHangY + 2, 'AGC H'); end; end else begin AGCy := Round((DBmax - (-FAGCTop)) * InvRange * H); if (AGCy >= 0) and (AGCy < H) then begin C.Pen.Color := FTheme.SpecAgcColor; C.Pen.Width := 1; C.Pen.Style := psDash; C.MoveTo(0, AGCy); C.LineTo(W, AGCy); C.Pen.Style := psSolid; C.Font.Color := FTheme.SpecAgcColor; C.Font.Size := 6; C.TextOut(4, AGCy - 9, Format('AGC -%ddB', [FAGCTop])); end; end; // ── 4. Кривая спектра ───────────────────────────────────────────────────── if FSpPtsLen <> W + 2 then begin SetLength(FSpPts, W + 2); FSpPtsLen := W + 2; end; SrcCount := EnsureRange(FSpectrumBufCount, 2, 1024); 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); // ── 5. Градиент ─────────────────────────────────────────────────────────── C.Brush.Style := bsSolid; C.Pen.Style := psClear; DrawSpectrumGradient(FSpPts, W, H); // ── 6. Линия спектра ────────────────────────────────────────────────────── C.Pen.Style := psSolid; C.Pen.Color := FTheme.SpecLine; C.Pen.Width := 1; C.Polyline(Slice(FSpPts, W)); // ── 7. Края фильтра + VFO ───────────────────────────────────────────────── C.Pen.Color := FTheme.SpecFilterEdge; C.Pen.Width := 1; C.Pen.Style := psSolid; C.MoveTo(X1, 0); C.LineTo(X1, H); C.MoveTo(X2, 0); C.LineTo(X2, H); C.Pen.Color := FTheme.SpecVfoCursor; C.Pen.Width := 2; C.MoveTo(VfoX, 0); C.LineTo(VfoX, H - 12); C.Brush.Color := FTheme.SpecVfoCursor; C.Brush.Style := bsSolid; C.Pen.Width := 1; C.Polygon([Point(VfoX-5,0), Point(VfoX+5,0), Point(VfoX,8)]); if FTXOverlay and (FTXVfoIndex <> FActiveVfo) then begin C.Pen.Color := TColor($002030E0); C.Pen.Width := 1; C.Pen.Style := psSolid; C.MoveTo(TXX1, 0); C.LineTo(TXX1, H); C.MoveTo(TXX2, 0); C.LineTo(TXX2, H); C.Pen.Width := 2; C.MoveTo(TXVfoX, 0); C.LineTo(TXVfoX, H - 12); C.Brush.Color := TColor($002030E0); C.Brush.Style := bsSolid; C.Pen.Width := 1; C.Polygon([Point(TXVfoX-5,0), Point(TXVfoX+5,0), Point(TXVfoX,8)]); end; if FMarkerActive then DrawMarkerLine(C, W, H); DrawADCOverloadOverlay(C, W, H); if Assigned(FSampleRateOverlay) then FSampleRateOverlay.DrawOverlay(FSpectrumBitmap, C, W, H); if Assigned(FVfoOverlay) then FVfoOverlay.DrawOverlay(FSpectrumBitmap, W, H); // Восстанавливаем непрозрачность: Canvas-операции (текст/линии со сглаживанием) // могли занулить альфу. OR маской выставляет альфу в $FF, RGB не меняя. {$IFDEF DARWIN} AMask := $000000FF; // ARGB: альфа в байте 0 {$ELSE} AMask := $FF000000; // BGRA: альфа в байте 3 {$ENDIF} FSpectrumBitmap.BeginUpdate(False); for i := 0 to H - 1 do begin RowLW := PLongWord(FSpectrumBitmap.ScanLine[i]); if RowLW = nil then Continue; for Yp := 0 to W - 1 do begin RowLW^ := RowLW^ or AMask; Inc(RowLW); end; end; FSpectrumBitmap.EndUpdate(False); 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.