Files
ewsdr/VfoOverlay.pas
T
ew8bakandClaude Fable 5 0adaff2d21 perf(spectrum): full-raw CPU renderer + dword blenders (frame 8.3ms -> 1.7ms)
Canvas на битмапе кадра больше не используется вообще (кроме редкого
ADC-overload пути с восстановлением альфы) — убраны все raw<->canvas
переходы, каждый из которых синкал весь битмап на Qt6 (~2мс):

- RawBegin/RawEnd: прямой доступ к пикселям через RawImage.Data +
  BytesPerLine (bottom-up DIB win32 учтён отрицательным шагом)
- RawVLine/RawHLine (с пунктиром), RawFillRect, RawTriangleDown,
  RawCurve (кривая = связные вертикальные сегменты по колонкам)
- кэш текстовых масок (TRawTextMask, LRU 48): строка рендерится canvas'ом
  один раз белым-на-чёрном в свой мини-битмап, блитится raw с цветом;
  все тексты кадра теперь Courier New
- конвертированы: маркер (метка без случайной цветной плашки), бикон-
  маркеры, буквы слайсов, слайс-линии, AGC (пунктир 4/2 и 1/2, подпись
  с фоном SpecFilter как раньше), края/VFO/TX-курсоры с треугольниками
- пофреймовый альфа-OR проход удалён: альфа чинится один раз в кэше
  СЕТКИ после ребилда (canvas-текст там), кадр наследует её через memcpy

Дворд-блендеры (два 16-бит лейна на умножение, /256 вместо /255,
расхождение <0.4%) вместо побайтовых с div 255:
- BandPlanOverlay.CompositeStrip (~1мс -> ~0.2мс)
- SampleRateOverlay.CompositeCache (per-px альфа)
- VfoOverlay.BlendBitmapKey (keyed-магента дворд-сравнением)
- SpectrumView.DrawSpectrumGradient (source-лейны 1 раз на строку,
  ~1.6мс -> ~0.8мс)

Порог перестройки бэндплана: полпикселя вместо 1 Гц (на QO-100 с
decoder-lock центр подтюнивается непрерывно — был canvas-ребилд полоски
каждый кадр). Композиты внутри raw-лока (их BeginUpdate вложенные).
PerfLog: зона ui.composites отделена от ui.spec_alpha (=RawEnd).

Замер на эфире (Pluto, 576k, 52fps): кадр 8.3мс -> 1.67мс (5x),
со слайсом 2.1-2.3мс; UI-поток ~45% -> ~26% ядра, из них 15% — блиты
paint_spectrum/paint_waterfall (потолок Qt6-вывода). Визуально проверено.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
2026-07-03 00:11:31 +03:00

