Files
ewsdr/VfoOverlay.pas
T
ew8bakandClaude Opus 4.8 4a92256e72 feat(overlay): redesign VfoOverlay in SmartSDR slice-flag style
Полный редизайн накладки поверх спектра: шапка (слайс-бейдж A/B, ширина
фильтра, кликабельный SPLIT, индикатор TX), метр-ряд (индикаторы NR/NB/ANF/
SNB + сигнал-бар), крупная частота + S, нижний бар с fly-out пикерами.

- Fly-out движок MODE/DSP/AUD (раскрываются под баром, карточка растёт):
  MODE — сетка режимов 4×2 + фильтры; DSP — NR/NB/SNB/ANF + AGC; AUD —
  выбор аудио-устройства вывода (задел под слайсы).
- Слайдер громкости (click+drag) + mute; SPLIT-toggle; live TX-индикатор.
- Все контролы подключены к RadioController (SetVolume/ToggleMute/SetSplit/
  EnumOutputDevices→ApplyAudioDevice); wire в MainForm + HandleMouseUp, чтобы
  клик по накладке не уходил в спектр.
- FormatFreq на Int64 (double накапливал ошибку в десятки Гц на ~10 ГГц QO-100).
- S-метр ниже по высоте + плавный градиент по уровню dBm: тёмно-зелёный→
  зелёный→жёлтый→красный (красный к ~S9+18).
- Кэш+dirty рендер сохранён (CPU-паритет со старой накладкой), GL-путь через
  DrawOverlayBitmap.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-07-01 14:00:59 +03:00

