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
e9d6b70de9a1a0c5c0ef6f204c8a9cad36bf8160
ewsdr/SpectrumView.pas
T
ew8bak d70c4a96ae Fix S-meter top layout
2026-04-28 21:42:12 +03:00

1173 lines
49 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;
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;
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 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;
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;
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(Alpha shr 1); RG := Byte(Alpha);
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] := 0;
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 := SV_CLR_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.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, TColor($0020160B), TColor($006C4F1F));
LabelBandW := 28;
GC.Pen.Style := psClear; GC.Brush.Style := bsSolid;
GC.Brush.Color := TColor($00543F18);
GC.FillRect(Rect(0, 0, LabelBandW, H));
GC.Pen.Style := psSolid;
GC.Font.Size := 7; GC.Font.Name := 'Courier New';
GC.Font.Color := TColor($00A8C9D9);
GC.Brush.Style := bsClear;
dB := DBmax - FSpecGridStep;
while dB >= DBmin do
begin
Yp := Round((DBmax - dB) * InvRange * H);
GC.Pen.Color := TColor($00685624); 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 := TColor($00685624);
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 := TColor($006A4E22); 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 := TColor($0000AAFF); C.Pen.Width := 1; C.Pen.Style := psDash;
C.MoveTo(0, AGCy); C.LineTo(W, AGCy);
C.Pen.Style := psSolid; C.Font.Color := TColor($0000AAFF); 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 := TColor($00FFCC00); C.Pen.Width := 1; C.Pen.Style := psDot;
C.MoveTo(0, AGCHangY); C.LineTo(W, AGCHangY);
C.Pen.Style := psSolid; C.Font.Color := TColor($00FFCC00); 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 := TColor($0000AAFF); C.Pen.Width := 1; C.Pen.Style := psDash;
C.MoveTo(0, AGCy); C.LineTo(W, AGCy);
C.Pen.Style := psSolid; C.Font.Color := TColor($0000AAFF); 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 := TColor($0040FF80); C.Pen.Width := 1;
C.Polyline(Slice(FSpPts, W));
// ── 7. Края фильтра + VFO ─────────────────────────────────────────────────
C.Pen.Color := TColor($0040FFCC); 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 := TColor($0000AAFF); C.Pen.Width := 2;
C.MoveTo(VfoX, 0); C.LineTo(VfoX, H - 12);
C.Brush.Color := TColor($0000AAFF); 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);
FillDWord(FWfPixels[0], W * H, 0);
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;
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, TColor($00372A12), TColor($00705A2A));
C.Pen.Color := TColor($00685624); 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 := TColor($00685624);
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 := TColor($00C8D8E2);
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 := TColor($0000FF80); 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 := TColor($00080808);
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');
CLR_SMETER_BG = TColor($00181818);
CLR_BAR_GREEN = TColor($00091F00);
CLR_BAR_OVER = TColor($00091528);
CLR_PEAK_MARKER = TColor($00F8F8FF);
CLR_TICK_GREEN = TColor($00708070);
CLR_TICK_WHITE = TColor($00E0E0DC);
CLR_TICK_BLUE = TColor($0070A090);
CLR_LABEL_DBM = TColor($0096D8DC);
CLR_LABEL_S = TColor($00F0F0F0);
CLR_SCALE_DBM = TColor($00D0DCDC);
CLR_SCALE_S_GREEN = TColor($00E0E0E0);
CLR_SCALE_S_BLUE = TColor($0090D090);
CLR_BDR = TColor($00303028);
LEFT_INFO_MIN = 62; RIGHT_PAD = 8; LABEL_PAD = 4;
TICK_LONG = 5; TICK_MED = 3;
var
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
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, TColor($00061006));
FillBar(S9X, Y_BAR_TOP, OvrX, Y_BAR_BOT, TColor($000A1006));
FillBar(OvrX, Y_BAR_TOP, BX + BW, Y_BAR_BOT, TColor($00060A10));
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 := TColor($00404040);
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 := TColor($00507070);
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 := clBlack;
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