1355 lines
50 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, FlatButton, AppTheme;
const
VFO_OVERLAY_ALPHA = 210;
OVL_W = 280; // ширина карточки
// Палитра слайсов (TColor = $00BBGGRR): одна на букву — общий цвет для
// бейджа-карточки во флаге и для буквы на полосе фильтра в спектре.
SLICE_COLORS: array[0..7] of TColor = (
TColor($0060E040), // A — зелёный
TColor($0010A8FF), // B — оранжевый
TColor($00F0D030), // C — голубой
TColor($00E070F0), // D — розовый/маджента
TColor($0030E0F0), // E — жёлтый
TColor($00F050B0), // F — фиолетовый (не красный — чтобы не путать с TX)
TColor($00E0C060), // G — бирюзовый
TColor($00C0C0C0)); // H — серый
// Цвет слайса по его букве (A..). За пределами таблицы — по кругу.
function SliceColor(L: Char): TColor;
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; // передача идёт (красный)
FTxSel: Boolean; // этот слайс выбран для передачи (янтарный)
FSlice: Char; // буква слайса ('A')
FSMeterThreshold: Double; // мин. изменение S-метра (дБ) для перерисовки
FDevNames: TStringList; // имена устройств вывода
FDevIdx: array of Integer; // соответствующие PortAudio-индексы (-1=default)
FCurDev: string; // имя текущего устройства ('' = default)
FPanel: TFlyPanel; // открытая fly-out панель
FAudScroll: Integer; // прокрутка списка аудио-устройств (верхний индекс)
FVolTrack: TRect; // трек громкости (локальные координаты)
FVolDrag: Boolean;
FOnSelect: TModeFilterEvent;
FOnDSPChange: TDSPChangeEvent;
FOnAGCChange: TAGCChangeEvent;
FOnVolume: TVolumeEvent;
FOnMute: TNotifyEvent;
FOnAudioDevice: TAudioDeviceEvent;
FOnSplit: TNotifyEvent;
FOnTxSelect: TNotifyEvent;
FOnInvalidate: TNotifyEvent;
FTheme: TAppTheme; // тема приложения (цвета кнопок и т.п.)
// Структурные цвета карточки, выведенные из FTheme (ApplyThemeColors).
CLR_CARD_BG, CLR_BORDER, CLR_SEP, CLR_TEXT, CLR_DIM,
CLR_ACCENT, CLR_ACCENT_D, CLR_BTN_NORM, CLR_BTN_HOT,
CLR_FREQ, CLR_SVAL, CLR_BAR_BG: TColor;
FSliceId: Integer; // логический id слайса (владелец — MainForm/контроллер)
FIsMain: Boolean; // главный приёмник (слайс A) — без кнопки закрытия
FOnSliceSelect: TNotifyEvent; // клик по бейджу буквы — сделать слайс активным
FOnClose: TNotifyEvent; // клик по × (только неглавные) — удалить слайс
FHitRects: array[0..63] of TRect;
FHitActions: array[0..63] of Integer;
FHitCount: Integer;
FHotIdx: Integer;
FCacheBitmap: TBitmap;
FCacheDirty: Boolean;
FMeterDirty: Boolean; // изменился только S-метр — перерисовать полоску, не весь флаг
FMeterRect: TRect; // прямоугольник сигнал-бара (запоминается при полном рендере)
FSRowTop: Integer; // верх строки частоты (для S-метки справа)
FLastSTextRect: TRect; // последний прямоугольник S-метки (для аккуратной очистки)
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);
procedure ApplyThemeColors; // раскладывает FTheme → структурные CLR_*
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 RequestMeterInvalidate;
procedure RefreshMeter(C: TCanvas);
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);
// Готовит внутренний кэш-битмап (полный рендер по CacheDirty либо дешёвая
// перерисовка одной полоски метра по MeterDirty) и возвращает его. Один путь
// для CPU (BlendBitmapKey) и GL (UploadBitmap).
function EnsureRendered: 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, ATxSel: Boolean);
procedure SetAudioDevices(Names: TStrings; const Indices: array of Integer;
const CurName: string);
procedure UpdateSMeter(DB: Double);
procedure UpdateVfo(AVfoHz: Double);
// Тема приложения (цвета кнопок берутся отсюда — как левая панель).
procedure SetTheme(const T: TAppTheme);
// Привязка к слайсу: id, буква флага, признак главного (слайс A).
procedure SetSliceInfo(ASliceId: Integer; ALetter: Char; AIsMain: Boolean);
property SliceId: Integer read FSliceId;
property IsMain: Boolean read FIsMain;
property SliceLetter: Char read FSlice; // буква слайса (A/B/…) для меток на полосе фильтра
// Для маркера фильтра слайса на спектре (читает GL-вьюха).
property DisplayVfoHz: Double read FVfoHz;
property DisplayMode: Integer read FMode;
property DisplayBW: Integer read FFilterBW;
// Битмап-кэш требует перерисовки (GL-вьюха решает, перезаливать ли текстуру).
property CacheDirty: Boolean read FCacheDirty;
// Изменился только S-метр (перезалить текстуру, но рендер дешёвый — одна полоска).
property MeterDirty: Boolean read FMeterDirty;
// Порог изменения S-метра (дБ) для перерисовки: у слайсов выше (меньше рендеров).
property SMeterThreshold: Double read FSMeterThreshold write FSMeterThreshold;
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 OnTxSelect: TNotifyEvent read FOnTxSelect write FOnTxSelect;
property OnSliceSelect: TNotifyEvent read FOnSliceSelect write FOnSliceSelect;
property OnClose: TNotifyEvent read FOnClose write FOnClose;
property OnInvalidate: TNotifyEvent read FOnInvalidate write FOnInvalidate;
end;
implementation
function SliceColor(L: Char): TColor;
var idx: Integer;
begin
if (L >= 'A') and (L <= 'Z') then idx := Ord(L) - Ord('A') else idx := 0;
Result := SLICE_COLORS[idx mod (High(SLICE_COLORS) + 1)];
end;
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_TX = -26;
HIT_AUD_UP = -27;
HIT_AUD_DN = -28;
HIT_SLICE_SEL = -29; // клик по бейджу буквы (выбрать слайс активным)
HIT_CLOSE = -30; // × закрытия слайса (неглавные)
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;
HDR_BADGE_H = 12; // высота бейджей A/SPLIT/TX (верх на CurY, низ приподнят)
MET_H = 21;
FRQ_H = 26;
BAR_H = 24;
ROW_H = 20;
IGAP = 2;
AUD_ROW_H = 17; // высота строки устройства в AUD-панели
AUD_MAX_VIS = 6; // максимум видимых устройств (дальше — прокрутка)
OVL_BASE_H = PAD + HDR_H + MET_H + FRQ_H + BAR_H + PAD; // = 96
// Палитра. Структурные цвета (фон/текст/акценты) берутся из темы —
// см. поля CLR_* класса + ApplyThemeColors. Здесь — только статус-акценты,
// которые намеренно одинаковы в обеих темах (яркие бейджи-статусы), и
// тёмный текст поверх них.
CLR_TX_ON = TColor($000030E0); // красный TX идёт (BGR)
CLR_TX_SEL = TColor($0010A8F0); // янтарный: слайс выбран для передачи
CLR_SPLIT_ON = TColor($0020C0FF); // оранжевый SPLIT
CLR_BADGE_TXT = TColor($00181818); // тёмный текст поверх ярких бейджей
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);
// Дворд-блендинг (два 16-битных лейна на умножение, /256 вместо /255 —
// расхождение <0.4%): побайтовый вариант с div 255 на 2 флагах стоил ~0.6мс.
// Keyed-пиксели (магента) пропускаются сравнением цветовых байтов дворда.
var
Y, X, SX0, SY0, SX1, SY1, TY: Integer;
A256, I256, S, D: LongWord;
SrcRow, DstRow: PLongWord;
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;
A256 := Alpha + (Alpha shr 7); // 0..256
I256 := 256 - A256;
Target.BeginUpdate(False);
Source.BeginUpdate(False);
try
for Y := SY0 to SY1 - 1 do
begin
TY := DstY + (Y - SY0);
SrcRow := PLongWord(Source.ScanLine[Y]);
DstRow := PLongWord(Target.ScanLine[TY]);
if (SrcRow = nil) or (DstRow = nil) then Continue;
Inc(SrcRow, SX0);
Inc(DstRow, DstX);
for X := SX0 to SX1 - 1 do
begin
S := SrcRow^;
{$IFDEF DARWIN}
if (S and $FFFFFF00) <> $FF00FF00 then // ARGB: R=FF,G=00,B=FF
{$ELSE}
if (S and $00FFFFFF) <> $00FF00FF then // BGRA: B=FF,G=00,R=FF
{$ENDIF}
begin
D := DstRow^;
DstRow^ := ((((S and $00FF00FF) * A256 + (D and $00FF00FF) * I256)
shr 8) and $00FF00FF)
or ((((S shr 8) and $00FF00FF) * A256 +
((D shr 8) and $00FF00FF) * I256) and $FF00FF00)
{$IFDEF DARWIN}
or $000000FF;
{$ELSE}
or $FF000000;
{$ENDIF}
end;
Inc(SrcRow);
Inc(DstRow);
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;
FTxSel := True; FSlice := 'A';
FSliceId := 0; FIsMain := True; // по умолчанию — главный приёмник (слайс A)
FSMeterThreshold := 0.4; // главный флаг — чувствительный метр
FPanel := fpNone;
FAudScroll := 0;
FVolDrag := False;
FDevNames := TStringList.Create;
FCurDev := '';
FCacheBitmap := TBitmap.Create;
FCacheBitmap.PixelFormat := pf32bit;
FCacheDirty := True;
FMeterDirty := False;
FLastSTextRect := Rect(0, 0, 0, 0);
FTheme := DarkTheme; // по умолчанию тёмная; MainForm выставит актуальную
ApplyThemeColors;
Width := OVL_W;
Height := OVL_BASE_H;
Cursor := crHandPoint;
end;
// Раскладывает тему в структурные цвета карточки. Статус-акценты (TX/SPLIT)
// намеренно НЕ тематизируются — они одинаковы в обеих темах.
procedure TVfoOverlay.ApplyThemeColors;
begin
CLR_CARD_BG := FTheme.Panel;
CLR_BORDER := FTheme.Border;
CLR_SEP := FTheme.Border;
CLR_TEXT := FTheme.Text;
CLR_DIM := FTheme.TextDim;
CLR_ACCENT := FTheme.BtnTextActive; // зелёный акцент (яркий/тёмный по теме)
CLR_ACCENT_D := FTheme.BtnActive; // фон активной строки
CLR_BTN_NORM := FTheme.BtnNorm;
CLR_BTN_HOT := FTheme.BtnHot;
CLR_FREQ := FTheme.FreqActive;
CLR_SVAL := FTheme.Amber; // числовое значение S-метра
CLR_BAR_BG := FTheme.BG; // фон полоски S-метра
end;
procedure TVfoOverlay.SetTheme(const T: TAppTheme);
begin
FTheme := T;
ApplyThemeColors;
RequestInvalidate; // перерисовать хром флага с новыми цветами
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;
// Лёгкая инвалидация: изменился только S-метр. НЕ трогает FCacheDirty, поэтому
// хром флага (частота/режим/кнопки) не перерисовывается — перезаливается только
// полоска метра (RefreshMeter в EnsureRendered).
procedure TVfoOverlay.RequestMeterInvalidate;
begin
FMeterDirty := True;
inherited Invalidate;
if Assigned(FOnInvalidate) then FOnInvalidate(Self);
end;
// Дешёвая перерисовка одной полоски метра + S-метки поверх уже отрендеренного
// хрома. Обе зоны самодостаточны и целиком очищаются под фон карточки.
procedure TVfoOverlay.RefreshMeter(C: TCanvas);
var
SStr: string;
STextW: Integer;
ClearR, NewR: TRect;
begin
// Сигнал-бар — самодостаточный прямоугольник, перерисовывается целиком.
C.Brush.Color := CLR_CARD_BG;
C.Brush.Style := bsSolid;
C.Pen.Style := psClear;
C.FillRect(FMeterRect);
DrawMeterBar(C, FMeterRect.Left, FMeterRect.Top,
FMeterRect.Right - FMeterRect.Left, MET_H);
// S-метка в строке частоты (справа). Очищаем объединение старого и нового
// прямоугольника, чтобы не оставалось «хвостов» при сужении текста.
SStr := DBmToSLabel(FSMeterDB);
C.Font.Name := 'Courier New';
C.Font.Style := [fsBold];
C.Font.Size := 9;
STextW := C.TextWidth(SStr);
NewR := Rect(FMeterRect.Right - STextW - 3, FSRowTop + 4, FMeterRect.Right, FSRowTop + FRQ_H);
ClearR := NewR;
if FLastSTextRect.Left < ClearR.Left then ClearR.Left := FLastSTextRect.Left;
if FLastSTextRect.Top < ClearR.Top then ClearR.Top := FLastSTextRect.Top;
C.Brush.Color := CLR_CARD_BG;
C.Brush.Style := bsSolid;
C.Pen.Style := psClear;
C.FillRect(ClearR);
C.Font.Color := CLR_SVAL;
C.Brush.Style := bsClear;
C.TextOut(FMeterRect.Right - STextW - 2, FSRowTop + 6, SStr);
FLastSTextRect := NewR;
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 := Min(Max(1, FDevNames.Count), AUD_MAX_VIS) * AUD_ROW_H;
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;
if FPanel = fpAud then FAudScroll := 0; // список с начала
Height := ComputeHeight;
RequestInvalidate;
end;
{ ---- Примитивы отрисовки ---- }
procedure TVfoOverlay.DrawButton(C: TCanvas; const R: TRect; const Lbl: string;
Active, Hot: Boolean; FontSz: Integer);
var
Brd: TColor;
begin
// Цвета берём из темы (как StyleButton на левой панели): рамка — по состоянию.
if Active then Brd := FTheme.BtnBorderActive else Brd := FTheme.BtnBorderNorm;
C.Font.Name := 'Courier New';
C.Font.Size := FontSz;
C.Font.Style := [];
// Общая отрисовка (FlatButton) — вид как у кнопок по всей программе.
PaintFlatButton(C, R, Lbl, Active, Hot,
FTheme.BtnNorm, FTheme.BtnActive, FTheme.BtnHot, Brd,
FTheme.BtnText, FTheme.BtnTextActive);
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);
var
TS: TTextStyle;
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;
// Центровку доверяем виджетсету (TextRect со стилем) — ручной расчёт по
// TextWidth/Height на подменном шрифте уводил глиф влево-вверх.
FillChar(TS, SizeOf(TS), 0);
TS.Alignment := taCenter;
TS.Layout := tlCenter;
TS.SingleLine := True;
TS.Clipping := True;
C.TextRect(R, R.Left, R.Top, Lbl, TS);
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 - 12;
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 := 7;
C.Font.Style := [];
// Последнюю метку (+60 = правый край) не рисуем — вылезает за границу.
for I := 0 to High(S_POS) - 1 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+2, 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);
const
ARROW_W = 15;
var
I, Slot, VisN, RowWidth, MaxScroll, PanelH, ArrowX, MidY, CY: Integer;
HR: TRect;
Nm: string;
Cur, Scrollable, CanUp, CanDn: Boolean;
Tri: array[0..2] of TPoint;
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;
VisN := Min(FDevNames.Count, AUD_MAX_VIS);
Scrollable := FDevNames.Count > AUD_MAX_VIS;
MaxScroll := FDevNames.Count - VisN;
if FAudScroll > MaxScroll then FAudScroll := MaxScroll;
if FAudScroll < 0 then FAudScroll := 0;
if Scrollable then RowWidth := RowW - ARROW_W - 2 else RowWidth := RowW;
for Slot := 0 to VisN - 1 do
begin
I := FAudScroll + Slot;
HR := Rect(X, Y + Slot*AUD_ROW_H, X + RowWidth, Y + Slot*AUD_ROW_H + 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) > RowWidth - 8 then
while (Length(Nm) > 1) and (C.TextWidth(Nm + '…') > RowWidth - 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;
if not Scrollable then Exit;
// Полоса прокрутки справа: ▲ (верх) / ▼ (низ) + счётчик позиции.
PanelH := VisN * AUD_ROW_H - 1;
ArrowX := X + RowWidth + 2;
MidY := Y + PanelH div 2;
CanUp := FAudScroll > 0;
CanDn := FAudScroll < MaxScroll;
// верхняя стрелка
HR := Rect(ArrowX, Y, X + RowW, MidY - 1);
C.Brush.Color := CLR_BTN_NORM; C.Brush.Style := bsSolid;
C.Pen.Color := CLR_BTN_NORM; C.Pen.Style := psSolid;
C.RoundRect(HR.Left, HR.Top, HR.Right, HR.Bottom, 4, 4);
CY := (HR.Top + HR.Bottom) div 2;
if CanUp then C.Brush.Color := CLR_TEXT else C.Brush.Color := CLR_DIM;
C.Pen.Color := C.Brush.Color;
Tri[0] := Point((HR.Left+HR.Right) div 2, CY - 3);
Tri[1] := Point((HR.Left+HR.Right) div 2 - 4, CY + 2);
Tri[2] := Point((HR.Left+HR.Right) div 2 + 4, CY + 2);
C.Polygon(Tri);
RegisterHit(HR, HIT_AUD_UP);
// нижняя стрелка
HR := Rect(ArrowX, MidY + 1, X + RowW, Y + PanelH);
C.Brush.Color := CLR_BTN_NORM; C.Brush.Style := bsSolid;
C.Pen.Color := CLR_BTN_NORM; C.Pen.Style := psSolid;
C.RoundRect(HR.Left, HR.Top, HR.Right, HR.Bottom, 4, 4);
CY := (HR.Top + HR.Bottom) div 2;
if CanDn then C.Brush.Color := CLR_TEXT else C.Brush.Color := CLR_DIM;
C.Pen.Color := C.Brush.Color;
Tri[0] := Point((HR.Left+HR.Right) div 2, CY + 3);
Tri[1] := Point((HR.Left+HR.Right) div 2 - 4, CY - 2);
Tri[2] := Point((HR.Left+HR.Right) div 2 + 4, CY - 2);
C.Polygon(Tri);
RegisterHit(HR, HIT_AUD_DN);
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_BADGE_H), FSlice, SliceColor(FSlice), CLR_BADGE_TXT);
RegisterHit(Rect(X, CurY, X+16, CurY+HDR_BADGE_H), HIT_SLICE_SEL); // бейдж = выбор слайса
// Кнопка закрытия × — только у неглавных слайсов (главный приёмник не закрыть).
if not FIsMain then
begin
R := Rect(W - PAD - 26 - 44 - 6 - 14, CurY, W - PAD - 26 - 44 - 6, CurY + HDR_BADGE_H);
DrawBadge(C, R, #$C3#$97, CLR_BTN_NORM, CLR_DIM); // UTF-8 '×'
RegisterHit(R, HIT_CLOSE);
end;
// ширина фильтра
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 (правый край) — кликабельно: выбор TX-слайса.
// передача идёт → красный; слайс выбран для TX → янтарный; иначе → нейтральный.
R := Rect(W - PAD - 26, CurY, W - PAD, CurY + HDR_BADGE_H);
if FTx then DrawBadge(C, R, 'TX', CLR_TX_ON, clWhite)
else if FTxSel then DrawBadge(C, R, 'TX', CLR_TX_SEL, CLR_BADGE_TXT)
else DrawBadge(C, R, 'TX', CLR_BTN_NORM, CLR_DIM);
RegisterHit(R, HIT_TX);
// SPLIT (левее TX) — кликабельно
R := Rect(W - PAD - 26 - 44, CurY, W - PAD - 26 - 4, CurY + HDR_BADGE_H);
if FSplit then DrawBadge(C, R, 'SPLIT', CLR_SPLIT_ON, CLR_BADGE_TXT)
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;
FMeterRect := Rect(MeterX, CurY, W - PAD, CurY + MET_H); // для RefreshMeter
DrawMeterBar(C, MeterX, CurY, W - PAD - MeterX, MET_H);
Inc(CurY, MET_H);
{ --- Частота + S --- }
FSRowTop := CurY; // для RefreshMeter
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);
FLastSTextRect := Rect(W - PAD - C.TextWidth(SStr) - 3, CurY + 4, W - PAD, CurY + FRQ_H);
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;
function TVfoOverlay.EnsureRendered: TBitmap;
begin
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;
FMeterDirty := False;
end
else if FMeterDirty then
begin
RefreshMeter(FCacheBitmap.Canvas); // дешёвый апдейт: только полоска метра
FMeterDirty := False;
end;
Result := FCacheBitmap;
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;
EnsureRendered;
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;
FMeterDirty := 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;
HIT_TX: begin if Assigned(FOnTxSelect) then FOnTxSelect(Self); Exit; end;
HIT_SLICE_SEL: begin if Assigned(FOnSliceSelect) then FOnSliceSelect(Self); Exit; end;
HIT_CLOSE: begin if Assigned(FOnClose) then FOnClose(Self); Exit; end;
HIT_AUD_UP: begin if FAudScroll > 0 then Dec(FAudScroll);
RequestInvalidate; Exit; end;
HIT_AUD_DN: begin if FAudScroll < FDevNames.Count - AUD_MAX_VIS then
Inc(FAudScroll);
RequestInvalidate; 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, ATxSel: Boolean);
begin
if (AVolume = FVolume) and (AMuted = FMuted) and (ASplit = FSplit)
and (ATx = FTx) and (ATxSel = FTxSel) then Exit;
if not FVolDrag then FVolume := AVolume; // во время drag ведём сами
FMuted := AMuted;
FSplit := ASplit;
FTx := ATx;
FTxSel := ATxSel;
RequestInvalidate;
end;
procedure TVfoOverlay.SetSliceInfo(ASliceId: Integer; ALetter: Char; AIsMain: Boolean);
begin
if (FSliceId = ASliceId) and (FSlice = ALetter) and (FIsMain = AIsMain) then Exit;
FSliceId := ASliceId;
FSlice := ALetter;
FIsMain := AIsMain;
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) > FSMeterThreshold then
begin
FSMeterDB := DB;
RequestMeterInvalidate; // только полоска метра, без ре-рендера всего флага
end;
end;
procedure TVfoOverlay.UpdateVfo(AVfoHz: Double);
begin
if FVfoHz <> AVfoHz then
begin
FVfoHz := AVfoHz;
RequestInvalidate;
end;
end;
end.