1100 lines
35 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
unit VfoOverlay;
{$mode objfpc}{$H+}
{
TVfoOverlay — накладка-«флаг слайса» поверх спектра, стиль SmartSDR.
Компоновка (сверху вниз):
шапка : [A] 2.7k SPLIT [TX]
метр : NR NB ANF SNB ▂▃▅▇█▆▄ -20 +20 +40
частота : 7.125.000 S 7
бар : 🔊──○── MODE DSP AUD
Нижний бар компактный; клик по MODE/DSP/AUD раскрывает fly-out панель ПОД баром
(карточка растёт в высоту). Слайдер громкости — click/drag по треку.
Рендер: кэш-битмап (BlendBitmapKey с key-color) + dirty-флаг, как раньше.
}
interface
uses
Classes, SysUtils, Controls, Graphics, Types, Math;
const
VFO_OVERLAY_ALPHA = 210;
OVL_W = 280; // ширина карточки
type
TModeFilterEvent = procedure(Mode: Integer; FilterBW: Integer) of object;
TDSPChangeEvent = procedure(NRMode, NBMode: Integer; SNBOn, ANFOn: Boolean) of object;
TAGCChangeEvent = procedure(AGCMode: Integer) of object;
TVolumeEvent = procedure(Vol: Integer) of object;
TAudioDeviceEvent = procedure(DevIndex: Integer; const DevName: string) of object;
TFlyPanel = (fpNone, fpMode, fpDsp, fpAud);
TVfoOverlay = class(TCustomControl)
private
FMode: Integer;
FFilterBW: Integer;
FVfoHz: Double;
FSMeterDB: Double;
FModeFilter: array[0..7] of Integer;
FNRMode: Integer; // 0=off, 1..4
FNBMode: Integer; // 0=off, 1=NB, 2=NB2
FSNBOn: Boolean;
FANFOn: Boolean;
FAGCMode: Integer; // 0=FAST 1=MED 2=SLOW 3=LONG 4=OFF
FVolume: Integer; // 0..100
FMuted: Boolean;
FSplit: Boolean;
FTx: Boolean;
FSlice: Char; // буква слайса ('A')
FDevNames: TStringList; // имена устройств вывода
FDevIdx: array of Integer; // соответствующие PortAudio-индексы (-1=default)
FCurDev: string; // имя текущего устройства ('' = default)
FPanel: TFlyPanel; // открытая fly-out панель
FVolTrack: TRect; // трек громкости (локальные координаты)
FVolDrag: Boolean;
FOnSelect: TModeFilterEvent;
FOnDSPChange: TDSPChangeEvent;
FOnAGCChange: TAGCChangeEvent;
FOnVolume: TVolumeEvent;
FOnMute: TNotifyEvent;
FOnAudioDevice: TAudioDeviceEvent;
FOnSplit: TNotifyEvent;
FOnInvalidate: TNotifyEvent;
FHitRects: array[0..63] of TRect;
FHitActions: array[0..63] of Integer;
FHitCount: Integer;
FHotIdx: Integer;
FCacheBitmap: TBitmap;
FCacheDirty: Boolean;
procedure DrawSelf(C: TCanvas; W, H: Integer);
procedure DrawButton(C: TCanvas; const R: TRect; const Lbl: string;
Active, Hot: Boolean; FontSz: Integer);
procedure DrawIndicator(C: TCanvas; X, Y: Integer; const Lbl: string; On_: Boolean);
procedure DrawBadge(C: TCanvas; const R: TRect; const Lbl: string;
BgColor, TxtColor: TColor);
procedure DrawSpeaker(C: TCanvas; X, Y: Integer; Muted: Boolean);
procedure DrawMeterBar(C: TCanvas; X, Y, BW, BH: Integer);
procedure DrawModePanel(C: TCanvas; X, Y, RowW: Integer);
procedure DrawDspPanel(C: TCanvas; X, Y, RowW: Integer);
procedure DrawAudPanel(C: TCanvas; X, Y, RowW: Integer);
procedure RegisterHit(const HR: TRect; HV: Integer);
function FormatFreq(Hz: Double): string;
function GetFilterBWForMode(ModeIdx, FilterIdx: Integer): Integer;
function GetFilterLblForMode(ModeIdx, FilterIdx: Integer): string;
function GetFilterCountForMode(ModeIdx: Integer): Integer;
function PanelContentH: Integer;
function ComputeHeight: Integer;
procedure SetPanel(P: TFlyPanel);
procedure ApplyVolFromX(LX: Integer);
procedure RequestInvalidate;
procedure DoHit(HV: Integer);
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseLeave; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawOverlay(Target: TBitmap; W, H: Integer);
procedure DrawOverlayBitmap(Target: TBitmap);
function HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
function HandleMouseMove(X, Y: Integer): Boolean;
function HandleMouseUp(X, Y: Integer): Boolean;
function HandleMouseLeave: Boolean;
procedure SetState(AMode, ABW: Integer; AVfoHz, ASMeterDB: Double);
procedure SetDSPState(ANRMode, ANBMode: Integer; ASNBOn, AANFOn: Boolean;
AAGCMode: Integer);
procedure SetExtState(AVolume: Integer; AMuted, ASplit, ATx: Boolean);
procedure SetAudioDevices(Names: TStrings; const Indices: array of Integer;
const CurName: string);
procedure UpdateSMeter(DB: Double);
procedure UpdateVfo(AVfoHz: Double);
property HotIdx: Integer read FHotIdx;
property BaseHeight: Integer read ComputeHeight;
property OnSelect: TModeFilterEvent read FOnSelect write FOnSelect;
property OnDSPChange: TDSPChangeEvent read FOnDSPChange write FOnDSPChange;
property OnAGCChange: TAGCChangeEvent read FOnAGCChange write FOnAGCChange;
property OnVolume: TVolumeEvent read FOnVolume write FOnVolume;
property OnMute: TNotifyEvent read FOnMute write FOnMute;
property OnAudioDevice: TAudioDeviceEvent read FOnAudioDevice write FOnAudioDevice;
property OnSplit: TNotifyEvent read FOnSplit write FOnSplit;
property OnInvalidate: TNotifyEvent read FOnInvalidate write FOnInvalidate;
end;
implementation
const
KEY_COLOR = TColor($00FF00FF);
// Значения хит-тестов
// режимы: -(I+1) = -1..-8
// фильтры: BW в Гц (>0)
// AGC: HIT_AGC_PICK_BASE+I
// устройства: HIT_DEV_BASE+I
HIT_NR = -9;
HIT_NB = -10;
HIT_SNB = -11;
HIT_ANF = -12;
HIT_BAR_MODE = -20;
HIT_BAR_DSP = -21;
HIT_BAR_AUD = -22;
HIT_MUTE = -23;
HIT_VOL = -24;
HIT_SPLIT = -25;
HIT_AGC_PICK_BASE = 100000;
HIT_DEV_BASE = 200000;
AGC_NAMES: array[0..4] of string = ('FAST', 'MED', 'SLOW', 'LONG', 'OFF');
// Геометрия карточки
PAD = 6;
HDR_H = 16;
MET_H = 18;
FRQ_H = 26;
BAR_H = 24;
ROW_H = 20;
IGAP = 2;
OVL_BASE_H = PAD + HDR_H + MET_H + FRQ_H + BAR_H + PAD; // = 96
// Палитра
CLR_CARD_BG = TColor($00191919);
CLR_BORDER = TColor($00484848);
CLR_SEP = TColor($00303030);
CLR_TEXT = TColor($00E4E4E4);
CLR_DIM = TColor($00707070);
CLR_ACCENT = TColor($0040FF80); // зелёный акцент
CLR_ACCENT_D = TColor($00103018); // тёмный акцент (фон активной)
CLR_BTN_NORM = TColor($00262626);
CLR_BTN_HOT = TColor($00383838);
CLR_FREQ = TColor($0050FF80);
CLR_SVAL = TColor($0030C8FF);
CLR_BAR_BG = TColor($00101010);
CLR_TX_ON = TColor($000030E0); // красный TX (BGR)
CLR_SPLIT_ON = TColor($0020C0FF); // оранжевый SPLIT
OVL_MODE_COUNT = 8;
OVL_MODE_NAMES: array[0..7] of string = (
'LSB','USB','DSB','CWL','CWU','FM','AM','SAM');
SSB_BW: array[0..5] of Integer = (1800,2100,2400,2700,3300,3800);
SSB_LBL: array[0..5] of string = ('1.8K','2.1K','2.4K','2.7K','3.3K','3.8K');
DSB_BW: array[0..5] of Integer = (16000,12000,10000,8000,5200,4000);
DSB_LBL: array[0..5] of string = ('16K','12K','10K','8K','5.2K','4K');
CW_BW: array[0..5] of Integer = (500,250,150,100,50,1000);
CW_LBL: array[0..5] of string = ('500','250','150','100','50','1K');
FM_BW: array[0..1] of Integer = (11000, 16000);
FM_LBL: array[0..1] of string = ('NFM', 'FM');
AM_BW: array[0..5] of Integer = (20000,16000,12000,10000,8000,6000);
AM_LBL: array[0..5] of string = ('20K','16K','12K','10K','8K','6K');
DB_S: array[1..9] of Double = (-121,-115,-109,-103,-97,-91,-85,-79,-73);
procedure BlendBitmapKey(Target, Source: TBitmap; DstX, DstY: Integer; Alpha: Byte);
var
Y, X, SX0, SY0, SX1, SY1, TY, InvA: Integer;
SrcRow, DstRow: PByte;
begin
if (Target = nil) or (Source = nil) or (Alpha = 0) then Exit;
SX0 := 0; SY0 := 0;
SX1 := Source.Width; SY1 := Source.Height;
if DstX < 0 then begin SX0 := -DstX; DstX := 0; end;
if DstY < 0 then begin SY0 := -DstY; DstY := 0; end;
if DstX + (SX1 - SX0) > Target.Width then SX1 := SX0 + Target.Width - DstX;
if DstY + (SY1 - SY0) > Target.Height then SY1 := SY0 + Target.Height - DstY;
if (SX1 <= SX0) or (SY1 <= SY0) then Exit;
InvA := 255 - Alpha;
Target.BeginUpdate(False);
Source.BeginUpdate(False);
try
for Y := SY0 to SY1 - 1 do
begin
TY := DstY + (Y - SY0);
SrcRow := PByte(Source.ScanLine[Y]);
DstRow := PByte(Target.ScanLine[TY]);
if (SrcRow = nil) or (DstRow = nil) then Continue;
Inc(SrcRow, SX0 * 4);
Inc(DstRow, DstX * 4);
for X := SX0 to SX1 - 1 do
begin
{$IFDEF DARWIN}
if not ((SrcRow[1] = $FF) and (SrcRow[2] = $00) and (SrcRow[3] = $FF)) then
begin
DstRow[1] := Byte((Alpha * SrcRow[1] + InvA * DstRow[1]) div 255);
DstRow[2] := Byte((Alpha * SrcRow[2] + InvA * DstRow[2]) div 255);
DstRow[3] := Byte((Alpha * SrcRow[3] + InvA * DstRow[3]) div 255);
end;
{$ELSE}
if not ((SrcRow[0] = $FF) and (SrcRow[1] = $00) and (SrcRow[2] = $FF)) then
begin
DstRow[0] := Byte((Alpha * SrcRow[0] + InvA * DstRow[0]) div 255);
DstRow[1] := Byte((Alpha * SrcRow[1] + InvA * DstRow[1]) div 255);
DstRow[2] := Byte((Alpha * SrcRow[2] + InvA * DstRow[2]) div 255);
end;
{$ENDIF}
Inc(SrcRow, 4);
Inc(DstRow, 4);
end;
end;
finally
Source.EndUpdate(False);
Target.EndUpdate(False);
end;
end;
function DBmToSLabel(DB: Double): string;
var
I, Over: Integer;
begin
if DB >= DB_S[9] then
begin
Over := Round(DB - DB_S[9]);
if Over < 5 then Result := 'S9'
else
begin
Over := ((Over + 5) div 10) * 10;
if Over = 0 then Over := 10;
Result := 'S9+' + IntToStr(Over);
end;
end
else if DB <= DB_S[1] then Result := 'S1'
else
begin
Result := 'S1';
for I := 1 to 8 do
if DB >= DB_S[I] then Result := 'S' + IntToStr(I);
end;
end;
{ ---- Фильтры по режиму ---- }
function TVfoOverlay.GetFilterBWForMode(ModeIdx, FilterIdx: Integer): Integer;
begin
case ModeIdx of
0,1: Result := SSB_BW[FilterIdx];
2: Result := DSB_BW[FilterIdx];
3,4: Result := CW_BW[FilterIdx];
5: Result := FM_BW[FilterIdx];
else Result := AM_BW[FilterIdx];
end;
end;
function TVfoOverlay.GetFilterLblForMode(ModeIdx, FilterIdx: Integer): string;
begin
case ModeIdx of
0,1: Result := SSB_LBL[FilterIdx];
2: Result := DSB_LBL[FilterIdx];
3,4: Result := CW_LBL[FilterIdx];
5: Result := FM_LBL[FilterIdx];
else Result := AM_LBL[FilterIdx];
end;
end;
function TVfoOverlay.GetFilterCountForMode(ModeIdx: Integer): Integer;
begin
if ModeIdx = 5 then Result := 2 else Result := 6;
end;
{ ---- Lifecycle ---- }
constructor TVfoOverlay.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
FMode := 1;
FFilterBW := 2700;
FVfoHz := 14200000;
FSMeterDB := -121;
FHitCount := 0;
FHotIdx := -1;
FModeFilter[0] := 2700; FModeFilter[1] := 2700; FModeFilter[2] := 8000;
FModeFilter[3] := 500; FModeFilter[4] := 500; FModeFilter[5] := 11000;
FModeFilter[6] := 8000; FModeFilter[7] := 8000;
FNRMode := 0; FNBMode := 0; FSNBOn := False; FANFOn := False; FAGCMode := 0;
FVolume := 70; FMuted := False; FSplit := False; FTx := False; FSlice := 'A';
FPanel := fpNone;
FVolDrag := False;
FDevNames := TStringList.Create;
FCurDev := '';
FCacheBitmap := TBitmap.Create;
FCacheBitmap.PixelFormat := pf32bit;
FCacheDirty := True;
Width := OVL_W;
Height := OVL_BASE_H;
Cursor := crHandPoint;
end;
destructor TVfoOverlay.Destroy;
begin
FDevNames.Free;
FCacheBitmap.Free;
inherited Destroy;
end;
procedure TVfoOverlay.RegisterHit(const HR: TRect; HV: Integer);
begin
if FHitCount > High(FHitRects) then Exit;
FHitRects[FHitCount] := HR;
FHitActions[FHitCount] := HV;
Inc(FHitCount);
end;
procedure TVfoOverlay.RequestInvalidate;
begin
FCacheDirty := True;
inherited Invalidate;
if Assigned(FOnInvalidate) then FOnInvalidate(Self);
end;
function TVfoOverlay.FormatFreq(Hz: Double): string;
var
T, iM, iK, iH: Int64;
begin
// Целочисленная математика (как FreqDispA := Round(FVfoA)): арифметика в double
// на частотах ~1e10 (QO-100) накапливает ошибку в десятки Гц.
T := Round(Hz);
iM := T div 1000000;
iK := (T div 1000) mod 1000;
iH := T mod 1000;
Result := Format('%d.%3.3d.%3.3d', [iM, iK, iH]);
end;
{ ---- Высота с учётом fly-out ---- }
function TVfoOverlay.PanelContentH: Integer;
begin
case FPanel of
fpMode: Result := ROW_H*2 + IGAP + ROW_H + IGAP; // 2 ряда режимов + ряд фильтров
fpDsp: Result := ROW_H + IGAP + ROW_H; // toggles + AGC
fpAud: Result := Max(1, FDevNames.Count) * 17;
else Result := 0;
end;
end;
function TVfoOverlay.ComputeHeight: Integer;
begin
if FPanel = fpNone then Result := OVL_BASE_H
else Result := OVL_BASE_H + IGAP + PanelContentH + PAD;
end;
procedure TVfoOverlay.SetPanel(P: TFlyPanel);
begin
if FPanel = P then FPanel := fpNone else FPanel := P;
Height := ComputeHeight;
RequestInvalidate;
end;
{ ---- Примитивы отрисовки ---- }
procedure TVfoOverlay.DrawButton(C: TCanvas; const R: TRect; const Lbl: string;
Active, Hot: Boolean; FontSz: Integer);
begin
if Active then C.Brush.Color := CLR_ACCENT
else if Hot then C.Brush.Color := CLR_BTN_HOT
else C.Brush.Color := CLR_BTN_NORM;
C.Brush.Style := bsSolid;
C.Pen.Style := psSolid;
C.Pen.Color := C.Brush.Color;
C.RoundRect(R.Left, R.Top, R.Right, R.Bottom, 5, 5);
if Active then C.Font.Color := CLR_CARD_BG
else C.Font.Color := CLR_TEXT;
C.Font.Name := 'Courier New';
C.Font.Size := FontSz;
C.Font.Style := [];
C.Brush.Style := bsClear;
C.TextOut(R.Left + (R.Right - R.Left - C.TextWidth(Lbl)) div 2,
R.Top + (R.Bottom - R.Top - C.TextHeight('A')) div 2, Lbl);
end;
procedure TVfoOverlay.DrawIndicator(C: TCanvas; X, Y: Integer; const Lbl: string;
On_: Boolean);
begin
C.Font.Name := 'Courier New';
C.Font.Size := 7;
C.Font.Style := [fsBold];
C.Brush.Style := bsClear;
if On_ then C.Font.Color := CLR_ACCENT else C.Font.Color := CLR_DIM;
C.TextOut(X, Y, Lbl);
end;
procedure TVfoOverlay.DrawBadge(C: TCanvas; const R: TRect; const Lbl: string;
BgColor, TxtColor: TColor);
begin
C.Brush.Color := BgColor;
C.Brush.Style := bsSolid;
C.Pen.Style := psSolid;
C.Pen.Color := BgColor;
C.RoundRect(R.Left, R.Top, R.Right, R.Bottom, 4, 4);
C.Font.Name := 'Courier New';
C.Font.Size := 7;
C.Font.Style := [fsBold];
C.Font.Color := TxtColor;
C.Brush.Style := bsClear;
C.TextOut(R.Left + (R.Right - R.Left - C.TextWidth(Lbl)) div 2,
R.Top + (R.Bottom - R.Top - C.TextHeight('A')) div 2, Lbl);
end;
procedure TVfoOverlay.DrawSpeaker(C: TCanvas; X, Y: Integer; Muted: Boolean);
var
Pts: array[0..5] of TPoint;
Col: TColor;
begin
if Muted then Col := CLR_DIM else Col := CLR_TEXT;
Pts[0] := Point(X, Y+4);
Pts[1] := Point(X+3, Y+4);
Pts[2] := Point(X+7, Y);
Pts[3] := Point(X+7, Y+12);
Pts[4] := Point(X+3, Y+8);
Pts[5] := Point(X, Y+8);
C.Brush.Color := Col;
C.Brush.Style := bsSolid;
C.Pen.Color := Col;
C.Pen.Style := psSolid;
C.Polygon(Pts);
if Muted then
begin
C.Pen.Color := CLR_TX_ON;
C.Pen.Width := 2;
C.MoveTo(X+9, Y); C.LineTo(X+14, Y+12);
C.Pen.Width := 1;
end
else
begin
C.Pen.Color := CLR_ACCENT;
C.MoveTo(X+9, Y+3); C.LineTo(X+11, Y+6); C.LineTo(X+9, Y+9);
C.MoveTo(X+11, Y+1); C.LineTo(X+14, Y+6); C.LineTo(X+11, Y+11);
end;
end;
// Цвет S-метра по УРОВНЮ (dBm): тёмно-зелёный → зелёный → жёлтый → красный.
// Опоры привязаны к S-делениям, а не к длине бара: красный достигается уже
// к ~S9+18, чтобы сильные сигналы (S9+10) были ближе к красному.
function MeterGradColor(DB: Double): TColor;
const
DS: array[0..3] of Double = (-121, -85, -73, -55); // S1, S7, S9, S9+18
RS: array[0..3] of Integer = ( 0, 30, 245, 235);
GS: array[0..3] of Integer = ( 85, 205, 215, 35);
BS: array[0..3] of Integer = ( 0, 40, 0, 20);
var
I, R, G, B: Integer;
T: Double;
begin
if DB <= DS[0] then begin R := RS[0]; G := GS[0]; B := BS[0]; end
else if DB >= DS[3] then begin R := RS[3]; G := GS[3]; B := BS[3]; end
else
begin
I := 0;
while (I < 3) and (DB > DS[I+1]) do Inc(I);
T := (DB - DS[I]) / (DS[I+1] - DS[I]);
R := RS[I] + Round((RS[I+1] - RS[I]) * T);
G := GS[I] + Round((GS[I+1] - GS[I]) * T);
B := BS[I] + Round((BS[I+1] - BS[I]) * T);
end;
Result := TColor((B shl 16) or (G shl 8) or R);
end;
procedure TVfoOverlay.DrawMeterBar(C: TCanvas; X, Y, BW, BH: Integer);
const
DB_MIN = -127.0;
DB_MAX = -13.0;
S_POS: array[0..7] of Double = (-121,-109,-97,-85,-73,-53,-33,-13);
S_LBL: array[0..7] of string = ('1','3','5','7','9','+20','+40','+60');
var
I, BarEnd, PX, BarH, TW, Col: Integer;
T: Double;
begin
BarH := BH - 9;
C.Brush.Color := CLR_BAR_BG;
C.Brush.Style := bsSolid;
C.Pen.Style := psClear;
C.FillRect(Rect(X, Y, X+BW, Y+BarH));
T := Max(0.0, Min(1.0, (FSMeterDB - DB_MIN) / (DB_MAX - DB_MIN)));
BarEnd := Min(X + Round(T * BW), X + BW - 1);
// Плавный градиент по всей ширине: цвет колонки = позиция на шкале.
C.Brush.Style := bsSolid;
C.Pen.Style := psClear;
Col := X + 1;
while Col < BarEnd do
begin
C.Brush.Color := MeterGradColor(DB_MIN + (Col - X) / BW * (DB_MAX - DB_MIN));
C.FillRect(Rect(Col, Y+1, Col+1, Y+BarH-1));
Inc(Col);
end;
C.Pen.Style := psSolid;
C.Pen.Color := CLR_BORDER;
C.Brush.Style := bsClear;
C.Rectangle(X, Y, X+BW, Y+BarH);
C.Font.Name := 'Courier New';
C.Font.Size := 5;
C.Font.Style := [];
for I := 0 to High(S_POS) do
begin
T := (S_POS[I] - DB_MIN) / (DB_MAX - DB_MIN);
PX := X + Round(T * BW);
TW := C.TextWidth(S_LBL[I]);
if I < 4 then C.Font.Color := CLR_DIM else C.Font.Color := CLR_ACCENT;
C.Pen.Color := CLR_DIM;
C.MoveTo(PX, Y+BarH); C.LineTo(PX, Y+BarH+2);
C.TextOut(PX - TW div 2, Y+BarH+1, S_LBL[I]);
end;
end;
{ ---- Fly-out панели ---- }
procedure TVfoOverlay.DrawModePanel(C: TCanvas; X, Y, RowW: Integer);
var
I, Col, Row, BX, BY, BW, FiltN, FBX, FBRight, BV: Integer;
HR: TRect;
begin
BW := (RowW - 3*3) div 4; // 4 колонки, зазор 3
for I := 0 to OVL_MODE_COUNT - 1 do
begin
Col := I mod 4; Row := I div 4;
BX := X + Col * (BW + 3);
BY := Y + Row * (ROW_H + IGAP);
HR := Rect(BX, BY, BX + BW, BY + ROW_H);
DrawButton(C, HR, OVL_MODE_NAMES[I], I = FMode,
(FHotIdx >= 0) and (FHitActions[FHotIdx] = -(I+1)), 7);
RegisterHit(HR, -(I+1));
end;
// Ряд фильтров текущего режима
FiltN := GetFilterCountForMode(FMode);
BY := Y + 2*(ROW_H + IGAP);
FBX := X;
for I := 0 to FiltN - 1 do
begin
FBRight := X + ((I+1) * RowW) div FiltN;
BV := GetFilterBWForMode(FMode, I);
HR := Rect(FBX, BY, FBRight - 2, BY + ROW_H);
DrawButton(C, HR, GetFilterLblForMode(FMode, I), BV = FFilterBW,
(FHotIdx >= 0) and (FHitActions[FHotIdx] = BV), 7);
RegisterHit(HR, BV);
FBX := FBRight;
end;
end;
procedure TVfoOverlay.DrawDspPanel(C: TCanvas; X, Y, RowW: Integer);
var
I, BX, BRight: Integer;
HR: TRect;
Lbl: string;
Act: Boolean;
const
TOG_HITS: array[0..3] of Integer = (HIT_NR, HIT_NB, HIT_SNB, HIT_ANF);
begin
// Ряд 1: NR / NB / SNB / ANF (тумблеры)
BX := X;
for I := 0 to 3 do
begin
BRight := X + ((I+1) * RowW) div 4;
HR := Rect(BX, Y, BRight - 2, Y + ROW_H);
case I of
0: begin
case FNRMode of 1: Lbl:='NR'; 2: Lbl:='NR2'; 3: Lbl:='NR3'; 4: Lbl:='NR4';
else Lbl:='NR'; end;
Act := FNRMode <> 0;
end;
1: begin if FNBMode = 2 then Lbl:='NB2' else Lbl:='NB'; Act := FNBMode <> 0; end;
2: begin Lbl:='SNB'; Act := FSNBOn; end;
else begin Lbl:='ANF'; Act := FANFOn; end;
end;
DrawButton(C, HR, Lbl, Act,
(FHotIdx >= 0) and (FHitActions[FHotIdx] = TOG_HITS[I]), 7);
RegisterHit(HR, TOG_HITS[I]);
BX := BRight;
end;
// Ряд 2: AGC режимы
Inc(Y, ROW_H + IGAP);
BX := X;
for I := 0 to 4 do
begin
BRight := X + ((I+1) * RowW) div 5;
HR := Rect(BX, Y, BRight - 2, Y + ROW_H);
DrawButton(C, HR, AGC_NAMES[I], I = FAGCMode,
(FHotIdx >= 0) and (FHitActions[FHotIdx] = HIT_AGC_PICK_BASE + I), 6);
RegisterHit(HR, HIT_AGC_PICK_BASE + I);
BX := BRight;
end;
end;
procedure TVfoOverlay.DrawAudPanel(C: TCanvas; X, Y, RowW: Integer);
var
I: Integer;
HR: TRect;
Nm: string;
Cur: Boolean;
begin
C.Font.Name := 'Courier New';
C.Font.Size := 7;
C.Font.Style := [];
if FDevNames.Count = 0 then
begin
C.Font.Color := CLR_DIM;
C.Brush.Style := bsClear;
C.TextOut(X, Y + 2, '(нет устройств)');
Exit;
end;
for I := 0 to FDevNames.Count - 1 do
begin
HR := Rect(X, Y + I*17, X + RowW, Y + I*17 + 16);
Nm := FDevNames[I];
Cur := (Nm = FCurDev) or ((FCurDev = '') and (I = 0));
if Cur then C.Brush.Color := CLR_ACCENT_D
else if (FHotIdx >= 0) and (FHitActions[FHotIdx] = HIT_DEV_BASE + I) then
C.Brush.Color := CLR_BTN_HOT
else C.Brush.Color := CLR_BTN_NORM;
C.Brush.Style := bsSolid;
C.Pen.Color := C.Brush.Color;
C.Pen.Style := psSolid;
C.RoundRect(HR.Left, HR.Top, HR.Right, HR.Bottom, 4, 4);
if Cur then C.Font.Color := CLR_ACCENT else C.Font.Color := CLR_TEXT;
C.Brush.Style := bsClear;
if C.TextWidth(Nm) > RowW - 8 then
while (Length(Nm) > 1) and (C.TextWidth(Nm + '…') > RowW - 8) do
SetLength(Nm, Length(Nm) - 1);
if Nm <> FDevNames[I] then Nm := Nm + '…';
C.TextOut(HR.Left + 4, HR.Top + (16 - C.TextHeight('A')) div 2, Nm);
RegisterHit(HR, HIT_DEV_BASE + I);
end;
end;
{ ---- Основная отрисовка ---- }
procedure TVfoOverlay.DrawSelf(C: TCanvas; W, H: Integer);
var
FreqStr, SStr, BWStr: string;
CurY, X, RW, i: Integer;
R: TRect;
BarL, BarW, MeterX: Integer;
begin
FHitCount := 0;
// Фон карточки
C.Brush.Color := CLR_CARD_BG;
C.Brush.Style := bsSolid;
C.Pen.Color := CLR_BORDER;
C.Pen.Style := psSolid;
C.Pen.Width := 1;
C.RoundRect(0, 0, W, H, 7, 7);
X := PAD;
RW := W - PAD*2;
CurY := PAD;
{ --- Шапка: [A] BW ... SPLIT [TX] --- }
DrawBadge(C, Rect(X, CurY, X+16, CurY+HDR_H-1), FSlice, CLR_ACCENT, CLR_CARD_BG);
// ширина фильтра
if FFilterBW >= 1000 then BWStr := Format('%.1fk', [FFilterBW/1000.0])
else BWStr := IntToStr(FFilterBW);
C.Font.Name := 'Courier New'; C.Font.Size := 8; C.Font.Style := [];
C.Font.Color := CLR_DIM; C.Brush.Style := bsClear;
C.TextOut(X + 22, CurY + 1, BWStr);
// TX badge (правый край)
R := Rect(W - PAD - 26, CurY, W - PAD, CurY + HDR_H - 1);
if FTx then DrawBadge(C, R, 'TX', CLR_TX_ON, clWhite)
else DrawBadge(C, R, 'TX', CLR_BTN_NORM, CLR_DIM);
// SPLIT (левее TX) — кликабельно
R := Rect(W - PAD - 26 - 44, CurY, W - PAD - 26 - 4, CurY + HDR_H - 1);
if FSplit then DrawBadge(C, R, 'SPLIT', CLR_SPLIT_ON, CLR_CARD_BG)
else DrawBadge(C, R, 'SPLIT', CLR_BTN_NORM, CLR_DIM);
RegisterHit(R, HIT_SPLIT);
Inc(CurY, HDR_H);
{ --- Метр: индикаторы + сигнал-бар --- }
DrawIndicator(C, X, CurY + 2, 'NR', FNRMode <> 0);
DrawIndicator(C, X + 24, CurY + 2, 'NB', FNBMode <> 0);
DrawIndicator(C, X + 48, CurY + 2, 'ANF', FANFOn);
DrawIndicator(C, X + 80, CurY + 2, 'SNB', FSNBOn);
MeterX := X + 112;
DrawMeterBar(C, MeterX, CurY, W - PAD - MeterX, MET_H);
Inc(CurY, MET_H);
{ --- Частота + S --- }
FreqStr := FormatFreq(FVfoHz);
C.Font.Name := 'Courier New'; C.Font.Size := 13; C.Font.Style := [fsBold];
C.Font.Color := CLR_FREQ; C.Brush.Style := bsClear;
C.TextOut(X + 2, CurY, FreqStr);
SStr := DBmToSLabel(FSMeterDB);
C.Font.Size := 9; C.Font.Color := CLR_SVAL;
C.TextOut(W - PAD - C.TextWidth(SStr) - 2, CurY + 6, SStr);
Inc(CurY, FRQ_H);
{ --- Нижний бар: 🔊 vol | MODE DSP AUD --- }
DrawSpeaker(C, X, CurY + (BAR_H-12) div 2, FMuted);
RegisterHit(Rect(X-1, CurY, X+16, CurY+BAR_H), HIT_MUTE);
// трек громкости
BarL := X + 20;
BarW := 56;
FVolTrack := Rect(BarL, CurY + BAR_H div 2 - 3, BarL + BarW, CurY + BAR_H div 2 + 3);
C.Brush.Color := CLR_BTN_NORM; C.Brush.Style := bsSolid;
C.Pen.Color := CLR_BTN_NORM; C.Pen.Style := psSolid;
C.RoundRect(FVolTrack.Left, FVolTrack.Top, FVolTrack.Right, FVolTrack.Bottom, 3, 3);
i := BarL + Round(FVolume/100.0 * BarW);
if not FMuted then
begin
C.Brush.Color := CLR_ACCENT; C.Pen.Color := CLR_ACCENT;
C.RoundRect(FVolTrack.Left, FVolTrack.Top, i, FVolTrack.Bottom, 3, 3);
end;
// ручка
C.Brush.Color := CLR_TEXT; C.Pen.Color := CLR_TEXT;
C.Ellipse(i-4, CurY + BAR_H div 2 - 5, i+4, CurY + BAR_H div 2 + 5);
RegisterHit(Rect(BarL-4, CurY, BarL + BarW + 4, CurY + BAR_H), HIT_VOL);
// 3 кнопки бара справа от трека
BarL := X + 20 + BarW + 8;
RW := (W - PAD) - BarL;
R := Rect(BarL, CurY + 2, BarL + (RW - 8) div 3, CurY + BAR_H - 2);
DrawButton(C, R, 'MODE', FPanel = fpMode,
(FHotIdx >= 0) and (FHitActions[FHotIdx] = HIT_BAR_MODE), 7);
RegisterHit(R, HIT_BAR_MODE);
R := Rect(R.Right + 4, CurY + 2, R.Right + 4 + (RW - 8) div 3, CurY + BAR_H - 2);
DrawButton(C, R, 'DSP', FPanel = fpDsp,
(FHotIdx >= 0) and (FHitActions[FHotIdx] = HIT_BAR_DSP), 7);
RegisterHit(R, HIT_BAR_DSP);
R := Rect(R.Right + 4, CurY + 2, W - PAD, CurY + BAR_H - 2);
DrawButton(C, R, 'AUD', FPanel = fpAud,
(FHotIdx >= 0) and (FHitActions[FHotIdx] = HIT_BAR_AUD), 7);
RegisterHit(R, HIT_BAR_AUD);
Inc(CurY, BAR_H);
{ --- Fly-out --- }
if FPanel <> fpNone then
begin
Inc(CurY, IGAP);
C.Pen.Color := CLR_SEP; C.Pen.Style := psSolid;
C.MoveTo(PAD, CurY); C.LineTo(W - PAD, CurY);
Inc(CurY, IGAP + 1);
case FPanel of
fpMode: DrawModePanel(C, PAD, CurY, W - PAD*2);
fpDsp: DrawDspPanel(C, PAD, CurY, W - PAD*2);
fpAud: DrawAudPanel(C, PAD, CurY, W - PAD*2);
end;
end;
end;
procedure TVfoOverlay.Paint;
begin
DrawSelf(Canvas, Width, Height);
end;
procedure TVfoOverlay.DrawOverlay(Target: TBitmap; W, H: Integer);
begin
if (not Visible) or (Target = nil) or (Width <= 0) or (Height <= 0) then Exit;
if (Left >= W) or (Top >= H) then Exit;
if (FCacheBitmap.Width <> Width) or (FCacheBitmap.Height <> Height) then
begin
FCacheBitmap.SetSize(Width, Height);
FCacheDirty := True;
end;
if FCacheDirty then
begin
FCacheBitmap.Canvas.Brush.Color := KEY_COLOR;
FCacheBitmap.Canvas.Brush.Style := bsSolid;
FCacheBitmap.Canvas.Pen.Style := psClear;
FCacheBitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
DrawSelf(FCacheBitmap.Canvas, Width, Height);
FCacheDirty := False;
end;
BlendBitmapKey(Target, FCacheBitmap, Left, Top, VFO_OVERLAY_ALPHA);
end;
procedure TVfoOverlay.DrawOverlayBitmap(Target: TBitmap);
begin
if (Target = nil) or (Width <= 0) or (Height <= 0) then Exit;
Target.PixelFormat := pf32bit;
Target.SetSize(Width, Height);
Target.Canvas.Brush.Color := KEY_COLOR;
Target.Canvas.Brush.Style := bsSolid;
Target.Canvas.Pen.Style := psClear;
Target.Canvas.FillRect(Rect(0, 0, Width, Height));
DrawSelf(Target.Canvas, Width, Height);
FCacheDirty := False;
end;
{ ---- Обработка хитов ---- }
procedure TVfoOverlay.DoHit(HV: Integer);
var
NewMode, NewBW: Integer;
begin
// Кнопки бара
case HV of
HIT_BAR_MODE: begin SetPanel(fpMode); Exit; end;
HIT_BAR_DSP: begin SetPanel(fpDsp); Exit; end;
HIT_BAR_AUD: begin SetPanel(fpAud); Exit; end;
HIT_MUTE: begin FMuted := not FMuted; RequestInvalidate;
if Assigned(FOnMute) then FOnMute(Self); Exit; end;
HIT_SPLIT: begin if Assigned(FOnSplit) then FOnSplit(Self); Exit; end;
end;
// Устройство аудио
if HV >= HIT_DEV_BASE then
begin
NewMode := HV - HIT_DEV_BASE; // индекс в списке
if (NewMode >= 0) and (NewMode < FDevNames.Count) then
begin
FCurDev := FDevNames[NewMode];
FPanel := fpNone; Height := ComputeHeight;
RequestInvalidate;
if Assigned(FOnAudioDevice) then
FOnAudioDevice(FDevIdx[NewMode], FDevNames[NewMode]);
end;
Exit;
end;
// AGC-режим
if HV >= HIT_AGC_PICK_BASE then
begin
FAGCMode := HV - HIT_AGC_PICK_BASE;
RequestInvalidate;
if Assigned(FOnAGCChange) then FOnAGCChange(FAGCMode);
Exit;
end;
// DSP-тумблеры (отрицательные HV — нельзя через set/in)
if (HV = HIT_NR) or (HV = HIT_NB) or (HV = HIT_SNB) or (HV = HIT_ANF) then
begin
case HV of
HIT_NR: FNRMode := (FNRMode + 1) mod 5;
HIT_NB: FNBMode := (FNBMode + 1) mod 3;
HIT_SNB: FSNBOn := not FSNBOn;
HIT_ANF: FANFOn := not FANFOn;
end;
RequestInvalidate;
if Assigned(FOnDSPChange) then FOnDSPChange(FNRMode, FNBMode, FSNBOn, FANFOn);
Exit;
end;
// Режим
if (HV < 0) and (HV >= -OVL_MODE_COUNT) then
begin
NewMode := (-HV) - 1;
if NewMode <> FMode then
begin
FModeFilter[FMode] := FFilterBW;
FMode := NewMode;
FFilterBW := FModeFilter[FMode];
Height := ComputeHeight; // число фильтров могло смениться (FM=2)
RequestInvalidate;
if Assigned(FOnSelect) then FOnSelect(FMode, FFilterBW);
end;
Exit;
end;
// Фильтр (BW>0)
if HV > 0 then
begin
NewBW := HV;
if NewBW <> FFilterBW then
begin
FFilterBW := NewBW;
FModeFilter[FMode] := FFilterBW;
RequestInvalidate;
if Assigned(FOnSelect) then FOnSelect(FMode, FFilterBW);
end;
end;
end;
procedure TVfoOverlay.ApplyVolFromX(LX: Integer);
var
V: Integer;
begin
if FVolTrack.Right <= FVolTrack.Left then Exit;
V := Round((LX - FVolTrack.Left) / (FVolTrack.Right - FVolTrack.Left) * 100);
if V < 0 then V := 0 else if V > 100 then V := 100;
if V <> FVolume then
begin
FVolume := V;
if FMuted then FMuted := False;
RequestInvalidate;
if Assigned(FOnVolume) then FOnVolume(FVolume);
end;
end;
{ ---- Внешний ввод (маршрутизируется MainForm поверх спектра) ---- }
function TVfoOverlay.HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
begin
Result := False;
if not Visible then Exit;
if (X < Left) or (Y < Top) or (X >= Left + Width) or (Y >= Top + Height) then Exit;
MouseDown(Button, [], X - Left, Y - Top);
Result := True;
end;
function TVfoOverlay.HandleMouseMove(X, Y: Integer): Boolean;
var
I, OldHot, LX, LY: Integer;
begin
Result := False;
if not Visible then Exit;
LX := X - Left; LY := Y - Top;
if FVolDrag then
begin
ApplyVolFromX(LX);
Result := True;
Exit;
end;
OldHot := FHotIdx;
FHotIdx := -1;
if (LX >= 0) and (LY >= 0) and (LX < Width) and (LY < Height) then
for I := 0 to FHitCount - 1 do
if PtInRect(FHitRects[I], Point(LX, LY)) then
begin FHotIdx := I; Break; end;
if FHotIdx <> OldHot then
begin
RequestInvalidate;
Result := True;
end;
end;
function TVfoOverlay.HandleMouseUp(X, Y: Integer): Boolean;
begin
Result := False;
if not Visible then Exit;
if FVolDrag then begin FVolDrag := False; Result := True; Exit; end;
if (X >= Left) and (Y >= Top) and (X < Left + Width) and (Y < Top + Height) then
Result := True; // клик был по накладке — не пускаем его в спектр
end;
function TVfoOverlay.HandleMouseLeave: Boolean;
begin
Result := False;
FVolDrag := False;
if FHotIdx >= 0 then
begin
FHotIdx := -1;
RequestInvalidate;
Result := True;
end;
end;
procedure TVfoOverlay.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
I, HV: Integer;
begin
inherited;
if Button <> mbLeft then Exit;
for I := 0 to FHitCount - 1 do
if PtInRect(FHitRects[I], Point(X, Y)) then
begin
HV := FHitActions[I];
if HV = HIT_VOL then
begin
FVolDrag := True;
ApplyVolFromX(X);
end
else
DoHit(HV);
Break;
end;
end;
procedure TVfoOverlay.MouseMove(Shift: TShiftState; X, Y: Integer);
var
I, OldHot: Integer;
begin
inherited;
OldHot := FHotIdx; FHotIdx := -1;
for I := 0 to FHitCount - 1 do
if PtInRect(FHitRects[I], Point(X, Y)) then
begin FHotIdx := I; Break; end;
if FHotIdx <> OldHot then RequestInvalidate;
end;
procedure TVfoOverlay.MouseLeave;
begin
inherited;
if FHotIdx >= 0 then begin FHotIdx := -1; RequestInvalidate; end;
end;
{ ---- Обновление состояния из контроллера ---- }
procedure TVfoOverlay.SetState(AMode, ABW: Integer; AVfoHz, ASMeterDB: Double);
begin
FMode := Max(0, Min(OVL_MODE_COUNT - 1, AMode));
FFilterBW := ABW;
FModeFilter[FMode] := ABW;
FVfoHz := AVfoHz;
FSMeterDB := ASMeterDB;
Height := ComputeHeight;
RequestInvalidate;
end;
procedure TVfoOverlay.SetDSPState(ANRMode, ANBMode: Integer; ASNBOn, AANFOn: Boolean;
AAGCMode: Integer);
begin
FNRMode := ANRMode;
FNBMode := ANBMode;
FSNBOn := ASNBOn;
FANFOn := AANFOn;
FAGCMode := AAGCMode;
RequestInvalidate;
end;
procedure TVfoOverlay.SetExtState(AVolume: Integer; AMuted, ASplit, ATx: Boolean);
begin
if (AVolume = FVolume) and (AMuted = FMuted) and (ASplit = FSplit)
and (ATx = FTx) then Exit;
if not FVolDrag then FVolume := AVolume; // во время drag ведём сами
FMuted := AMuted;
FSplit := ASplit;
FTx := ATx;
RequestInvalidate;
end;
procedure TVfoOverlay.SetAudioDevices(Names: TStrings; const Indices: array of Integer;
const CurName: string);
var
I: Integer;
begin
FDevNames.Assign(Names);
SetLength(FDevIdx, FDevNames.Count);
for I := 0 to FDevNames.Count - 1 do
if I <= High(Indices) then FDevIdx[I] := Indices[I] else FDevIdx[I] := -1;
FCurDev := CurName;
if FPanel = fpAud then Height := ComputeHeight;
RequestInvalidate;
end;
procedure TVfoOverlay.UpdateSMeter(DB: Double);
begin
if Abs(DB - FSMeterDB) > 0.4 then
begin
FSMeterDB := DB;
RequestInvalidate;
end;
end;
procedure TVfoOverlay.UpdateVfo(AVfoHz: Double);
begin
if FVfoHz <> AVfoHz then
begin
FVfoHz := AVfoHz;
RequestInvalidate;
end;
end;
end.