unit FilterPopup; { TFilterPopup — поповер редактора фильтров приёмника, открывается ПКМ по любой кнопке фильтра на левой панели. Слева список слотов режима (10 пресетов + VAR1/VAR2), справа Name/Low/High/Width, внизу форма полосы в масштабе на ЗНАКОВОЙ оси частот. Знак и есть главный смысл нижней картинки: у LSB полоса лежит в минусе, и это видно глазами — ровно то место, где в проекте дважды заводились баги с боковой. Скат нарисован схематично: реальная крутизна у WDSP определяется длиной FIR (fircore) и никаким пользовательским параметром не управляется. Эталон содержимого — Thetis FilterForm.cs (12 слотов + Name/Low/High/Width); графика полосы — наша добавка, у них её нет. Реализован как ДОЧЕРНИЙ контрол верхнеуровневой формы (не отдельное окно) — как TPureSignalPopup/TPanDisplayPopup: Wayland не даёт клиенту позиционировать top-level окна. } {$IFDEF FPC} {$MODE Delphi} {$ENDIF} interface uses Classes, SysUtils, Math, Types, Controls, ExtCtrls, StdCtrls, Graphics, Forms, RadioController, RadioModes, Settings, FlatButton, FlatEdit, FlatSpinEdit, FlatListBox; type TFilterSlotEvent = procedure(Mode, Idx: Integer; const S: TFilterSlot) of object; TFilterResetEvent = procedure(Mode, Idx: Integer) of object; TFilterPopup = class(TCustomControl) private FController: TRadioController; // не владеем FMode: Integer; FSlotIdx: Integer; FSet: TFilterSet; FPresets: Integer; // пресетов у режима (VAR идут сверх) FLoading: Boolean; // подавляет Apply при программной заливке FBg: TPanel; FTitle: TLabel; FBtnClose: TFlatButton; FList: TFlatListBox; FEdName: TFlatEdit; FEdLow: TFlatSpinEdit; FEdHigh: TFlatSpinEdit; FEdWidth: TFlatSpinEdit; FBtnReset: TFlatButton; FBtnResetAll: TFlatButton; FShape: TPaintBox; FOnSlotEdited: TFilterSlotEvent; FOnSlotReset: TFilterResetEvent; function MakeLbl(const Cap: string; ALeft, ATop, AW: Integer): TLabel; procedure FillList; procedure ShowSlot; procedure Commit; procedure ListClick(Sender: TObject); procedure EdgeChange(Sender: TObject); procedure WidthChange(Sender: TObject); procedure NameChange(Sender: TObject); procedure ResetClick(Sender: TObject); procedure ResetAllClick(Sender: TObject); procedure CloseClick(Sender: TObject); procedure ShapePaint(Sender: TObject); function SlotLabel(Idx: Integer): string; protected procedure Paint; override; public constructor Create(AOwner: TComponent); override; // Перечитывает таблицу контроллера и показывает слот SlotIdx режима Mode. procedure LoadFrom(C: TRadioController; Mode, SlotIdx: Integer); // Подсветить выбор, когда фильтр переключили снаружи (кнопка/CAT/drag). procedure SyncSelection(Mode, Idx: Integer); // Показать под контролом-якорем (кнопкой фильтра) как дочерний контрол формы. procedure PopupBelow(C: TRadioController; Anchor: TControl; Mode, SlotIdx: Integer); property SlotIdx: Integer read FSlotIdx; property OnSlotEdited: TFilterSlotEvent read FOnSlotEdited write FOnSlotEdited; property OnSlotReset: TFilterResetEvent read FOnSlotReset write FOnSlotReset; end; implementation const {$IFDEF WINDOWS} UI_FONT = 'Segoe UI'; {$ELSE} UI_FONT = 'Sans'; {$ENDIF} CLR_BG = TColor($00303030); // рамка (1px кайма поповера) CLR_PANEL = TColor($001A1A1A); CLR_TEXT = TColor($00E0E0E0); CLR_TEXTDIM = TColor($00888888); CLR_ACCENT = TColor($0040FF80); CLR_INPUT = TColor($00FFFFFF); CLR_INPUT_TEXT = TColor($00202020); CLR_GRID = TColor($00303030); CLR_BAND = TColor($0040FF80); POP_W = 300; PAD = 10; LISTW = 78; LBLW = 40; ROWH = 24; ITEMH = 22; // = BASE_ITEM_H в FlatListBox SHAPE_H = 96; RULER_H = 13; EDGE_LIM = 20000; FE_MODE_NAMES: array[0..MODE_MAX] of string = ( 'LSB','USB','DSB','CWL','CWU','FM','AM','SAM','DIGU','DIGL','WFM','DMR','FMRAW'); constructor TFilterPopup.Create(AOwner: TComponent); var Y, CtlX, CtlW, BW: Integer; function MakeSpin(ATop: Integer; H: TNotifyEvent): TFlatSpinEdit; begin Result := TFlatSpinEdit.Create(Self); Result.Parent := FBg; Result.SetBounds(CtlX, ATop, CtlW, ROWH - 2); Result.MinValue := -EDGE_LIM; Result.MaxValue := EDGE_LIM; Result.Increment := 10; Result.Color := CLR_INPUT; Result.Font.Color := CLR_INPUT_TEXT; Result.Font.Name := UI_FONT; Result.Font.Size := 9; Result.OnChange := H; end; begin inherited Create(AOwner); ControlStyle := ControlStyle + [csOpaque]; Visible := False; Color := CLR_BG; Font.Name := UI_FONT; Font.Size := 9; Font.Color := CLR_TEXT; FMode := MODE_USB; FSlotIdx := 0; FPresets := FILT_COUNT; // ★Гард на ВСЁ время постройки: сеттеры Flat*-контролов (напр. // TFlatSpinEdit.SetMinValue → SetValue → DoChange) стреляют OnChange прямо // из конструктора, а обработчики трогают контролы, созданные ниже. FLoading := True; FBg := TPanel.Create(Self); FBg.Parent := Self; FBg.BevelOuter := bvNone; FBg.Color := CLR_PANEL; FBg.SetBounds(1, 1, POP_W - 2, 10); Y := PAD; FTitle := MakeLbl('Filters', PAD, Y + 2, POP_W - 2 * PAD - 18); FTitle.Font.Color := CLR_ACCENT; FTitle.Font.Style := [fsBold]; FBtnClose := MakeFlatBtn(FBg, '×', POP_W - PAD - 16, Y, 16, 16, CloseClick); FBtnClose.ClrText := CLR_TEXTDIM; FBtnClose.ClrTextAct := CLR_TEXT; Inc(Y, ROWH); // ---- Слева список слотов, справа поля ---- FList := TFlatListBox.Create(Self); FList.Parent := FBg; FList.SetBounds(PAD, Y, LISTW, FILT_SLOTS * ITEMH + 4); FList.Font.Name := UI_FONT; FList.Font.Size := 9; FList.OnClick := ListClick; // выбор строки = клик (у TFlatListBox нет OnSelect) CtlX := PAD + LISTW + 10 + LBLW + 6; CtlW := POP_W - PAD - CtlX; MakeLbl('Name', PAD + LISTW + 10, Y + 3, LBLW); FEdName := TFlatEdit.Create(Self); FEdName.Parent := FBg; FEdName.SetBounds(CtlX, Y, CtlW, ROWH - 2); FEdName.MaxLength := 6; FEdName.Color := CLR_INPUT; FEdName.Font.Color := CLR_INPUT_TEXT; FEdName.Font.Name := UI_FONT; FEdName.Font.Size := 9; FEdName.OnChange := NameChange; Inc(Y, ROWH + 4); MakeLbl('Low', PAD + LISTW + 10, Y + 3, LBLW); FEdLow := MakeSpin(Y, EdgeChange); Inc(Y, ROWH + 4); MakeLbl('High', PAD + LISTW + 10, Y + 3, LBLW); FEdHigh := MakeSpin(Y, EdgeChange); Inc(Y, ROWH + 4); MakeLbl('Width', PAD + LISTW + 10, Y + 3, LBLW); FEdWidth := MakeSpin(Y, WidthChange); FEdWidth.MinValue := FILT_MIN_WIDTH; Inc(Y, ROWH + 8); BW := (POP_W - PAD - (PAD + LISTW + 10) - 6) div 2; FBtnReset := MakeFlatBtn(FBg, 'Reset', PAD + LISTW + 10, Y, BW, ROWH - 2, ResetClick); FBtnResetAll := MakeFlatBtn(FBg, 'Reset all', PAD + LISTW + 10 + BW + 6, Y, BW, ROWH - 2, ResetAllClick); // Список выше полей — берём максимум по высоте. Y := Max(Y + ROWH - 2, FList.Top + FList.Height) + 8; MakeLbl('— Passband —', PAD, Y, POP_W - 2 * PAD).Font.Color := CLR_TEXTDIM; Inc(Y, 18); FShape := TPaintBox.Create(Self); FShape.Parent := FBg; FShape.SetBounds(PAD, Y, POP_W - 2 * PAD, SHAPE_H); FShape.OnPaint := ShapePaint; Inc(Y, SHAPE_H); FBg.Height := Y - 1 + PAD; Width := POP_W; Height := Y + 1 + PAD; FLoading := False; end; procedure TFilterPopup.Paint; begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := CLR_BG; Canvas.Pen.Style := psClear; Canvas.FillRect(0, 0, Width, Height); end; function TFilterPopup.MakeLbl(const Cap: string; ALeft, ATop, AW: Integer): TLabel; begin Result := TLabel.Create(Self); Result.Parent := FBg; Result.Caption := Cap; Result.Left := ALeft; Result.Top := ATop; if AW > 0 then Result.Width := AW; Result.Font.Color := CLR_TEXT; Result.Font.Name := UI_FONT; Result.Font.Size := 9; end; function TFilterPopup.SlotLabel(Idx: Integer): string; begin Result := FSet[Idx].Name; if Result = '' then Result := '—'; end; procedure TFilterPopup.FillList; var i: Integer; begin FList.Items.BeginUpdate; try FList.Items.Clear; for i := 0 to FPresets - 1 do FList.Items.Add(SlotLabel(i)); FList.Items.Add(SlotLabel(FILT_VAR1)); FList.Items.Add(SlotLabel(FILT_VAR2)); finally FList.Items.EndUpdate; end; end; procedure TFilterPopup.LoadFrom(C: TRadioController; Mode, SlotIdx: Integer); var i: Integer; begin if C = nil then Exit; FController := C; FMode := EnsureRange(Mode, 0, CFG_MODE_MAX); FPresets := FilterPresetCount(FMode); for i := 0 to FILT_SLOTS - 1 do FSet[i] := C.FilterSlot(FMode, i); FSlotIdx := EnsureRange(SlotIdx, 0, FILT_SLOTS - 1); // Пресет вне таблицы режима (FM/WFM короче) — показываем VAR1. if (FSlotIdx >= FPresets) and (FSlotIdx < FILT_VAR1) then FSlotIdx := FILT_VAR1; FTitle.Caption := 'Filters — ' + FE_MODE_NAMES[EnsureRange(FMode, 0, MODE_MAX)]; FLoading := True; try FillList; ShowSlot; finally FLoading := False; end; end; procedure TFilterPopup.SyncSelection(Mode, Idx: Integer); begin if (Mode <> FMode) or (Idx = FSlotIdx) then Exit; FSlotIdx := EnsureRange(Idx, 0, FILT_SLOTS - 1); FLoading := True; try ShowSlot; finally FLoading := False; end; end; procedure TFilterPopup.ShowSlot; var Row: Integer; begin if FSlotIdx >= FILT_VAR1 then Row := FPresets + (FSlotIdx - FILT_VAR1) else Row := FSlotIdx; FList.ItemIndex := Row; FEdName.Text := FSet[FSlotIdx].Name; FEdLow.Value := FSet[FSlotIdx].Lo; FEdHigh.Value := FSet[FSlotIdx].Hi; FEdWidth.Value := FSet[FSlotIdx].Hi - FSet[FSlotIdx].Lo; FShape.Invalidate; end; procedure TFilterPopup.Commit; begin if FLoading or (FShape = nil) then Exit; FShape.Invalidate; if Assigned(FOnSlotEdited) then FOnSlotEdited(FMode, FSlotIdx, FSet[FSlotIdx]); end; procedure TFilterPopup.ListClick(Sender: TObject); var Row: Integer; begin if FLoading then Exit; Row := FList.ItemIndex; if Row < 0 then Exit; if Row >= FPresets then FSlotIdx := FILT_VAR1 + (Row - FPresets) else FSlotIdx := Row; FLoading := True; try ShowSlot; finally FLoading := False; end; // Клик по строке = выбрать этот фильтр в приёмнике (как кнопка на панели). if Assigned(FController) then FController.SetFilterIdx(FSlotIdx); end; procedure TFilterPopup.EdgeChange(Sender: TObject); var Lo, Hi: Integer; begin if FLoading then Exit; Lo := FEdLow.Value; Hi := FEdHigh.Value; if Hi - Lo < FILT_MIN_WIDTH then begin // Края не пускаем друг через друга: двигаем тот, который НЕ трогали. if Sender = FEdLow then Hi := Lo + FILT_MIN_WIDTH else Lo := Hi - FILT_MIN_WIDTH; FLoading := True; try FEdLow.Value := Lo; FEdHigh.Value := Hi; finally FLoading := False; end; end; FSet[FSlotIdx].Lo := Lo; FSet[FSlotIdx].Hi := Hi; FLoading := True; try FEdWidth.Value := Hi - Lo; finally FLoading := False; end; Commit; end; procedure TFilterPopup.WidthChange(Sender: TObject); // Width производная: держим центр полосы, разъезжаются оба края (как Thetis). var W, C, Lo, Hi: Integer; begin if FLoading then Exit; W := Max(FILT_MIN_WIDTH, FEdWidth.Value); C := (FSet[FSlotIdx].Lo + FSet[FSlotIdx].Hi) div 2; Lo := C - W div 2; Hi := Lo + W; FSet[FSlotIdx].Lo := Lo; FSet[FSlotIdx].Hi := Hi; FLoading := True; try FEdLow.Value := Lo; FEdHigh.Value := Hi; finally FLoading := False; end; Commit; end; procedure TFilterPopup.NameChange(Sender: TObject); var Row: Integer; begin if FLoading then Exit; FSet[FSlotIdx].Name := FEdName.Text; Row := FList.ItemIndex; FLoading := True; try FillList; FList.ItemIndex := Row; finally FLoading := False; end; Commit; end; procedure TFilterPopup.ResetClick(Sender: TObject); begin if Assigned(FOnSlotReset) then FOnSlotReset(FMode, FSlotIdx); end; procedure TFilterPopup.ResetAllClick(Sender: TObject); begin if Assigned(FOnSlotReset) then FOnSlotReset(FMode, -1); end; procedure TFilterPopup.CloseClick(Sender: TObject); begin Hide; end; procedure TFilterPopup.ShapePaint(Sender: TObject); // Трапеция полосы в масштабе на знаковой оси. Окно оси симметрично нулю и // шире полосы, поэтому сразу видно, по какую сторону от несущей она лежит. var W, H, GH, ZeroX, i, X, Skirt, Lo, Hi, X1, X2: Integer; Span, Step: Double; S: string; function FreqToX(F: Double): Integer; begin Result := Round((F + Span) / (2 * Span) * W); end; begin W := FShape.Width; H := FShape.Height; if (W <= 0) or (H <= 0) then Exit; GH := H - RULER_H; Lo := FSet[FSlotIdx].Lo; Hi := FSet[FSlotIdx].Hi; with FShape.Canvas do begin Brush.Style := bsSolid; Brush.Color := CLR_PANEL; FillRect(0, 0, W, H); Span := Max(Abs(Lo), Abs(Hi)) * 1.6; if Span < 500 then Span := 500; // Сетка: шаг кратен 1 кГц, подстраивается под окно. Step := 1000; while Span / Step > 12 do Step := Step * 2; Pen.Style := psSolid; Pen.Color := CLR_GRID; i := -Trunc(Span / Step); while i <= Trunc(Span / Step) do begin X := FreqToX(i * Step); Line(X, 0, X, GH); Inc(i); end; // Ноль = несущая, ярче сетки. ZeroX := FreqToX(0); Pen.Color := CLR_TEXTDIM; Line(ZeroX, 0, ZeroX, GH); // Полоса: плоская вершина + схематичные скаты. X1 := FreqToX(Lo); X2 := FreqToX(Hi); Skirt := Max(2, Round(0.06 * (X2 - X1))); Brush.Color := CLR_BAND; Pen.Color := CLR_BAND; Polygon([Point(X1, GH - 2), Point(X1 + Skirt, Round(GH * 0.2)), Point(X2 - Skirt, Round(GH * 0.2)), Point(X2, GH - 2)]); // Линейка: края полосы + ноль. Brush.Style := bsClear; Font.Name := UI_FONT; Font.Size := 7; Font.Color := CLR_TEXTDIM; S := '0'; TextOut(ZeroX - TextWidth(S) div 2, GH, S); Font.Color := CLR_BAND; S := IntToStr(Lo); TextOut(Max(0, Min(W - TextWidth(S), X1 - TextWidth(S) div 2)), GH, S); S := IntToStr(Hi); TextOut(Max(0, Min(W - TextWidth(S), X2 - TextWidth(S) div 2)), GH, S); end; end; procedure TFilterPopup.PopupBelow(C: TRadioController; Anchor: TControl; Mode, SlotIdx: Integer); var Root: TCustomForm; L, T: Integer; Cl: TPoint; begin if Anchor = nil then Exit; Root := GetParentForm(Anchor); if Root = nil then Exit; // ★Родителя назначаем ДО заливки данных. TFlatListBox при заполнении и при // установке ItemIndex считает ItemHeight, а тот трогает Canvas // (Canvas.Font.Assign / TextHeight) — у контрола без родительского окна это // AV. У TPureSignalPopup списка нет, поэтому там порядок был обратный и // проблемы не возникало. Parent := Root; LoadFrom(C, Mode, SlotIdx); // Позиция под якорем в КЛИЕНТСКИХ координатах формы (не top-level окно!). Cl := Root.ScreenToClient(Anchor.ClientToScreen(Point(0, Anchor.Height + 2))); L := Cl.X; T := Cl.Y; if L + Width > Root.ClientWidth then L := Root.ClientWidth - Width; if L < 0 then L := 0; if T + Height > Root.ClientHeight then T := Root.ScreenToClient(Anchor.ClientToScreen(Point(0, 0))).Y - Height; if T < 0 then T := 0; SetBounds(L, T, Width, Height); Visible := True; BringToFront; end; end.