ew8bak/ewsdr
1
0
Fork 0
mirror of https://git.vladimir.cc/vladimir/ewsdr.git synced 2026-08-25 20:27:33 +00:00
Code Issues Packages Projects Releases Wiki Activity
Files
fa38e433e177992731b84e2ea4d359fce302d068
ewsdr/SpectrumView.pas
T
ew8bakandClaude Sonnet 4.6 fa38e433e1 fix waterfall init color to match surrounding panel 
Empty waterfall now fills with FTheme.Panel (same color as PanelRight)
instead of FTheme.BG, so there's no visible seam before stream starts.
Correct TColor→BGRA conversion (R/B swap) applied.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-02 21:48:12 +03:00

1230 lines
52 KiB
ObjectPascal
Raw Blame History

unit SpectrumView;
{
SpectrumView.pas — рендеринг спектра, водопада и S-метра.
TSpectrumView инкапсулирует всё рисование: спектр, водопад, линейка частот,
S-метр, индикаторы мощности/SWR. MainForm создаёт один экземпляр, передаёт
ссылки на TPaintBox после BuildUI, обновляет свойства при изменении состояния.
Зависимости: нет обратной зависимости на MainForm (нет circular dep).
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, Graphics, ExtCtrls, Controls, Math,
IntfGraphics, FPImage, LCLIntf, LCLType, GraphType, AppTheme;
const
SV_CLR_BG = TColor($00101010);
SV_CLR_BORDER = TColor($00303030);
SV_CLR_METER_ON = TColor($0000CC44);
SV_CLR_AMBER = TColor($0000AAFF);
type
TSpectrumView = class
private
// ── Off-screen bitmaps ────────────────────────────────────────────────────
FSpectrumBitmap: TBitmap;
FWaterfallBitmap: TBitmap; // размер-placeholder для DrawWaterfall
FWfBitmap: TBitmap;
FWfBitmapW: Integer;
FWfBitmapH: Integer;
FGridBitmap: TBitmap;
FGridBitmapW: Integer;
FGridBitmapH: Integer;
FRulerBitmap: TBitmap;
FSpecGradImg: TLazIntfImage;
FSpecGradBmp: TBitmap;
FWfIntfImg: TLazIntfImage;
FWfPixels: array of LongWord;
FSpPts: array of TPoint;
// ── Тема ─────────────────────────────────────────────────────────────────
FTheme: TAppTheme;
FLightTheme: Boolean;
FSpPtsLen: Integer;
FSmBitmap: TBitmap;
FRulerLastFreq: Double;
FRulerLastVfo: Double;
FRulerLastSpan: Double;
// ── Radio state ───────────────────────────────────────────────────────────
FVfoA: Double;
FVfoB: Double;
FActiveVfo: Integer;
FCenterFreq: Double;
FSpanHz: Double;
FMode: Integer;
FFilterBW: Integer;
FAGCTop: Integer;
FAGCThresh: Double;
FAGCHangLevel: Double;
FWDSPReady: Boolean;
// ── Waterfall settings ────────────────────────────────────────────────────
FWfAGCEnabled: Boolean;
FWfNFEnabled: Boolean;
FWfManualHigh: Double;
FWfManualLow: Double;
FWfAGCOffset: Double;
FWfHigh: Double;
FWfLow: Double;
// ── Display settings ──────────────────────────────────────────────────────
FSpecRefLevel: Double;
FSpecRange: Double;
FSpecGridStep: Double;
// ── Marker ────────────────────────────────────────────────────────────────
FMarkerActive: Boolean;
FMarkerX: Integer;
// ── Meter values ──────────────────────────────────────────────────────────
FLastSMeter: Double;
FSMeterPeak: Double;
FSMeterMin: Double;
FLastFwdW: Double;
FLastSWR: Double;
// ── Буферы данных (пишутся из DSP-потока) ────────────────────────────────
FSpectrumBuf: array[0..1023] of Single;
FWaterfallBuf: array[0..1023] of Single;
FSpectrumBufCount: Integer;
FWaterfallBufCount: Integer;
FSpectrumDirty: Boolean;
FWaterfallDirty: Boolean;
FWfFrameCounter: Integer;
FWfFrameInterval: Integer;
// ── Ссылки на TPaintBox (устанавливаются из MainForm после BuildUI) ───────
FPbSpectrum: TPaintBox;
FPbWaterfall: TPaintBox;
FPbRuler: TPaintBox;
FPbSMeterRight: TPaintBox;
FPbFwdPower: TPaintBox;
FPbSWR: TPaintBox;
// ── Приватные методы рендеринга ───────────────────────────────────────────
function ActiveVfoFreq: Double;
function ScaleX(X, Total, Width: Integer): Integer;
procedure DrawSpectrumGradient(const SpPts: array of TPoint; W, H: Integer);
procedure DrawMarkerLine(C: TCanvas; W, H: Integer);
public
constructor Create;
destructor Destroy; override;
// ── Состояние радио ───────────────────────────────────────────────────────
property VfoA: Double read FVfoA write FVfoA;
property VfoB: Double read FVfoB write FVfoB;
property ActiveVfo: Integer read FActiveVfo write FActiveVfo;
property CenterFreq: Double read FCenterFreq write FCenterFreq;
property SpanHz: Double read FSpanHz write FSpanHz;
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 FWfAGCEnabled write FWfAGCEnabled;
property WfNFEnabled: Boolean read FWfNFEnabled write FWfNFEnabled;
property WfManualHigh: Double read FWfManualHigh write FWfManualHigh;
property WfManualLow: Double read FWfManualLow write FWfManualLow;
property WfAGCOffset: Double read FWfAGCOffset write FWfAGCOffset;
// ── Отображение ───────────────────────────────────────────────────────────
property SpecRefLevel: Double read FSpecRefLevel write FSpecRefLevel;
property SpecRange: Double read FSpecRange write FSpecRange;
property SpecGridStep: Double read FSpecGridStep write FSpecGridStep;
// ── Маркер ────────────────────────────────────────────────────────────────
property MarkerActive: Boolean read FMarkerActive write FMarkerActive;
property MarkerX: Integer read FMarkerX write FMarkerX;
// ── S-метр ────────────────────────────────────────────────────────────────
property LastSMeter: Double read FLastSMeter write FLastSMeter;
property SMeterPeak: Double read FSMeterPeak write FSMeterPeak;
property SMeterMin: Double read FSMeterMin write FSMeterMin;
property LastFwdW: Double read FLastFwdW write FLastFwdW;
property LastSWR: Double read FLastSWR write FLastSWR;
// ── Флаги обновления ──────────────────────────────────────────────────────
property SpectrumDirty: Boolean read FSpectrumDirty write FSpectrumDirty;
property WaterfallDirty: Boolean read FWaterfallDirty write FWaterfallDirty;
property WfFrameInterval: Integer read FWfFrameInterval write FWfFrameInterval;
// ── Ссылки на PaintBox ────────────────────────────────────────────────────
property PbSpectrum: TPaintBox write FPbSpectrum;
property PbWaterfall: TPaintBox write FPbWaterfall;
property PbRuler: TPaintBox write FPbRuler;
property PbSMeterRight: TPaintBox write FPbSMeterRight;
property PbFwdPower: TPaintBox write FPbFwdPower;
property PbSWR: TPaintBox write FPbSWR;
// ── Данные от DSP (вызываются из DSP-потока) ──────────────────────────────
procedure SetSpectrumData(const Pixels: array of Single; Count: Integer);
procedure SetWaterfallData(const Pixels: array of Single; Count: Integer);
// ── Рендеринг ─────────────────────────────────────────────────────────────
procedure DrawSpectrum;
procedure DrawWaterfall;
procedure DrawRuler;
procedure DrawBarMeter(ACanvas: TCanvas; R: TRect;
Value, MaxVal: Double; BarColor: TColor);
procedure DrawSMeterWide(ACanvas: TCanvas; R: TRect;
Value, Peak, MinVal: Double;
out ZX1, ZX2, ZY1, ZY2: Integer);
procedure DrawSMeterZone(ACanvas: TCanvas; R: TRect;
X1, X2, Y1, Y2: Integer);
// ── Управление размером bitmap ────────────────────────────────────────────
procedure SetSpectrumBitmapSize(W, H: Integer);
procedure SetWaterfallBitmapSize(W, H: Integer);
procedure SetRulerSize(W, H: Integer);
function SpectrumBitmapWidth: Integer;
// ── Paint-обработчики (назначаются в BuildUI) ─────────────────────────────
procedure PaintSpectrum(Sender: TObject);
procedure PaintWaterfall(Sender: TObject);
procedure PaintRuler(Sender: TObject);
procedure PaintSMeterRight(Sender: TObject);
procedure PaintFwdPower(Sender: TObject);
procedure PaintSWR(Sender: TObject);
// ── Утилиты ───────────────────────────────────────────────────────────────
procedure InvalidateGridCache;
// ── Тема ─────────────────────────────────────────────────────────────────
procedure SetTheme(const T: TAppTheme);
procedure InvalidateRulerCache;
procedure ResetSpectrumBuf;
procedure ResetWfAvgBuf;
procedure FillDemoSpectrum;
function NeedsRulerRedraw: Boolean;
end;
// Вспомогательные функции (публичные для возможного использования в MainForm)
function FormatFreqSV(Hz: Double): string;
implementation
// ════════════════════════════════════════════════════════════════════════════
// Вспомогательные функции — цвет, градиент
// ════════════════════════════════════════════════════════════════════════════
function WaterfallColorThetis(Level: Integer): LongWord;
const
STOPS: array[0..5] of LongWord = (
$000000, $0A1A48, $0088CC, $E0C020, $D84A12, $FFFFFF);
var
Seg, Base: Integer;
T: Double;
C0, C1: LongWord;
R, G, B: Integer;
begin
Level := EnsureRange(Level, 0, 255);
Seg := Min(4, Level div 51);
Base := Seg * 51;
T := (Level - Base) / 51.0;
C0 := STOPS[Seg];
C1 := STOPS[Seg + 1];
R := Round(((C0 shr 16) and $FF) * (1.0 - T) + ((C1 shr 16) and $FF) * T);
G := Round(((C0 shr 8) and $FF) * (1.0 - T) + ((C1 shr 8) and $FF) * T);
B := Round((C0 and $FF) * (1.0 - T) + (C1 and $FF) * T);
Result := ($FF shl 24) or (R shl 16) or (G shl 8) or B;
end;
function WaterfallEnhancedColorThetis(ValueDB, LowDB, HighDB: Double): LongWord;
var
Overall, Local: Double;
R, G, B: Integer;
begin
if ValueDB <= LowDB then begin Result := $FF000000; Exit; end;
if ValueDB >= HighDB then begin Result := ($FF shl 24) or (255 shl 16) or (124 shl 8) or 192; Exit; end;
Overall := (ValueDB - LowDB) / Max(1E-9, HighDB - LowDB);
if Overall < (2.0 / 9.0) then
begin Local := Overall / (2.0/9.0); R := 0; G := 0; B := Round(Local * 255.0); end
else if Overall < (3.0 / 9.0) then
begin Local := (Overall - 2.0/9.0) / (1.0/9.0); R := 0; G := Round(Local*255.0); B := 255; end
else if Overall < (4.0 / 9.0) then
begin Local := (Overall - 3.0/9.0) / (1.0/9.0); R := 0; G := 255; B := Round((1.0-Local)*255.0); end
else if Overall < (5.0 / 9.0) then
begin Local := (Overall - 4.0/9.0) / (1.0/9.0); R := Round(Local*255.0); G := 255; B := 0; end
else if Overall < (7.0 / 9.0) then
begin Local := (Overall - 5.0/9.0) / (2.0/9.0); R := 255; G := Round((1.0-Local)*255.0); B := 0; end
else if Overall < (8.0 / 9.0) then
begin Local := (Overall - 7.0/9.0) / (1.0/9.0); R := 255; G := 0; B := Round(Local*255.0); end
else
begin
Local := (Overall - 8.0/9.0) / (1.0/9.0);
R := Round((0.75 + 0.25 * (1.0 - Local)) * 255.0);
G := Round(Local * 255.0 * 0.5);
B := 255;
end;
R := EnsureRange(R, 0, 255);
G := EnsureRange(G, 0, 255);
B := EnsureRange(B, 0, 255);
Result := ($FF shl 24) or (R shl 16) or (G shl 8) or B;
end;
// Цветовая схема водопада для светлой темы.
// Шум исчезает в фоне (кремовый), сигналы: зелень → бирюза → синева → индиго.
function WaterfallLightTheme(ValueDB, LowDB, HighDB: Double): LongWord;
const
NSTOPS = 8;
SR: array[0..NSTOPS-1] of Integer = (240, 210, 148, 60, 14, 8, 24, 64);
SG: array[0..NSTOPS-1] of Integer = (238, 228, 200, 164, 132, 96, 52, 6);
SB: array[0..NSTOPS-1] of Integer = (230, 190, 118, 68, 96, 148, 166, 100);
var
T: Double;
Seg: Integer;
R, G, B: Integer;
begin
if ValueDB <= LowDB then begin Result := $FFF0EEE6; Exit; end;
if ValueDB >= HighDB then begin Result := ($FF shl 24) or (SR[NSTOPS-1] shl 16) or (SG[NSTOPS-1] shl 8) or SB[NSTOPS-1]; Exit; end;
T := (ValueDB - LowDB) / Max(1E-9, HighDB - LowDB) * (NSTOPS - 1);
Seg := Min(NSTOPS - 2, Trunc(T));
T := T - Seg;
R := EnsureRange(Round(SR[Seg] * (1.0 - T) + SR[Seg+1] * T), 0, 255);
G := EnsureRange(Round(SG[Seg] * (1.0 - T) + SG[Seg+1] * T), 0, 255);
B := EnsureRange(Round(SB[Seg] * (1.0 - T) + SB[Seg+1] * T), 0, 255);
Result := ($FF shl 24) or (R shl 16) or (G shl 8) or B;
end;
procedure InitRawDesc32(var Desc: TRawImageDescription; AWidth, AHeight: Integer);
begin
FillChar(Desc, SizeOf(Desc), 0);
Desc.Format := ricfRGBA;
Desc.Width := AWidth;
Desc.Height := AHeight;
Desc.Depth := 32;
Desc.BitOrder := riboBitsInOrder;
Desc.ByteOrder := riboLSBFirst;
Desc.LineOrder := riloTopToBottom;
Desc.BitsPerPixel := 32;
Desc.LineEnd := rileDWordBoundary;
Desc.BlueShift := 0; Desc.BluePrec := 8;
Desc.GreenShift := 8; Desc.GreenPrec := 8;
Desc.RedShift := 16; Desc.RedPrec := 8;
Desc.AlphaShift := 24; Desc.AlphaPrec := 8;
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;
function FormatFreqSV(Hz: Double): string;
var Mhz, KHz, Rest: Integer;
begin
Mhz := Trunc(Hz / 1000000);
KHz := Trunc((Hz - Mhz * 1000000) / 1000);
Rest := Trunc(Hz) mod 1000;
Result := Format('%3d.%3.3d.%3.3d', [Mhz, KHz, Rest]);
end;
// ════════════════════════════════════════════════════════════════════════════
// TSpectrumView
// ════════════════════════════════════════════════════════════════════════════
constructor TSpectrumView.Create;
begin
inherited Create;
FSpectrumBitmap := TBitmap.Create;
FWaterfallBitmap := TBitmap.Create;
FWfBitmap := TBitmap.Create;
FGridBitmap := TBitmap.Create;
FRulerBitmap := TBitmap.Create;
FSpecGradBmp := TBitmap.Create;
FSmBitmap := nil;
FSpecGradImg := nil;
FWfIntfImg := nil;
FWfBitmapW := 0; FWfBitmapH := 0;
FGridBitmapW := 0; FGridBitmapH := 0;
FSpPtsLen := 0;
FRulerLastFreq := -1.0; FRulerLastVfo := -1.0;
// Водопад AGC defaults
FWfManualHigh := -80.0;
FWfManualLow := -130.0;
FWfAGCOffset := 0.0;
FWfHigh := -80.0;
FWfLow := -130.0;
FWfAGCEnabled := True;
FWfNFEnabled := False;
// Spectrum display defaults
FSpecRefLevel := -20.0;
FSpecRange := 110.0;
FSpecGridStep := 10.0;
FSpanHz := 192000;
FSpectrumBufCount := 1024;
FWaterfallBufCount := 1024;
FWfFrameInterval := 2;
FWfFrameCounter := 0;
FWaterfallDirty := True;
FLastSMeter := -130; FSMeterPeak := -130; FSMeterMin := -130;
FLastFwdW := 0; FLastSWR := 1;
FLightTheme := False;
FTheme := DarkTheme;
ResetSpectrumBuf;
end;
destructor TSpectrumView.Destroy;
begin
FSpectrumBitmap.Free;
FWaterfallBitmap.Free;
FWfBitmap.Free;
FGridBitmap.Free;
FRulerBitmap.Free;
FSpecGradBmp.Free;
FreeAndNil(FSpecGradImg);
FreeAndNil(FWfIntfImg);
FreeAndNil(FSmBitmap);
inherited;
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.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.DrawSpectrumGradient(const SpPts: array of TPoint; W, H: Integer);
var
Row, Col: Integer; YMin, Alpha: Integer;
RowPtr: PByte; BPPg: Integer; RG, GG: Byte;
Desc: TRawImageDescription;
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;
if (FSpecGradImg = nil) or (FSpecGradImg.Width <> W) or (FSpecGradImg.Height <> H) then
begin
FreeAndNil(FSpecGradImg);
FSpecGradImg := TLazIntfImage.Create(W, H);
InitRawDesc32(Desc, W, H);
FSpecGradImg.DataDescription := Desc;
FSpecGradImg.CreateData;
end;
if FSpecGradImg.PixelData <> nil then
FillChar(FSpecGradImg.PixelData^, W * H * 4, 0);
BPPg := FSpecGradImg.DataDescription.BitsPerPixel div 8;
if BPPg < 3 then BPPg := 4;
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;
GG := Byte(FTheme.SpecGradB * Alpha div 200);
RG := Byte(FTheme.SpecGradG * Alpha div 200);
RowPtr := FSpecGradImg.GetDataLineStart(Row);
if RowPtr = nil then Continue;
for Col := 0 to W - 1 do
begin
if SpPts[Col].Y <= Row then
begin
RowPtr[0] := GG;
RowPtr[1] := RG;
RowPtr[2] := Byte(FTheme.SpecGradR * Alpha div 200);
if BPPg >= 4 then RowPtr[3] := Byte(Alpha);
end else begin
RowPtr[0] := 0; RowPtr[1] := 0; RowPtr[2] := 0;
if BPPg >= 4 then RowPtr[3] := 0;
end;
Inc(RowPtr, BPPg);
end;
end;
FSpecGradBmp.LoadFromIntfImage(FSpecGradImg);
LCLIntf.BitBlt(FSpectrumBitmap.Canvas.Handle, 0, 0, W, H,
FSpecGradBmp.Canvas.Handle, 0, 0, $CC0020);
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);
var i, N: Integer;
begin
N := Min(Count, 1024);
for i := 0 to N - 1 do FWaterfallBuf[i] := Pixels[i];
FWaterfallBufCount := N;
Inc(FWfFrameCounter);
if FWfFrameCounter >= Max(1, FWfFrameInterval) then
begin
FWfFrameCounter := 0;
FWaterfallDirty := True;
end;
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));
FreeAndNil(FSpecGradImg);
InvalidateGridCache;
FSpPtsLen := 0;
end;
procedure TSpectrumView.SetWaterfallBitmapSize(W, H: Integer);
begin
FWaterfallBitmap.SetSize(W, H);
FWfBitmapW := 0; FWfBitmapH := 0;
SetLength(FWfPixels, 0);
FreeAndNil(FWfIntfImg);
end;
procedure TSpectrumView.SetRulerSize(W, H: Integer);
begin
if (W <= 0) or (H <= 0) then Exit;
FRulerBitmap.SetSize(W, H);
FRulerLastFreq := -1.0; FRulerLastVfo := -1.0; FRulerLastSpan := -1.0;
end;
function TSpectrumView.SpectrumBitmapWidth: Integer;
begin
Result := FSpectrumBitmap.Width;
end;
// ────────────────────────────────────────────────────────────────────────────
// Утилиты
// ────────────────────────────────────────────────────────────────────────────
procedure TSpectrumView.InvalidateGridCache;
begin
FGridBitmapW := 0; FGridBitmapH := 0;
FSpectrumDirty := True;
end;
procedure TSpectrumView.SetTheme(const T: TAppTheme);
begin
FTheme := T;
FLightTheme := T.BG > TColor($00808080); // светлая тема если фон светлее 50%
FreeAndNil(FSpecGradImg); // пересчитать градиент
InvalidateGridCache;
InvalidateRulerCache;
FWaterfallDirty := True;
end;
procedure TSpectrumView.InvalidateRulerCache;
begin
FRulerLastFreq := -1.0; FRulerLastVfo := -1.0; FRulerLastSpan := -1.0;
end;
procedure TSpectrumView.ResetSpectrumBuf;
var i: Integer;
begin
for i := 0 to 1023 do FSpectrumBuf[i] := -130.0;
for i := 0 to 1023 do FWaterfallBuf[i] := -130.0;
FWfHigh := FWfManualHigh; FWfLow := FWfManualLow;
FWaterfallDirty := True;
end;
procedure TSpectrumView.ResetWfAvgBuf;
begin
FWfHigh := FWfManualHigh; FWfLow := FWfManualLow;
FWaterfallDirty := True;
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 := (Abs(FCenterFreq - FRulerLastFreq) >= 0.5) or
(Abs(ActiveVfoFreq - FRulerLastVfo) >= 0.5) or
(Abs(FSpanHz - FRulerLastSpan) >= 1.0);
end;
// ────────────────────────────────────────────────────────────────────────────
// DrawSpectrum
// ────────────────────────────────────────────────────────────────────────────
procedure TSpectrumView.DrawSpectrum;
var
C, GC: TCanvas;
i, Yp, W, H, GX: Integer;
DBmin, DBmax, dB: Double;
VfoX, X1, X2: Integer;
Lo_Hz, Hi_Hz, Half: Double;
AGCy, AGCHangY: Integer;
SrcF, Frac, dBv: Double;
S0, S1: Integer;
InvRange: Double;
LabelBandW, SrcCount: 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) then
begin
FGridBitmapW := W; FGridBitmapH := H;
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;
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;
LCLIntf.BitBlt(C.Handle, 0, 0, W, H, FGridBitmap.Canvas.Handle, 0, 0, $CC0020);
// ── 2. Полоса фильтра ─────────────────────────────────────────────────────
Half := FFilterBW / 2;
if FActiveVfo = 0 then
VfoX := Round((FVfoA - FCenterFreq + FSpanHz/2) / FSpanHz * W)
else
VfoX := Round((FVfoB - 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)));
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;
// ── 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);
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 FMarkerActive then DrawMarkerLine(C, W, H);
end;
// ────────────────────────────────────────────────────────────────────────────
// DrawWaterfall
// ────────────────────────────────────────────────────────────────────────────
procedure TSpectrumView.DrawWaterfall;
var
W, H, X: Integer;
dB, frac, WatSrcF: Double;
WatS0, WatS1, V: Integer;
TargetLow, TargetHigh: Double;
HistMinDB, HistMaxDB, HistStepDB: Double;
NoiseFloorDB, SignalTopDB: Double;
CumCount, LowTargetCount, HighTargetCount, HistIdx: Integer;
WfHigh, WfLow, InvRange, Step: Double;
Px: PLongWord;
Desc: TRawImageDescription;
Row, Col: Integer; RowPtr: PByte; Src: PLongWord; BPPi: Integer;
Pal: LongWord; Hist: array[0..191] of Integer; SrcCount: Integer;
const
ALPHA_HIGH = 0.10; ALPHA_LOW = 0.08;
WF_AUTO_OFFSET = -4.0; WF_MIN_RANGE = 48.0; WF_MAX_RANGE = 62.0;
begin
if FWaterfallBitmap = nil then Exit;
W := FWaterfallBitmap.Width; H := FWaterfallBitmap.Height;
if (W <= 0) or (H <= 0) then Exit;
SrcCount := EnsureRange(FWaterfallBufCount, 2, 1024);
FillChar(Hist, SizeOf(Hist), 0);
HistMinDB := -170.0; HistMaxDB := 22.0;
HistStepDB := (HistMaxDB - HistMinDB) / Length(Hist);
for X := 0 to SrcCount - 1 do
begin
HistIdx := EnsureRange(Trunc((FWaterfallBuf[X] - HistMinDB) / HistStepDB), 0, High(Hist));
Inc(Hist[HistIdx]);
end;
LowTargetCount := Round(SrcCount * 0.30);
HighTargetCount := Round(SrcCount * 0.98);
CumCount := 0; NoiseFloorDB := FWfLow; SignalTopDB := FWfHigh;
for HistIdx := 0 to High(Hist) do
begin
CumCount := CumCount + Hist[HistIdx];
if CumCount >= LowTargetCount then
begin NoiseFloorDB := HistMinDB + (HistIdx + 0.5) * HistStepDB; Break; end;
end;
CumCount := 0;
for HistIdx := 0 to High(Hist) do
begin
CumCount := CumCount + Hist[HistIdx];
if CumCount >= HighTargetCount then
begin SignalTopDB := HistMinDB + (HistIdx + 0.5) * HistStepDB; Break; end;
end;
if FWfAGCEnabled then
begin
TargetLow := NoiseFloorDB + WF_AUTO_OFFSET + FWfAGCOffset;
if FWfNFEnabled then
TargetHigh := Max(TargetLow + WF_MIN_RANGE, SignalTopDB + 6.0)
else
TargetHigh := TargetLow + 52.0;
if TargetHigh > TargetLow + WF_MAX_RANGE then TargetHigh := TargetLow + WF_MAX_RANGE;
FWfLow := FWfLow + ALPHA_LOW * (TargetLow - FWfLow);
FWfHigh := FWfHigh + ALPHA_HIGH * (TargetHigh - FWfHigh);
end;
WfHigh := FWfHigh; WfLow := FWfLow;
if not FWfAGCEnabled then begin WfHigh := FWfManualHigh; WfLow := FWfManualLow; end;
if WfHigh < WfLow + 40.0 then WfHigh := WfLow + 40.0;
if WfHigh > 0.0 then WfHigh := 0.0;
if WfLow < -160 then WfLow := -160;
InvRange := 255.0 / (WfHigh - WfLow);
if (FWfBitmapW <> W) or (FWfBitmapH <> H) then
begin
FWfBitmapW := W; FWfBitmapH := H;
SetLength(FWfPixels, W * H);
// TColor = $00BBGGRR → waterfall pixel = $FF_RR_GG_BB (swap R и B)
Pal := $FF000000
or ((LongWord(FTheme.Panel) and $FF) shl 16)
or (LongWord(FTheme.Panel) and $FF00)
or ((LongWord(FTheme.Panel) shr 16) and $FF);
FillDWord(FWfPixels[0], W * H, Pal);
FWfBitmap.SetSize(W, H);
FreeAndNil(FWfIntfImg);
end;
if H > 1 then Move(FWfPixels[0], FWfPixels[W], (H - 1) * SizeOf(LongWord) * W);
Step := (SrcCount - 1.0) / Max(1, W - 1);
WatSrcF := 0.0; Px := @FWfPixels[0];
for X := 0 to W - 1 do
begin
WatS0 := Trunc(WatSrcF);
if WatS0 > SrcCount - 2 then WatS0 := SrcCount - 2;
WatS1 := WatS0 + 1;
frac := WatSrcF - WatS0;
dB := FWaterfallBuf[WatS0] * (1.0 - frac) + FWaterfallBuf[WatS1] * frac;
V := Trunc((dB - WfLow) * InvRange);
if V < 0 then V := 0; if V > 255 then V := 255;
if FLightTheme then
Pal := WaterfallLightTheme(dB, WfLow, WfHigh)
else
Pal := WaterfallEnhancedColorThetis(dB, WfLow, WfHigh);
Px^ := Pal; Inc(Px);
WatSrcF := WatSrcF + Step;
end;
if FWfIntfImg = nil then
begin
FWfIntfImg := TLazIntfImage.Create(W, H);
InitRawDesc32(Desc, W, H);
FWfIntfImg.DataDescription := Desc;
FWfIntfImg.CreateData;
end;
BPPi := FWfIntfImg.DataDescription.BitsPerPixel div 8;
if (BPPi = 4) and (FWfIntfImg.PixelData <> nil) then
Move(FWfPixels[0], FWfIntfImg.PixelData^, W * H * 4)
else
begin
Src := @FWfPixels[0];
for Row := 0 to H - 1 do
begin
RowPtr := FWfIntfImg.GetDataLineStart(Row);
if RowPtr = nil then begin Inc(Src, W); Continue; end;
for Col := 0 to W - 1 do
begin
RowPtr[0] := Byte(Src^); RowPtr[1] := Byte(Src^ shr 8);
RowPtr[2] := Byte(Src^ shr 16);
if BPPi >= 4 then RowPtr[3] := $FF;
Inc(Src); Inc(RowPtr, BPPi);
end;
end;
end;
FWfBitmap.LoadFromIntfImage(FWfIntfImg);
end;
// ────────────────────────────────────────────────────────────────────────────
// DrawRuler
// ────────────────────────────────────────────────────────────────────────────
procedure TSpectrumView.DrawRuler;
var
C: TCanvas; W, H, i, X: Integer;
FreqStart, FreqHz: Double; VfoX: Integer;
Lbl: string; TW: Integer;
begin
if FPbRuler = nil then Exit;
W := FPbRuler.Width; H := FPbRuler.Height;
if (W <= 0) or (H <= 0) then Exit;
if (Abs(FCenterFreq - FRulerLastFreq) < 0.5) and
(Abs(ActiveVfoFreq - FRulerLastVfo) < 0.5) and
(Abs(FSpanHz - FRulerLastSpan) < 1.0) then Exit;
FRulerLastFreq := FCenterFreq; FRulerLastVfo := ActiveVfoFreq; FRulerLastSpan := FSpanHz;
if (FRulerBitmap.Width <> W) or (FRulerBitmap.Height <> H) then
FRulerBitmap.SetSize(W, H);
C := FRulerBitmap.Canvas;
PaintVerticalGradient(C, W, H, FTheme.RulerGradTop, FTheme.RulerGradBot);
C.Pen.Color := FTheme.RulerBorder; C.Pen.Width := 1;
C.MoveTo(0, 0); C.LineTo(W, 0);
C.MoveTo(0, H-1); C.LineTo(W, H-1);
C.Font.Name := 'Courier New'; C.Font.Size := 7;
C.Brush.Style := bsClear;
FreqStart := FCenterFreq - FSpanHz / 2;
for i := 0 to 8 do
begin
X := ScaleX(i, 8, W);
C.Pen.Color := FTheme.RulerBorder;
C.MoveTo(X, 0); C.LineTo(X, H div 2);
FreqHz := FreqStart + i * FSpanHz / 8;
Lbl := Format('%.3f', [FreqHz / 1e6]);
TW := C.TextWidth(Lbl);
C.Font.Color := FTheme.RulerText;
C.TextOut(X - TW div 2, H div 2 - 1, Lbl);
end;
VfoX := Round((ActiveVfoFreq - FCenterFreq + FSpanHz/2) / FSpanHz * W);
if (VfoX >= 0) and (VfoX < W) then
begin
C.Pen.Color := FTheme.RulerVfo; C.Pen.Width := 2;
C.MoveTo(VfoX, 0); C.LineTo(VfoX, H - 1); C.Pen.Width := 1;
end;
end;
// ────────────────────────────────────────────────────────────────────────────
// DrawBarMeter, DrawSMeterWide, DrawSMeterZone
// ────────────────────────────────────────────────────────────────────────────
procedure TSpectrumView.DrawBarMeter(ACanvas: TCanvas; R: TRect;
Value, MaxVal: Double; BarColor: TColor);
var Pct, BarW: Integer;
begin
ACanvas.Brush.Color := FTheme.SMeterBG;
ACanvas.FillRect(R);
if MaxVal > 0 then
Pct := Round(Max(0.0, Min(1.0, Value / MaxVal)) * (R.Right - R.Left - 2))
else
Pct := 0;
BarW := Pct;
ACanvas.Brush.Color := BarColor; ACanvas.Pen.Color := BarColor;
ACanvas.FillRect(Rect(R.Left+1, R.Top+1, R.Left+1+BarW, R.Bottom-1));
ACanvas.Brush.Style := bsClear;
ACanvas.Pen.Color := SV_CLR_BORDER;
ACanvas.Rectangle(R);
end;
procedure TSpectrumView.DrawSMeterWide(ACanvas: TCanvas; R: TRect;
Value, Peak, MinVal: Double; out ZX1, ZX2, ZY1, ZY2: Integer);
const
DB_MIN = -127.0; DB_MAX = -13.0; DB_S9 = -73.0; DB_OVR = -43.0;
DBM_MARKS: array[0..5] of Double = (-120,-100,-80,-60,-40,-20);
DBM_LABELS: array[0..5] of string = ('-120','-100','-80','-60','-40','-20');
S_MARKS_DBM: array[0..7] of Double = (-121,-109,-97,-85,-73,-53,-33,-13);
S_MARKS_LBL: array[0..7] of string = ('S1','S3','S5','S7','S9','+20','+40','+60');
LEFT_INFO_MIN = 62; RIGHT_PAD = 8; LABEL_PAD = 4;
TICK_LONG = 5; TICK_MED = 3;
var
CLR_SMETER_BG, CLR_BAR_GREEN, CLR_BAR_OVER: TColor;
CLR_PEAK_MARKER, CLR_TICK_GREEN, CLR_TICK_WHITE, CLR_TICK_BLUE: TColor;
CLR_LABEL_DBM, CLR_LABEL_S, CLR_SCALE_DBM: TColor;
CLR_SCALE_S_GREEN, CLR_SCALE_S_BLUE, CLR_BDR: TColor;
W, H, BX, BW, LeftInfo: Integer;
Y_BAR_TOP, Y_BAR_BOT: Integer;
BarEnd, PeakLeft, PeakRight, S9X, OvrX: Integer;
i, X, TW: Integer; Lbl: string; SNum, Over: Integer;
LblDbm, LblS: string;
TWDbm, LblZoneL, TH10, TH6, MaxTWDbm, MaxTWS, LabelNeed: Integer;
function DBtoX(dB: Double): Integer; inline;
begin
Result := BX + Round((dB - DB_MIN) / (DB_MAX - DB_MIN) * BW);
if Result < BX then Result := BX;
if Result > BX + BW then Result := BX + BW;
end;
procedure VLine(X2, Y1, Y2: Integer; C: TColor);
begin ACanvas.Pen.Color := C; ACanvas.MoveTo(X2, Y1); ACanvas.LineTo(X2, Y2); end;
procedure FillBar(X1, Y1, X2, Y2: Integer; C: TColor);
begin
ACanvas.Brush.Color := C; ACanvas.Brush.Style := bsSolid;
ACanvas.Pen.Style := psClear;
if X2 > X1 then ACanvas.FillRect(Rect(X1, Y1, X2, Y2));
ACanvas.Pen.Style := psSolid;
end;
begin
CLR_SMETER_BG := FTheme.SMeterBG;
CLR_BAR_GREEN := FTheme.SMeterBarGreen;
CLR_BAR_OVER := FTheme.SMeterBarOver;
CLR_PEAK_MARKER := FTheme.SMeterPeakMarker;
CLR_TICK_GREEN := FTheme.SMeterTickGreen;
CLR_TICK_WHITE := FTheme.SMeterTickWhite;
CLR_TICK_BLUE := FTheme.SMeterTickBlue;
CLR_LABEL_DBM := FTheme.SMeterLabelDbm;
CLR_LABEL_S := FTheme.SMeterLabelS;
CLR_SCALE_DBM := FTheme.SMeterScaleDbm;
CLR_SCALE_S_GREEN:= FTheme.SMeterScaleSGreen;
CLR_SCALE_S_BLUE := FTheme.SMeterScaleSBlue;
CLR_BDR := FTheme.SMeterBdr;
W := R.Right - R.Left; H := R.Bottom - R.Top;
ZX1 := 0; ZX2 := 0; ZY1 := 0; ZY2 := 0;
if (W < 80) or (H < 16) then Exit;
// --- Вычисляем строки надписей заранее чтобы измерить ширину ---
LblDbm := Format('%.1f', [Value]);
if Value >= -73.0 then
begin
Over := Round(Value - (-73.0));
if Over < 5 then LblS := 'S9'
else begin Over := ((Over + 5) div 10) * 10; if Over = 0 then Over := 10; LblS := Format('S9+%d', [Over]); end;
end else if Value <= -121.0 then LblS := 'S1'
else begin
LblS := 'S1';
for SNum := 1 to 8 do
if Value >= (-121.0 + (SNum - 1) * 6.0) then LblS := 'S' + IntToStr(SNum);
end;
// Измеряем ширину надписей
ACanvas.Font.Name := 'Courier New'; ACanvas.Font.Style := [fsBold];
ACanvas.Font.Size := 10; TWDbm := ACanvas.TextWidth(LblDbm);
MaxTWDbm := ACanvas.TextWidth('-120.0');
MaxTWS := ACanvas.TextWidth('S9+60');
ACanvas.Font.Size := 6; ACanvas.Font.Style := [];
// Левая информационная зона зависит от реальных метрик шрифта.
LabelNeed := Max(MaxTWDbm + 2 + ACanvas.TextWidth('dBm '), MaxTWS) + LABEL_PAD * 2;
LeftInfo := Max(LEFT_INFO_MIN, LabelNeed + 4);
BX := R.Left + LeftInfo; BW := W - LeftInfo - RIGHT_PAD;
if BW < 10 then Exit;
LblZoneL := BX - LabelNeed;
Y_BAR_TOP := R.Top + H * 44 div 100;
Y_BAR_BOT := R.Top + H * 58 div 100;
S9X := DBtoX(DB_S9); OvrX := DBtoX(DB_OVR);
ACanvas.Brush.Color := CLR_SMETER_BG; ACanvas.Brush.Style := bsSolid;
ACanvas.Pen.Style := psClear; ACanvas.FillRect(R); ACanvas.Pen.Style := psSolid;
FillBar(BX, Y_BAR_TOP, S9X, Y_BAR_BOT, CLR_BAR_GREEN);
FillBar(S9X, Y_BAR_TOP, OvrX, Y_BAR_BOT, CLR_BAR_GREEN);
FillBar(OvrX, Y_BAR_TOP, BX + BW, Y_BAR_BOT, CLR_BAR_OVER);
BarEnd := DBtoX(Value);
PeakLeft := DBtoX(MinVal);
PeakRight := DBtoX(Peak);
ZX1 := Max(BX + 1, Min(PeakLeft, PeakRight));
ZX2 := Min(BX + BW - 1, Max(PeakLeft, PeakRight));
ZY1 := Y_BAR_TOP + 1; ZY2 := Y_BAR_BOT - 1;
if BarEnd > BX then
begin
if BarEnd <= S9X then
FillBar(BX, Y_BAR_TOP+1, BarEnd, Y_BAR_BOT-1, CLR_BAR_GREEN)
else begin
FillBar(BX, Y_BAR_TOP+1, S9X, Y_BAR_BOT-1, CLR_BAR_GREEN);
FillBar(S9X, Y_BAR_TOP+1, BarEnd, Y_BAR_BOT-1, CLR_BAR_OVER);
end;
end;
if (PeakRight > BX) and (PeakRight <= BX + BW) then
begin
ACanvas.Pen.Color := CLR_PEAK_MARKER; ACanvas.Pen.Width := 2;
ACanvas.MoveTo(PeakRight, Y_BAR_TOP - (Y_BAR_BOT - Y_BAR_TOP));
ACanvas.LineTo(PeakRight, Y_BAR_BOT + (Y_BAR_BOT - Y_BAR_TOP));
ACanvas.Pen.Width := 1;
end;
// Рамка: от левого края зоны надписей до правого края шкалы
ACanvas.Brush.Style := bsClear; ACanvas.Pen.Color := CLR_BDR;
ACanvas.Rectangle(LblZoneL, Y_BAR_TOP, BX + BW, Y_BAR_BOT);
// разделитель между зоной надписей и шкалой
ACanvas.Pen.Color := FTheme.SMeterDivider;
ACanvas.MoveTo(BX, Y_BAR_TOP + 1); ACanvas.LineTo(BX, Y_BAR_BOT - 1);
// --- Шкальные тики и надписи ---
ACanvas.Font.Size := 6; ACanvas.Font.Style := []; ACanvas.Brush.Style := bsClear;
for i := 0 to High(DBM_MARKS) do
begin
X := DBtoX(DBM_MARKS[i]);
VLine(X, Y_BAR_TOP - TICK_LONG, Y_BAR_TOP - 1, CLR_TICK_WHITE);
Lbl := DBM_LABELS[i]; TW := ACanvas.TextWidth(Lbl);
ACanvas.Font.Color := CLR_SCALE_DBM;
ACanvas.TextOut(X - TW div 2, Y_BAR_TOP - TICK_LONG - ACanvas.TextHeight(Lbl) - 1, Lbl);
end;
i := -125;
while i < -13 do
begin
X := DBtoX(i); VLine(X, Y_BAR_TOP - TICK_MED, Y_BAR_TOP - 1, CLR_TICK_GREEN);
Inc(i, 5);
end;
for i := 0 to High(S_MARKS_DBM) do
begin
X := DBtoX(S_MARKS_DBM[i]);
if S_MARKS_DBM[i] >= DB_S9 then VLine(X, Y_BAR_BOT+1, Y_BAR_BOT+TICK_LONG, CLR_TICK_BLUE)
else VLine(X, Y_BAR_BOT+1, Y_BAR_BOT+TICK_LONG, CLR_TICK_GREEN);
Lbl := S_MARKS_LBL[i]; TW := ACanvas.TextWidth(Lbl);
if S_MARKS_DBM[i] >= DB_S9 then ACanvas.Font.Color := CLR_SCALE_S_BLUE
else ACanvas.Font.Color := CLR_SCALE_S_GREEN;
ACanvas.TextOut(X - TW div 2, Y_BAR_BOT + TICK_LONG + 1, Lbl);
end;
// --- Надписи в левой зоне, левовыровнены к LblZoneL+4 ---
ACanvas.Brush.Style := bsClear;
ACanvas.Font.Size := 10; ACanvas.Font.Style := [fsBold]; TH10 := ACanvas.TextHeight('0');
ACanvas.Font.Size := 6; ACanvas.Font.Style := []; TH6 := ACanvas.TextHeight('0');
// "-85.3" над "dBm", снизу прижаты к верхнему краю полосы
ACanvas.Font.Size := 10; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_LABEL_DBM;
ACanvas.TextOut(LblZoneL + 4, Y_BAR_TOP - TH10 - 2, LblDbm);
ACanvas.Font.Size := 6; ACanvas.Font.Style := []; ACanvas.Font.Color := CLR_TICK_BLUE;
ACanvas.TextOut(LblZoneL + 4 + TWDbm + 2, Y_BAR_TOP - TH6 - 4, 'dBm');
// S-значение под полосой, левый край у LblZoneL+4
ACanvas.Font.Size := 10; ACanvas.Font.Style := [fsBold]; ACanvas.Font.Color := CLR_LABEL_S;
ACanvas.TextOut(LblZoneL + 4, Y_BAR_BOT + 2, LblS);
end;
procedure TSpectrumView.DrawSMeterZone(ACanvas: TCanvas; R: TRect;
X1, X2, Y1, Y2: Integer);
const ALPHA = 16384;
var Img: TLazIntfImage; FC: TFPColor; IX, IY: Integer;
begin
if (X2 <= X1) or (FSmBitmap = nil) then Exit;
Img := FSmBitmap.CreateIntfImage;
try
for IY := Y1 to Y2 - 1 do
for IX := X1 to X2 - 1 do
begin
FC := Img.Colors[IX, IY];
FC.Red := Min(65535, FC.Red + ALPHA);
FC.Green := Min(65535, FC.Green + ALPHA);
FC.Blue := Min(65535, FC.Blue + ALPHA);
Img.Colors[IX, IY] := FC;
end;
FSmBitmap.LoadFromIntfImage(Img);
finally Img.Free; end;
end;
// ────────────────────────────────────────────────────────────────────────────
// Paint-обработчики
// ────────────────────────────────────────────────────────────────────────────
procedure TSpectrumView.PaintSpectrum(Sender: TObject);
var PB: TPaintBox;
begin
PB := TPaintBox(Sender);
if (FSpectrumBitmap.Width > 0) and (FSpectrumBitmap.Height > 0) then
PB.Canvas.Draw(0, 0, FSpectrumBitmap)
else begin
PB.Canvas.Brush.Color := SV_CLR_BG;
PB.Canvas.FillRect(Rect(0, 0, PB.Width, PB.Height));
end;
end;
procedure TSpectrumView.PaintWaterfall(Sender: TObject);
var PB: TPaintBox; W, H: Integer;
begin
PB := TPaintBox(Sender);
W := PB.Width; H := PB.Height;
if (W <= 0) or (H <= 0) then Exit;
if (FWfBitmap <> nil) and (FWfBitmap.Width = W) and (FWfBitmap.Height = H) then
PB.Canvas.Draw(0, 0, FWfBitmap)
else begin
PB.Canvas.Brush.Color := FTheme.Panel;
PB.Canvas.FillRect(Rect(0, 0, W, H));
end;
if FMarkerActive then DrawMarkerLine(PB.Canvas, W, H);
end;
procedure TSpectrumView.PaintRuler(Sender: TObject);
var PB: TPaintBox;
begin
PB := TPaintBox(Sender);
DrawRuler;
if (FRulerBitmap.Width > 0) and (FRulerBitmap.Height > 0) then
PB.Canvas.Draw(0, 0, FRulerBitmap);
end;
procedure TSpectrumView.PaintSMeterRight(Sender: TObject);
var PB: TPaintBox; W, H, ZX1, ZX2, ZY1, ZY2: Integer;
begin
PB := TPaintBox(Sender);
W := PB.Width; H := PB.Height;
if (W <= 0) or (H <= 0) then Exit;
if (FSmBitmap = nil) or (FSmBitmap.Width <> W) or (FSmBitmap.Height <> H) then
begin
FreeAndNil(FSmBitmap);
FSmBitmap := TBitmap.Create;
FSmBitmap.SetSize(W, H);
end;
DrawSMeterWide(FSmBitmap.Canvas, Rect(0, 0, W, H),
FLastSMeter, FSMeterPeak, FSMeterMin,
ZX1, ZX2, ZY1, ZY2);
DrawSMeterZone(FSmBitmap.Canvas, Rect(0, 0, W, H), ZX1, ZX2, ZY1, ZY2);
PB.Canvas.Draw(0, 0, FSmBitmap);
end;
procedure TSpectrumView.PaintFwdPower(Sender: TObject);
var PB: TPaintBox;
begin
PB := TPaintBox(Sender);
DrawBarMeter(PB.Canvas, Rect(0, 0, PB.Width, PB.Height),
FLastFwdW, 150, SV_CLR_METER_ON);
end;
procedure TSpectrumView.PaintSWR(Sender: TObject);
var PB: TPaintBox;
begin
PB := TPaintBox(Sender);
DrawBarMeter(PB.Canvas, Rect(0, 0, PB.Width, PB.Height),
FLastSWR - 1.0, 4.0, SV_CLR_AMBER);
end;
end.
Reference in New Issue View Git Blame Copy Permalink