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; // ширина карточки // Индексы совпадают с MODE_* контроллера (WDSPEngine.pas). OVL_MODE_COUNT = 11; OVL_MODE_COLS = 4; OVL_MODE_ROWS = (OVL_MODE_COUNT + OVL_MODE_COLS - 1) div OVL_MODE_COLS; OVL_MODE_NAMES: array[0..OVL_MODE_COUNT-1] of string = ( 'LSB','USB','DSB','CWL','CWU','FM','AM','SAM','DIGU','DIGL','WFM'); // Палитра слайсов (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; TSquelchEvent = procedure(SQLOn: Boolean; SQLLevel: Integer) 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..OVL_MODE_COUNT-1] 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 FSQLOn: Boolean; // FM-шумоподавитель (squelch) включён FSQLLevel: Integer; // порог squelch 0..100 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; FSqlTrack: TRect; // трек squelch в DSP-панели (лок. координаты) FSqlDrag: Boolean; FOnSelect: TModeFilterEvent; FOnDSPChange: TDSPChangeEvent; FOnSquelchChange: TSquelchEvent; 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 ApplySqlFromX(LX: Integer); function IsFM: Boolean; 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 SetSquelchState(AOn: Boolean; ALevel: 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; // Слайс сейчас передаёт (полоса фильтра на спектре краснеет, как у главного). property TxActive: Boolean read FTx; // Битмап-кэш требует перерисовки (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 OnSquelchChange: TSquelchEvent read FOnSquelchChange write FOnSquelchChange; 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); // Значения хит-тестов // режимы: HIT_MODE_BASE-I // фильтры: HIT_FILT_BASE+I (индекс, не BW: полосы WFM доходят до 200000 // и налезали бы на HIT_AGC_PICK_BASE/HIT_DEV_BASE) // 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_SQL = -31; // тумблер FM-squelch (в DSP-панели) HIT_SQL_SLIDER = -32; // трек порога FM-squelch HIT_AGC_PICK_BASE = 100000; HIT_DEV_BASE = 200000; // Свои диапазоны, чтобы не пересекаться с тумблерами (-9..-32) и с базами выше. HIT_MODE_BASE = -1000; // -1000 .. -1000-(OVL_MODE_COUNT-1) HIT_FILT_BASE = 1000; // 1000 + индекс кнопки в ряду фильтров 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); // тёмный текст поверх ярких бейджей 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'); WFM_BW: array[0..2] of Integer = (200000, 160000, 120000); WFM_LBL: array[0..2] of string = ('200K', '160K', '120K'); DIGI_BW: array[0..5] of Integer = (300, 600, 1200, 1800, 2400, 3000); DIGI_LBL: array[0..5] of string = ('300','600','1.2K','1.8K','2.4K','3.0K'); 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]; 8,9: Result := DIGI_BW[FilterIdx]; // DIGU/DIGL — полоса от нуля 10: Result := WFM_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]; 8,9: Result := DIGI_LBL[FilterIdx]; 10: Result := WFM_LBL[FilterIdx]; else Result := AM_LBL[FilterIdx]; end; end; function TVfoOverlay.GetFilterCountForMode(ModeIdx: Integer): Integer; begin case ModeIdx of 5: Result := 2; // FM: NFM/FM 10: Result := 3; // WFM: 200K/160K/120K else Result := 6; end; 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; FModeFilter[8] := 3000; FModeFilter[9] := 3000; FModeFilter[10] := 160000; FNRMode := 0; FNBMode := 0; FSNBOn := False; FANFOn := False; FAGCMode := 0; FSQLOn := False; FSQLLevel := 40; FSqlDrag := False; 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.IsFM: Boolean; begin Result := FMode = 5; // индекс FM в OVL_MODE_NAMES (= MODE_FM контроллера) end; function TVfoOverlay.PanelContentH: Integer; begin case FPanel of fpMode: Result := OVL_MODE_ROWS*(ROW_H + IGAP) + ROW_H; // ряды режимов + ряд фильтров fpDsp: begin Result := ROW_H + IGAP + ROW_H; // toggles + AGC if IsFM then Inc(Result, IGAP + ROW_H); // + ряд SQL (только FM) end; 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 - (OVL_MODE_COLS - 1)*3) div OVL_MODE_COLS; // зазор 3 for I := 0 to OVL_MODE_COUNT - 1 do begin Col := I mod OVL_MODE_COLS; Row := I div OVL_MODE_COLS; 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] = HIT_MODE_BASE - I), 7); RegisterHit(HR, HIT_MODE_BASE - I); end; // Ряд фильтров текущего режима FiltN := GetFilterCountForMode(FMode); BY := Y + OVL_MODE_ROWS*(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] = HIT_FILT_BASE + I), 7); RegisterHit(HR, HIT_FILT_BASE + I); 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; // Ряд 3 (только FM): тумблер SQL + ползунок порога squelch if IsFM then begin Inc(Y, ROW_H + IGAP); // кнопка SQL слева (1/4 ширины) BRight := X + RowW div 4; HR := Rect(X, Y, BRight - 2, Y + ROW_H); DrawButton(C, HR, 'SQL', FSQLOn, (FHotIdx >= 0) and (FHitActions[FHotIdx] = HIT_SQL), 7); RegisterHit(HR, HIT_SQL); // ползунок порога справа BX := BRight + 4; FSqlTrack := Rect(BX, Y + ROW_H div 2 - 3, X + RowW, Y + ROW_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(FSqlTrack.Left, FSqlTrack.Top, FSqlTrack.Right, FSqlTrack.Bottom, 3, 3); BX := FSqlTrack.Left + Round(FSQLLevel/100.0 * (FSqlTrack.Right - FSqlTrack.Left)); if FSQLOn then begin C.Brush.Color := CLR_ACCENT; C.Pen.Color := CLR_ACCENT; C.RoundRect(FSqlTrack.Left, FSqlTrack.Top, BX, FSqlTrack.Bottom, 3, 3); end; C.Brush.Color := CLR_TEXT; C.Pen.Color := CLR_TEXT; C.Ellipse(BX-4, Y + ROW_H div 2 - 5, BX+4, Y + ROW_H div 2 + 5); RegisterHit(Rect(FSqlTrack.Left - 4, Y, FSqlTrack.Right + 4, Y + ROW_H), HIT_SQL_SLIDER); 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]; слайс [B] BW ... [×] [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); // бейдж = выбор слайса // Кнопка закрытия × — только у неглавных слайсов (главный приёмник не закрыть). // Место освободилось от SPLIT (его у слайсов нет) — ставим вплотную к TX. if not FIsMain then begin R := Rect(W - PAD - 26 - 6 - 14, CurY, W - PAD - 26 - 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) — кликабельно; только у главного: split = TX на VFO B, // у слайса своего B-VFO нет (кросс-частотный TX делается TX-бейджем слайса). if FIsMain then begin 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); end; 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_SQL: begin FSQLOn := not FSQLOn; RequestInvalidate; if Assigned(FOnSquelchChange) then FOnSquelchChange(FSQLOn, FSQLLevel); 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 <= HIT_MODE_BASE) and (HV > HIT_MODE_BASE - OVL_MODE_COUNT) then begin NewMode := HIT_MODE_BASE - HV; if NewMode <> FMode then begin FModeFilter[FMode] := FFilterBW; FMode := NewMode; FFilterBW := FModeFilter[FMode]; Height := ComputeHeight; // число фильтров могло смениться (FM=2, WFM=3) RequestInvalidate; if Assigned(FOnSelect) then FOnSelect(FMode, FFilterBW); end; Exit; end; // Фильтр текущего режима (по индексу кнопки, не по BW) if (HV >= HIT_FILT_BASE) and (HV < HIT_FILT_BASE + GetFilterCountForMode(FMode)) then begin NewBW := GetFilterBWForMode(FMode, HV - HIT_FILT_BASE); 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; procedure TVfoOverlay.ApplySqlFromX(LX: Integer); var V: Integer; begin if FSqlTrack.Right <= FSqlTrack.Left then Exit; V := Round((LX - FSqlTrack.Left) / (FSqlTrack.Right - FSqlTrack.Left) * 100); if V < 0 then V := 0 else if V > 100 then V := 100; if V <> FSQLLevel then begin FSQLLevel := V; RequestInvalidate; if Assigned(FOnSquelchChange) then FOnSquelchChange(FSQLOn, FSQLLevel); 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; if FSqlDrag then begin ApplySqlFromX(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 FSqlDrag then begin FSqlDrag := 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; FSqlDrag := 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 if HV = HIT_SQL_SLIDER then begin FSqlDrag := True; ApplySqlFromX(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.SetSquelchState(AOn: Boolean; ALevel: Integer); begin if (FSQLOn = AOn) and ((FSQLLevel = ALevel) or FSqlDrag) then Exit; FSQLOn := AOn; if not FSqlDrag then FSQLLevel := ALevel; // во время drag ведём сами 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.