diff --git a/MainForm.pas b/MainForm.pas index 35b3513..249e6b2 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -533,6 +533,7 @@ type procedure OnTXProfileRenameFromSettings(Idx: Integer; const AName: string); procedure OnTXProfileDeleteFromSettings(Idx: Integer); procedure OnTXProfileFactoryFromSettings(Sender: TObject); + procedure OnVfoOverlayTXProfile(Idx: Integer); procedure OnChannelStoreChanged(Sender: TObject); procedure OnChannelActiveChanged(Idx: Integer; const Name: string; Active: Boolean); procedure PbSpectrumMouseDown(Sender: TObject; Button: TMouseButton; @@ -5708,6 +5709,10 @@ begin FController.FNetwork.Device.BoardType, FPendingBoardType)); PushTXProfilesToSettings; end; + // Пилюли профиля на флагах: список общий, привязки могли съехать после + // удаления/сброса — обновляем на всех панах. + for i := 0 to MAX_PANS - 1 do + if FPans[i] <> nil then FPans[i].PushAllFlagTXProfiles; end; procedure TMainForm.PushTXProfilesToSettings; @@ -6098,6 +6103,16 @@ begin PushFlagStateAllPans(CurSliceId); end; +procedure TMainForm.OnVfoOverlayTXProfile(Idx: Integer); +// Пилюля TX-профиля во флаге: «этот источник передачи звучит вот так». +// Idx = -1 — привязки нет, передаёт активный профиль. +begin + // Привязка главного живёт в секции профилей (контроллер её уже сохранил), + // привязка слайса уедет в конфиг с общим персистом панов — как RxMuteOnTx. + FController.SetSliceTXProfile(CurSliceId, Idx); + PushFlagStateAllPans(CurSliceId); +end; + procedure TMainForm.RefreshTxIndicators; // Обновить TX-бейджи (TxSel/Tx) на всех флагах всех панов после смены // TX-слайса / состояния передачи. @@ -6198,6 +6213,7 @@ begin O.OnSplit := OnVfoOverlaySplit; O.OnTxSelect := OnVfoOverlayTxSelect; O.OnRxMuteTx := OnVfoOverlayRxMuteTx; + O.OnTXProfile := OnVfoOverlayTXProfile; O.OnSliceSelect := OnVfoOverlaySliceSelect; O.OnClose := OnVfoOverlayClose; O.OnInvalidate := OnVfoOverlayInvalidate; @@ -7160,6 +7176,7 @@ begin Cfg.Pans[i].Slices[n].FMSQLevel := FController.FSlices[s].FMSQLevel; Cfg.Pans[i].Slices[n].DevName := FController.FSlices[s].DevName; Cfg.Pans[i].Slices[n].InDevName := FController.FSlices[s].InDevName; + Cfg.Pans[i].Slices[n].TXProfile := FController.FSlices[s].TXProfile; Inc(n); end; end; @@ -7186,6 +7203,7 @@ begin FController.FAudioIn.FindDeviceByName(SC.InDevName), SC.InDevName); if SC.Muted then FController.SetSliceMute(Id, True); FController.SetSliceRxMuteOnTx(Id, SC.RxMuteOnTx); + FController.SetSliceTXProfile(Id, SC.TXProfile); // «этот слайс звучит вот так» if SC.FMSQOn then FController.SetSliceFMSquelch(Id, True, SC.FMSQLevel); P.CreateSliceFlag(Id); FActiveSliceId := Id; diff --git a/PanafallPanel.pas b/PanafallPanel.pas index f00d3e8..1580211 100644 --- a/PanafallPanel.pas +++ b/PanafallPanel.pas @@ -286,6 +286,8 @@ type procedure PushAllSliceFlagStates; // все флаги панели (после смены rate и т.п.) procedure PushMainFlagExtState; procedure PushMainFlagAudioDevices; + procedure PushFlagTXProfiles(O: TVfoOverlay; SliceId: Integer); + procedure PushAllFlagTXProfiles; procedure UpdateSliceDMRFlags; // Тик: S-метр/частота главного флага + позиции + троттленный S-метр слайсов. procedure TickFlags; @@ -1321,6 +1323,23 @@ begin end; end; +// Список TX-профилей (общий) + привязка ЭТОГО флага (SliceId 0 = главный). +procedure TPanafallPanel.PushFlagTXProfiles(O: TVfoOverlay; SliceId: Integer); +var + L: TStringList; + i: Integer; +begin + if (O = nil) or (FController = nil) then Exit; + L := TStringList.Create; + try + for i := 0 to FController.TXProfileCount - 1 do + L.Add(FController.TXProfileName(i)); + O.SetTXProfiles(L, FController.SliceTXProfile(SliceId)); + finally + L.Free; + end; +end; + // Заливает во флаг слайса его текущее состояние из контроллера. procedure TPanafallPanel.PushSliceFlagState(SliceId: Integer); var @@ -1352,6 +1371,7 @@ begin // Auto TX (настройка CAT-порта слайса) — бейдж TX подписан AutoTX. O.SetAutoTxState(FController.SliceAutoTx(SliceId)); O.SetRxMuteTxState(S.RxMuteOnTx); // бейдж RXM + PushFlagTXProfiles(O, SliceId); // пилюля TX-профиля слайса // Список аудио-устройств (общий PA-список) + текущее устройство слайса. if Assigned(FController.FAudioOut) then begin @@ -1399,6 +1419,18 @@ begin FController.FSplitTxB and (FController.FTxSliceId = 0), FController.FTransmitting and (FController.FTxSliceId = 0), FController.FTxSliceId = 0); + PushFlagTXProfiles(FMainFlag, 0); +end; + +// Обновить пилюли TX-профиля на всех флагах панели (список профилей общий: +// переименовали/удалили — видно везде). +procedure TPanafallPanel.PushAllFlagTXProfiles; +var i: Integer; +begin + if Assigned(FMainFlag) then PushFlagTXProfiles(FMainFlag, 0); + for i := 0 to High(FSliceFlags) do + if FSliceFlags[i] <> nil then + PushFlagTXProfiles(FSliceFlags[i], FSliceFlags[i].SliceId); end; procedure TPanafallPanel.PushMainFlagAudioDevices; diff --git a/RadioController.pas b/RadioController.pas index 17126a9..abc3a59 100644 --- a/RadioController.pas +++ b/RadioController.pas @@ -178,6 +178,9 @@ type InDeviceIndex: Integer; // PortAudio-индекс ввода (-1 = общий) InDevName: string; AudioIn: TAudioInput; // НЕ владеет: ссылка на поток из mic-пула + // TX-профиль слайса: индекс в FTXProfiles или -1 = «не переключать». + // Применяется, когда слайс становится TX-источником (SetTxSlice). + TXProfile: Integer; DMR: TDMRSliceDecoder; // владеет; nil для не-DMR слайса end; @@ -596,6 +599,11 @@ type procedure RenameTXProfile(Idx: Integer; const AName: string); procedure DeleteTXProfile(Idx: Integer); procedure ResetTXProfilesToFactory; // заводской набор заново + // Профиль на TX-источник: -1 = не переключать (звучит активный). + function SliceTXProfile(SliceId: Integer): Integer; + procedure SetSliceTXProfile(SliceId, ProfIdx: Integer); + procedure RemapTXProfileBindings(Deleted: Integer); // после удаления/замены списка + procedure ApplyBoundTXProfile; // профиль текущего TX-источника → в эфир procedure SaveTXProfilesToConfig; // ---- Управление диапазонами (состояние + DSP; рендер через события) ---- @@ -2148,6 +2156,7 @@ begin FSlices[slot].RxMuteOnTx := True; // себя на передаче по умолчанию не слышим FSlices[slot].FMSQOn := False; // squelch по умолчанию выключен FSlices[slot].FMSQLevel := 40; + FSlices[slot].TXProfile := -1; // звучит тот профиль, что активен FSlices[slot].NRMode := 0; // DSP слайса стартует выключенным FSlices[slot].NBMode := 0; FSlices[slot].SNB := False; @@ -2940,6 +2949,9 @@ begin else if FTransmitting then SetMOX(False); end; FTxSliceId := SliceId; + // Профиль, привязанный к новому источнику, — ДО пуша режима и цепи: иначе + // ApplyTXSettingsToDSP внутри SelectTXProfile лёг бы на старый режим. + ApplyBoundTXProfile; // Передающий тракт под режим нового источника (idle-канал, применится к PTT). if FWDSPReady and Assigned(FDSPEngine) then begin @@ -5033,6 +5045,9 @@ begin for i := Idx to FTXProfiles.Count - 2 do FTXProfiles.Items[i] := FTXProfiles.Items[i + 1]; Dec(FTXProfiles.Count); + // Привязки флагов — это ИНДЕКСЫ: после сдвига списка их надо переписать, + // иначе слайс молча начнёт включать соседний профиль. + RemapTXProfileBindings(Idx); if FTXProfiles.ActiveIdx > Idx then Dec(FTXProfiles.ActiveIdx) else if FTXProfiles.ActiveIdx = Idx then begin @@ -5047,6 +5062,74 @@ begin Changed(rfTXProfile); end; +procedure TRadioController.RemapTXProfileBindings(Deleted: Integer); +// Профиль удалён из середины списка: привязку на него снимаем, привязки на +// профили правее — сдвигаем. Deleted < 0 = список заменён целиком, снимаем все. + + procedure Fix(var B: Integer); + begin + if B < 0 then Exit; + if Deleted < 0 then B := -1 + else if B = Deleted then B := -1 + else if B > Deleted then Dec(B); + end; + +var i: Integer; +begin + Fix(FTXProfiles.MainBind); + for i := 0 to High(FSlices) do + if FSlices[i].Active then Fix(FSlices[i].TXProfile); +end; + +function TRadioController.SliceTXProfile(SliceId: Integer): Integer; +// Привязка «этот источник передачи → этот профиль». -1 = не переключать. +var idx: Integer; +begin + Result := -1; + if SliceId <= 0 then + Result := FTXProfiles.MainBind + else + begin + idx := FindSliceIndex(SliceId); + if idx >= 0 then Result := FSlices[idx].TXProfile; + end; + if (Result < 0) or (Result >= FTXProfiles.Count) then Result := -1; +end; + +procedure TRadioController.SetSliceTXProfile(SliceId, ProfIdx: Integer); +var idx: Integer; +begin + if (ProfIdx < -1) or (ProfIdx >= FTXProfiles.Count) then ProfIdx := -1; + if SliceId <= 0 then + begin + if FTXProfiles.MainBind = ProfIdx then Exit; + FTXProfiles.MainBind := ProfIdx; + SaveTXProfilesToConfig; + end + else + begin + idx := FindSliceIndex(SliceId); + if (idx < 0) or (FSlices[idx].TXProfile = ProfIdx) then Exit; + FSlices[idx].TXProfile := ProfIdx; + // Персист слайсов делает MainForm на общем сохранении панов — здесь только + // состояние. Привязку главного пишем сразу: она живёт в секции профилей. + end; + // Привязали источник, который передаёт прямо сейчас, — применяем немедленно, + // иначе профиль подхватился бы только при следующей смене TX-источника. + if SliceId = FTxSliceId then ApplyBoundTXProfile; + Changed(rfTXProfile); +end; + +procedure TRadioController.ApplyBoundTXProfile; +// Профиль текущего TX-источника → в эфир. Ничего не делает, если источник ни к +// чему не привязан (-1) или нужный профиль уже активен. +var P: Integer; +begin + P := SliceTXProfile(FTxSliceId); + if (P < 0) or (P = FTXProfiles.ActiveIdx) then Exit; + SelectTXProfile(P); +end; + procedure TRadioController.ResetTXProfilesToFactory; // Пересобирает заводской набор поверх текущего списка. База — ЖИВЫЕ настройки, // поэтому «Default» = микрофонный вход, полоса, динамика и мощность как сейчас, @@ -5055,6 +5138,7 @@ procedure TRadioController.ResetTXProfilesToFactory; // пересоздаётся. begin DefaultTXProfiles(FTXSettings, FDrivePercent, FTXProfiles); + RemapTXProfileBindings(-1); // список другой — старые привязки бессмысленны // ActiveIdx гасим перед Select: иначе StoreActiveTXProfile внутри него // впишет в свежий «Default» живой EQ и сброс тембра тут же отменится. FTXProfiles.ActiveIdx := -1; diff --git a/Settings.pas b/Settings.pas index 8a0bc18..c3064f5 100644 --- a/Settings.pas +++ b/Settings.pas @@ -177,6 +177,7 @@ type FMSQLevel: Integer; DevName: string; // имя PortAudio-устройства вывода ('' = default) InDevName: string; // имя устройства ВВОДА слайса ('' = общий вход) + TXProfile: Integer; // TX-профиль слайса: -1 = какой активен, тот и звучит end; TPanCfg = record @@ -349,6 +350,9 @@ type TTXProfileList = record Count: Integer; ActiveIdx: Integer; + // Привязка профиля к ГЛАВНОМУ приёмнику (слайс A). У слайсов B..G то же + // самое лежит в TSliceCfg.TXProfile; -1 = ничего не переключать. + MainBind: Integer; Items: array[0..TXPROF_MAX-1] of TTXProfile; end; @@ -1938,6 +1942,7 @@ begin FillChar(L, SizeOf(L), 0); L.Count := 0; L.ActiveIdx := 0; + L.MainBind := -1; // главный приёмник профиль не переключает // «Default» — текущее состояние устройства (микрофонный вход, полоса, // динамика, мощность), но с заводским EQ: после миграции старого конфига // звук в эфире не меняется, а сброс к заводским возвращает ровный тембр. @@ -1970,6 +1975,7 @@ begin FillChar(L, SizeOf(L), 0); L.Count := 0; L.ActiveIdx := 0; + L.MainBind := -1; Result := False; MacStr := MacToStr(MAC); if FRoot.Find(MacStr) = nil then Exit; @@ -2030,6 +2036,8 @@ begin if L.Count = 0 then Exit; // пустой список = как будто секции нет L.ActiveIdx := JI(Root, 'active', 0); if (L.ActiveIdx < 0) or (L.ActiveIdx >= L.Count) then L.ActiveIdx := 0; + L.MainBind := JI(Root, 'main_bind', -1); + if (L.MainBind < -1) or (L.MainBind >= L.Count) then L.MainBind := -1; Result := True; end; @@ -2042,6 +2050,7 @@ var begin Root := EnsureObj(GetDevObj(MacToStr(MAC)), 'tx_profiles'); JW(Root, 'active', EnsureRange(L.ActiveIdx, 0, Max(0, L.Count - 1))); + JW(Root, 'main_bind', EnsureRange(L.MainBind, -1, Max(-1, L.Count - 1))); // Список пересоздаётся целиком: удаление профиля не должно оставлять хвост. Idx := Root.IndexOfName('list'); if Idx >= 0 then Root.Delete(Idx); @@ -2732,6 +2741,7 @@ begin SliceObj.Add('fmsq_level', P.Pans[i].Slices[j].FMSQLevel); SliceObj.Add('dev_name', P.Pans[i].Slices[j].DevName); SliceObj.Add('in_dev_name', P.Pans[i].Slices[j].InDevName); + SliceObj.Add('tx_profile', P.Pans[i].Slices[j].TXProfile); end; end; end; @@ -2812,6 +2822,8 @@ begin P.Pans[id].Slices[n].FMSQLevel := JI(SliceObj, 'fmsq_level', 30); P.Pans[id].Slices[n].DevName := JS(SliceObj, 'dev_name', ''); P.Pans[id].Slices[n].InDevName := JS(SliceObj, 'in_dev_name', ''); + P.Pans[id].Slices[n].TXProfile := EnsureRange( + JI(SliceObj, 'tx_profile', -1), -1, TXPROF_MAX - 1); end; end; end; diff --git a/VfoOverlay.pas b/VfoOverlay.pas index 7c2dec5..b1f937d 100644 --- a/VfoOverlay.pas +++ b/VfoOverlay.pas @@ -57,7 +57,10 @@ type TVolumeEvent = procedure(Vol: Integer) of object; TAudioDeviceEvent = procedure(DevIndex: Integer; const DevName: string) of object; - TFlyPanel = (fpNone, fpMode, fpDsp, fpAud); + TFlyPanel = (fpNone, fpMode, fpDsp, fpAud, fpTxProf); + + // Выбран TX-профиль для этого флага: Idx = -1 («как активный») или индекс. + TTXProfilePickEvent = procedure(Idx: Integer) of object; TVfoOverlay = class(TCustomControl) private @@ -102,6 +105,13 @@ type FCurInDev: string; // текущий вход слайса ('' = общий вход) FAudInTab: Boolean; // AUD-панель показывает вход (IN), а не выход + // TX-профили: список имён (общий на все флаги) + привязка ЭТОГО флага. + // -1 = флаг ничего не переключает, передаёт активный профиль. + FProfNames: TStringList; + FProfBound: Integer; + FProfScroll: Integer; // прокрутка списка профилей + FProfListRect: TRect; // область списка профилей (зона колёсика) + FPanel: TFlyPanel; // открытая fly-out панель FAudScroll: Integer; // прокрутка списка аудио-устройств (верхний индекс) FAudListRect: TRect; // область списка AUD (лок. коорд.) — зона колёсика @@ -121,6 +131,7 @@ type FOnSplit: TNotifyEvent; FOnTxSelect: TNotifyEvent; FOnRxMuteTx: TNotifyEvent; + FOnTXProfile: TTXProfilePickEvent; FOnInvalidate: TNotifyEvent; FTheme: TAppTheme; // тема приложения (цвета кнопок и т.п.) @@ -156,6 +167,13 @@ type 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 DrawProfPanel(C: TCanvas; X, Y, RowW: Integer); + // Стрелки прокрутки справа от списка (общие для AUD и профилей). + procedure DrawScrollArrows(C: TCanvas; X, Y, RowW, RowWidth, PanelH: Integer; + CanUp, CanDn: Boolean; HitUp, HitDn: Integer); + function ProfRowCount: Integer; // «— как активный» + профили + function ProfRowName(I: Integer): string; + procedure ScrollProfToCurrent; // Строки активной вкладки AUD (OUT — устройства вывода, IN — ввода; // у IN первая строка псевдо: «общий вход» / «нет»). function AudRowCount: Integer; @@ -206,6 +224,8 @@ type procedure SetDSPState(ANRMode, ANBMode: Integer; ASNBOn, AANFOn: Boolean; AAGCMode: Integer); procedure SetSquelchState(AOn: Boolean; ALevel: Integer); + // Список TX-профилей (одинаков у всех флагов) + привязка этого флага. + procedure SetTXProfiles(ANames: TStrings; ABound: Integer); procedure SetExtState(AVolume: Integer; AMuted, ASplit, ATx, ATxSel: Boolean); procedure SetRxMuteTxState(AOn: Boolean); // бейдж RXM (self-monitor на TX) // Auto TX слайса (настройка CAT): бейдж TX превращается в AutoTX. @@ -257,6 +277,7 @@ type property OnSplit: TNotifyEvent read FOnSplit write FOnSplit; property OnTxSelect: TNotifyEvent read FOnTxSelect write FOnTxSelect; property OnRxMuteTx: TNotifyEvent read FOnRxMuteTx write FOnRxMuteTx; + property OnTXProfile: TTXProfilePickEvent read FOnTXProfile write FOnTXProfile; property OnSliceSelect: TNotifyEvent read FOnSliceSelect write FOnSliceSelect; property OnClose: TNotifyEvent read FOnClose write FOnClose; property OnInvalidate: TNotifyEvent read FOnInvalidate write FOnInvalidate; @@ -300,8 +321,12 @@ const HIT_SQL = -31; // тумблер FM-squelch (в DSP-панели) HIT_SQL_SLIDER = -32; // трек порога FM-squelch HIT_RXMUTE = -33; // бейдж RXM: приём слайса на своей передаче + HIT_TXPROF = -36; // пилюля TX-профиля в шапке (открыть список) + HIT_PROF_UP = -37; // прокрутка списка профилей + HIT_PROF_DN = -38; HIT_AGC_PICK_BASE = 100000; HIT_DEV_BASE = 200000; + HIT_PROF_BASE = 300000; // 300000 + строка списка (0 = «как активный») // Свои диапазоны, чтобы не пересекаться с тумблерами (-9..-33) и с базами выше. HIT_MODE_BASE = -1000; // -1000 .. -1000-(OVL_MODE_COUNT-1) HIT_FILT_BASE = 1000; // 1000 + индекс кнопки в ряду фильтров @@ -319,6 +344,9 @@ const IGAP = 2; AUD_ROW_H = 17; // высота строки устройства в AUD-панели AUD_MAX_VIS = 6; // максимум видимых устройств (дальше — прокрутка) + PROF_MAX_VIS = 6; // столько же строк у списка TX-профилей + PROF_PILL_W = 92; // ширина пилюли профиля в шапке + PROF_PILL_MIN = 44; // уже этого не рисуем — шапка занята бейджами OVL_BASE_H = PAD + HDR_H + MET_H + FRQ_H + BAR_H + PAD; // = 96 // Палитра. Структурные цвета (фон/текст/акценты) берутся из темы — @@ -519,6 +547,10 @@ begin FInDevNames := TStringList.Create; FCurInDev := ''; FAudInTab := False; // AUD открывается на вкладке OUT + FProfNames := TStringList.Create; + FProfBound := -1; // флаг не переключает профиль + FProfScroll := 0; + FProfListRect := Rect(0, 0, 0, 0); FCacheBitmap := TBitmap.Create; FCacheBitmap.PixelFormat := pf32bit; FCacheDirty := True; @@ -558,6 +590,7 @@ end; destructor TVfoOverlay.Destroy; begin + FProfNames.Free; FInDevNames.Free; FDevNames.Free; FCacheBitmap.Free; @@ -660,6 +693,7 @@ begin // ряд вкладок OUT/IN + список устройств активной вкладки fpAud: Result := ROW_H + IGAP + Min(Max(1, AudRowCount), AUD_MAX_VIS) * AUD_ROW_H; + fpTxProf: Result := Min(ProfRowCount, PROF_MAX_VIS) * AUD_ROW_H; else Result := 0; end; end; @@ -674,6 +708,7 @@ procedure TVfoOverlay.SetPanel(P: TFlyPanel); begin if FPanel = P then FPanel := fpNone else FPanel := P; if FPanel = fpAud then ScrollAudToCurrent; // сразу показать выбранное + if FPanel = fpTxProf then ScrollProfToCurrent; Height := ComputeHeight; RequestInvalidate; end; @@ -996,15 +1031,143 @@ begin end; end; +function TVfoOverlay.ProfRowCount: Integer; +// Строка 0 — псевдо «— как активный», дальше сами профили. +begin + Result := FProfNames.Count + 1; +end; + +function TVfoOverlay.ProfRowName(I: Integer): string; +begin + if I <= 0 then Result := 'As active' + else if I - 1 < FProfNames.Count then Result := FProfNames[I - 1] + else Result := ''; +end; + +procedure TVfoOverlay.ScrollProfToCurrent; +var Cnt, Cur: Integer; +begin + FProfScroll := 0; + Cnt := ProfRowCount; + if Cnt <= PROF_MAX_VIS then Exit; + Cur := FProfBound + 1; // -1 → строка 0 + FProfScroll := Min(Max(0, Cur - PROF_MAX_VIS div 2), Cnt - PROF_MAX_VIS); +end; + +procedure TVfoOverlay.SetTXProfiles(ANames: TStrings; ABound: Integer); +var Same: Boolean; +begin + Same := (ABound = FProfBound) and (ANames <> nil) and + (ANames.Count = FProfNames.Count) and (ANames.Text = FProfNames.Text); + if Same then Exit; + if ANames <> nil then FProfNames.Assign(ANames) else FProfNames.Clear; + if (ABound < -1) or (ABound >= FProfNames.Count) then ABound := -1; + FProfBound := ABound; + if FPanel = fpTxProf then + begin + ScrollProfToCurrent; + Height := ComputeHeight; // список мог стать длиннее/короче + end; + RequestInvalidate; +end; + +procedure TVfoOverlay.DrawProfPanel(C: TCanvas; X, Y, RowW: Integer); +const + ARROW_W = 15; +var + I, Slot, VisN, RowWidth, MaxScroll, Cnt: Integer; + HR: TRect; + Nm, Full: string; + Cur, Scrollable: Boolean; +begin + C.Font.Name := 'Courier New'; + C.Font.Size := 7; + C.Font.Style := []; + Cnt := ProfRowCount; + VisN := Min(Cnt, PROF_MAX_VIS); + FProfListRect := Rect(X, Y, X + RowW, Y + VisN * AUD_ROW_H); + Scrollable := Cnt > PROF_MAX_VIS; + MaxScroll := Cnt - VisN; + if FProfScroll > MaxScroll then FProfScroll := MaxScroll; + if FProfScroll < 0 then FProfScroll := 0; + if Scrollable then RowWidth := RowW - ARROW_W - 2 else RowWidth := RowW; + + for Slot := 0 to VisN - 1 do + begin + I := FProfScroll + Slot; + HR := Rect(X, Y + Slot*AUD_ROW_H, X + RowWidth, Y + Slot*AUD_ROW_H + 16); + Full := ProfRowName(I); + Nm := Full; + Cur := (I - 1) = FProfBound; + if Cur then C.Brush.Color := CLR_ACCENT_D + else if (FHotIdx >= 0) and (FHitActions[FHotIdx] = HIT_PROF_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; + while (Length(Nm) > 1) and (C.TextWidth(Nm + '…') > RowWidth - 8) do + SetLength(Nm, Length(Nm) - 1); + if Nm <> Full then Nm := Nm + '…'; + C.TextOut(HR.Left + 4, HR.Top + (16 - C.TextHeight('A')) div 2, Nm); + RegisterHit(HR, HIT_PROF_BASE + I); + end; + + if not Scrollable then Exit; + DrawScrollArrows(C, X, Y, RowW, RowWidth, VisN * AUD_ROW_H - 1, + FProfScroll > 0, FProfScroll < MaxScroll, + HIT_PROF_UP, HIT_PROF_DN); +end; + +procedure TVfoOverlay.DrawScrollArrows(C: TCanvas; X, Y, RowW, RowWidth, + PanelH: Integer; CanUp, CanDn: Boolean; HitUp, HitDn: Integer); +// Полоса прокрутки справа от списка: ▲ / ▼. Общая для AUD и TX-профилей. +var + HR: TRect; + ArrowX, MidY, CY: Integer; + Tri: array[0..2] of TPoint; +begin + ArrowX := X + RowWidth + 2; + MidY := Y + PanelH div 2; + + 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, HitUp); + + 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, HitDn); +end; + procedure TVfoOverlay.DrawAudPanel(C: TCanvas; X, Y, RowW: Integer); const ARROW_W = 15; var - I, Slot, VisN, RowWidth, MaxScroll, PanelH, ArrowX, MidY, CY, Cnt: Integer; + I, Slot, VisN, RowWidth, MaxScroll, Cnt: Integer; HR, TabR: TRect; Nm: string; - Cur, Scrollable, CanUp, CanDn: Boolean; - Tri: array[0..2] of TPoint; + Cur, Scrollable: Boolean; begin // Ряд вкладок: OUT (куда отдаём звук) / IN (откуда берём модуляцию). TabR := Rect(X, Y, X + (RowW - 4) div 2, Y + ROW_H); @@ -1062,50 +1225,20 @@ begin 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); + DrawScrollArrows(C, X, Y, RowW, RowWidth, VisN * AUD_ROW_H - 1, + FAudScroll > 0, FAudScroll < MaxScroll, + HIT_AUD_UP, HIT_AUD_DN); end; { ---- Основная отрисовка ---- } procedure TVfoOverlay.DrawSelf(C: TCanvas; W, H: Integer); var - FreqStr, SStr, BWStr, DMRStr, TxStr: string; + FreqStr, SStr, BWStr, DMRStr, TxStr, PStr: string; CurY, X, RW, i, DMRX, DMRRight, TxRight, TxW: Integer; + ProfLeft, ProfRight, ProfW: Integer; R: TRect; + Tri3: array[0..2] of TPoint; BarL, BarW, MeterX: Integer; begin FHitCount := 0; @@ -1154,6 +1287,7 @@ begin 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); + ProfLeft := X + 22 + C.TextWidth(BWStr) + 8; // Краткий статус дополнительного DMR-слайса. Он обновляется только при // устойчивом изменении sync/slot/CC/TG, поэтому не заставляет GL-текстуру // перезаливаться на каждом burst. @@ -1186,6 +1320,45 @@ begin else DrawBadge(C, R, 'SPLIT', CLR_BTN_NORM, CLR_DIM); RegisterHit(R, HIT_SPLIT); end; + // Пилюля TX-профиля этого флага — сразу за шириной фильтра. Правая граница: + // до SPLIT (главный) либо до RXM (слайс). У DMR передачи нет вовсе, у FMRAW + // профиль ни на что не влияет (ApplyTXModeSettings глушит всю обработку — + // компрессор, leveler, ALC, phase rot, EQ, mic gain), у пустого списка + // выбирать нечего — не рисуем. Тесная шапка (узкий флаг) — тоже. + if FIsMain then ProfRight := W - PAD - 26 - 44 - 6 + else ProfRight := TxRight - TxW - 4 - 32 - 6; + if (FProfNames.Count > 0) and (FMode <> OVL_MODE_DMR) and + (FMode <> OVL_MODE_FMRAW) and + (ProfRight - ProfLeft >= PROF_PILL_MIN) then + begin + ProfW := Min(PROF_PILL_W, ProfRight - ProfLeft); + R := Rect(ProfLeft, CurY, ProfLeft + ProfW, CurY + HDR_BADGE_H); + if FProfBound >= 0 then C.Brush.Color := CLR_ACCENT_D + else if (FHotIdx >= 0) and (FHitActions[FHotIdx] = HIT_TXPROF) 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(R.Left, R.Top, R.Right, R.Bottom, 4, 4); + if FProfBound >= 0 then PStr := ProfRowName(FProfBound + 1) + else PStr := 'Profile'; // привязки нет — просто ярлык + C.Font.Size := 7; + if FProfBound >= 0 then C.Font.Color := CLR_ACCENT else C.Font.Color := CLR_DIM; + C.Brush.Style := bsClear; + while (Length(PStr) > 1) and (C.TextWidth(PStr) > ProfW - 14) do + SetLength(PStr, Length(PStr) - 1); + C.TextOut(R.Left + 4, R.Top + (HDR_BADGE_H - C.TextHeight('A')) div 2, PStr); + // Треугольник «список» справа — рисуем, а не пишем: в Courier New + // юникодных стрелок может не оказаться. + C.Brush.Color := C.Font.Color; C.Brush.Style := bsSolid; + C.Pen.Color := C.Font.Color; + Tri3[0] := Point(R.Right - 9, CurY + 5); + Tri3[1] := Point(R.Right - 3, CurY + 5); + Tri3[2] := Point(R.Right - 6, CurY + 9); + C.Polygon(Tri3); + C.Font.Size := 8; + RegisterHit(R, HIT_TXPROF); + end; Inc(CurY, HDR_H); { --- Метр: индикаторы + сигнал-бар --- } @@ -1259,6 +1432,7 @@ begin fpMode: DrawModePanel(C, PAD, CurY, W - PAD*2); fpDsp: DrawDspPanel(C, PAD, CurY, W - PAD*2); fpAud: DrawAudPanel(C, PAD, CurY, W - PAD*2); + fpTxProf: DrawProfPanel(C, PAD, CurY, W - PAD*2); end; end; end; @@ -1339,6 +1513,12 @@ begin end; HIT_RXMUTE: begin FRxMuteTx := not FRxMuteTx; RequestInvalidate; if Assigned(FOnRxMuteTx) then FOnRxMuteTx(Self); Exit; end; + HIT_TXPROF: begin SetPanel(fpTxProf); Exit; end; + HIT_PROF_UP: begin if FProfScroll > 0 then Dec(FProfScroll); + RequestInvalidate; Exit; end; + HIT_PROF_DN: begin if FProfScroll < ProfRowCount - PROF_MAX_VIS then + Inc(FProfScroll); + RequestInvalidate; 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); @@ -1360,6 +1540,18 @@ begin end; end; + // Строка списка TX-профилей: 0 = «как активный» (-1), дальше индексы профилей. + if HV >= HIT_PROF_BASE then + begin + NewMode := HV - HIT_PROF_BASE - 1; // -1 = «как активный» + if (NewMode < -1) or (NewMode >= FProfNames.Count) then Exit; + FProfBound := NewMode; + FPanel := fpNone; Height := ComputeHeight; + RequestInvalidate; + if Assigned(FOnTXProfile) then FOnTXProfile(NewMode); + Exit; + end; + // Устройство аудио (строка активной вкладки OUT/IN) if HV >= HIT_DEV_BASE then begin @@ -1533,7 +1725,20 @@ var MaxScroll, Old: Integer; begin Result := False; - if (not Visible) or (FPanel <> fpAud) then Exit; + if not Visible then Exit; + if FPanel = fpTxProf then + begin + if not PtInRect(FProfListRect, Point(X - Left, Y - Top)) then Exit; + Result := True; + MaxScroll := ProfRowCount - PROF_MAX_VIS; + if MaxScroll <= 0 then Exit; + Old := FProfScroll; + if WheelDelta > 0 then Dec(FProfScroll) else Inc(FProfScroll); + FProfScroll := EnsureRange(FProfScroll, 0, MaxScroll); + if FProfScroll <> Old then RequestInvalidate; + Exit; + end; + if FPanel <> fpAud then Exit; if not PtInRect(FAudListRect, Point(X - Left, Y - Top)) then Exit; Result := True; // зона наша — колесо в спектр не пускаем MaxScroll := AudRowCount - AUD_MAX_VIS; @@ -1635,6 +1840,11 @@ begin FDMRCandidateText := ''; FDMRCandidateSince := 0; end; + // Ушли в режим, где профиль ни на что не влияет: пилюли уже нет, открытый + // список закрываем сами — иначе он висел бы без своей кнопки. + if (FPanel = fpTxProf) and + ((FMode = OVL_MODE_DMR) or (FMode = OVL_MODE_FMRAW)) then + FPanel := fpNone; Height := ComputeHeight; RequestInvalidate; end;