Files
ewsdr/PureSignalPopup.pas
T

473 lines
16 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.
{
Copyright (C)
2026 - Uladzimir Karpenka, EW8BAK
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit PureSignalPopup;
{
TPureSignalPopup — поповер управления и настроек PureSignal, открывается
ПКМ по кнопке PS на левой панели. Управление: PS (авто-калибровка вкл/выкл),
CAL (одиночная калибровка), RESET (сброс коррекции), 2TON. Статус: лампа и
уровень feedback (оптимум ~152), счётчик калибровок, лампа коррекции,
GetPk/SetPk. Параметры calcc (MOX/CAL wait, PH#, Relax ptol, Auto-atten,
Pin/Map/Stbl, Ints, тона 2TON) пишутся в FTXSettings.PS* живьём:
ApplyPSSettingsToDSP + OnChanged (персист в MainForm).
Реализован как ДОЧЕРНИЙ контрол верхнеуровневой формы (не отдельное окно) —
как TPanDisplayPopup: Wayland не даёт клиенту позиционировать top-level окна.
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, Math, Types, Controls, ExtCtrls, StdCtrls, Graphics, Forms,
RadioController, Settings,
FlatButton, FlatComboBox, FlatCheckBox, FlatSpinEdit, FlatFloatSpinEdit;
type
TPureSignalPopup = class(TCustomControl)
private
FController: TRadioController; // не владеем
FLoading: Boolean; // подавляет Apply при программной заливке
FBg: TPanel;
FTitle: TLabel;
FBtnClose: TFlatButton;
// Управление
FBtnPS: TFlatButton;
FBtnCal: TFlatButton;
FBtnReset: TFlatButton;
FBtn2Ton: TFlatButton;
// Статус
FFbLamp: TPanel;
FLbFbVal: TLabel;
FLbCals: TLabel;
FCorrLamp: TPanel;
FLbGetPk: TLabel;
FLbAtt: TLabel;
// Параметры
FSePk: TFlatFloatSpinEdit;
FBtnDefPk: TFlatButton;
FSeMoxWait: TFlatFloatSpinEdit;
FSeCalWait: TFlatFloatSpinEdit;
FSePhNum: TFlatSpinEdit;
FChkRelax: TFlatCheckBox;
FChkAutoAtt:TFlatCheckBox;
FChkPin: TFlatCheckBox;
FChkMap: TFlatCheckBox;
FChkStbl: TFlatCheckBox;
FCbInts: TFlatComboBox;
FSeTT1: TFlatSpinEdit;
FSeTT2: TFlatSpinEdit;
FOnChanged: TNotifyEvent;
function MakeLbl(const Cap: string; ALeft, ATop, AW: Integer): TLabel;
procedure Apply(Sender: TObject); // контролы → FTXSettings.PS* → WDSP
procedure PSClick(Sender: TObject);
procedure CalClick(Sender: TObject);
procedure ResetClick(Sender: TObject);
procedure TwoToneClick(Sender: TObject);
procedure DefPkClick(Sender: TObject);
procedure CloseClick(Sender: TObject);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
procedure LoadFrom(C: TRadioController);
// Обновление статусных ламп/значений (звать с UI-таймера пока Visible
// и по rfPureSignal/rfTwoTone).
procedure RefreshStatus;
// Показать под контролом-якорем (кнопкой PS) как дочерний контрол формы.
procedure PopupBelow(C: TRadioController; Anchor: TControl);
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
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);
// Лампа feedback — пороги от цели PSFBTarget (Thetis-Enhanced eu2av):
// >1.5×цели горячо, 0.7..1.3×цели оптимум, 0.5×..0.7× слабовато, ниже — нет
// сигнала. TColor = BGR.
CLR_FB_HOT = TColor($00FF9030); // голубой: слишком горячо (атт. мал)
CLR_FB_OK = TColor($0000FF00); // зелёный: оптимум
CLR_FB_LOW = TColor($0000FFFF); // жёлтый: слабовато
CLR_FB_NONE = TColor($000000C0); // красный: нет feedback
CLR_LAMP_OFF= TColor($00101010);
POP_W = 272;
PAD = 10;
LBLW = 92;
CTLX = 108;
ROWH = 24;
constructor TPureSignalPopup.Create(AOwner: TComponent);
var
Y: Integer;
function NextRow: Integer;
begin
Result := Y;
Inc(Y, ROWH + 4);
end;
function MakeIntSpin(ATop, AMin, AMax, AInc: Integer): TFlatSpinEdit;
begin
Result := TFlatSpinEdit.Create(Self);
Result.Parent := FBg;
Result.SetBounds(CTLX, ATop, POP_W - CTLX - PAD, ROWH - 2);
Result.MinValue := AMin;
Result.MaxValue := AMax;
Result.Increment := AInc;
Result.Color := CLR_INPUT;
Result.Font.Color := CLR_INPUT_TEXT;
Result.Font.Name := UI_FONT;
Result.Font.Size := 9;
Result.OnChange := Apply;
end;
function MakeFloatSpin(ATop: Integer; AMin, AMax, AInc: Double;
ADec: Integer): TFlatFloatSpinEdit;
begin
Result := TFlatFloatSpinEdit.Create(Self);
Result.Parent := FBg;
Result.SetBounds(CTLX, ATop, POP_W - CTLX - PAD, ROWH - 2);
Result.MinValue := AMin;
Result.MaxValue := AMax;
Result.Increment := AInc;
Result.DecimalPlaces := ADec;
Result.Color := CLR_INPUT;
Result.Font.Color := CLR_INPUT_TEXT;
Result.Font.Name := UI_FONT;
Result.Font.Size := 9;
Result.OnChange := Apply;
end;
function MakeChk(const Cap: string; ALeft, ATop, AW: Integer): TFlatCheckBox;
begin
Result := TFlatCheckBox.Create(Self);
Result.Parent := FBg;
Result.SetBounds(ALeft, ATop, AW, ROWH - 4);
Result.Caption := Cap;
Result.Font.Color := CLR_TEXT;
Result.Font.Name := UI_FONT;
Result.Font.Size := 9;
Result.OnChange := Apply;
end;
function MakeLamp(ALeft, ATop: Integer): TPanel;
begin
Result := TPanel.Create(Self);
Result.Parent := FBg;
Result.SetBounds(ALeft, ATop, 16, 16);
Result.BevelOuter := bvNone;
Result.Color := CLR_LAMP_OFF;
Result.Caption := '';
end;
var
BW: Integer;
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
Visible := False;
Color := CLR_BG;
Font.Name := UI_FONT;
Font.Size := 9;
Font.Color := CLR_TEXT;
FLoading := False;
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('PureSignal', PAD, NextRow + 2, POP_W - 2 * PAD - 18);
FTitle.Font.Color := CLR_ACCENT;
FTitle.Font.Style := [fsBold];
FBtnClose := MakeFlatBtn(FBg, '×', POP_W - PAD - 16, PAD, 16, 16, CloseClick);
FBtnClose.ClrText := CLR_TEXTDIM;
FBtnClose.ClrTextAct := CLR_TEXT;
// ---- Управление: PS / CAL / RESET / 2TON ----
BW := (POP_W - 2 * PAD - 2 * 6) div 3;
FBtnPS := MakeFlatBtn(FBg, 'PS ON', PAD, Y, BW, ROWH, PSClick);
FBtnCal := MakeFlatBtn(FBg, 'CAL', PAD + BW + 6, Y, BW, ROWH, CalClick);
FBtnReset := MakeFlatBtn(FBg, 'RESET', PAD + 2 * (BW + 6), Y, BW, ROWH, ResetClick);
NextRow;
FBtn2Ton := MakeFlatBtn(FBg, '2TON', PAD, Y, BW, ROWH, TwoToneClick);
// ---- Статус: лампа + FB + cals + corr в одной строке с 2TON ----
FFbLamp := MakeLamp(PAD + BW + 6, Y + 4);
FLbFbVal := MakeLbl('FB: —', PAD + BW + 28, Y + 4, 68);
FCorrLamp := MakeLamp(POP_W - PAD - 62, Y + 4);
MakeLbl('corr', POP_W - PAD - 42, Y + 4, 36).Font.Color := CLR_TEXTDIM;
NextRow;
FLbCals := MakeLbl('cals: 0', PAD, Y + 2, 90);
FLbCals.Font.Color := CLR_TEXTDIM;
FLbAtt := MakeLbl('TX ATT: — dB', PAD + 96, Y + 2, POP_W - 2 * PAD - 96);
FLbAtt.Font.Color := CLR_TEXTDIM;
Inc(Y, 20);
MakeLbl('— Calibration —', PAD, Y + 3, POP_W - 2 * PAD).Font.Color := CLR_TEXTDIM;
NextRow;
// ---- GetPk / SetPk ----
FLbGetPk := MakeLbl('GetPk: —', PAD, Y + 3, LBLW);
FSePk := MakeFloatSpin(Y, 0.05, 1.00, 0.01, 4);
FSePk.Width := FSePk.Width - 42;
FBtnDefPk := MakeFlatBtn(FBg, 'DEF', POP_W - PAD - 38, Y, 38, ROWH - 2, DefPkClick);
NextRow;
MakeLbl('MOX wait, s', PAD, Y + 3, LBLW);
FSeMoxWait := MakeFloatSpin(Y, 0.0, 0.9, 0.1, 1);
NextRow;
MakeLbl('CAL wait, s', PAD, Y + 3, LBLW);
FSeCalWait := MakeFloatSpin(Y, 0.0, 10.0, 0.5, 1);
NextRow;
MakeLbl('PH# delay, ns', PAD, Y + 3, LBLW);
FSePhNum := MakeIntSpin(Y, 0, 1000, 10);
NextRow;
FChkAutoAtt := MakeChk('Auto-attenuate', PAD, Y + 2, 130);
FChkRelax := MakeChk('Relax tolerance', PAD + 134, Y + 2, POP_W - 2 * PAD - 134);
NextRow;
FChkPin := MakeChk('Pin', PAD, Y + 2, 56);
FChkMap := MakeChk('Map', PAD + 62, Y + 2, 56);
FChkStbl := MakeChk('Stbl', PAD + 124, Y + 2, 60);
NextRow;
MakeLbl('Tint (ints/spi)', PAD, Y + 3, LBLW);
FCbInts := TFlatComboBox.Create(Self);
FCbInts.Parent := FBg;
FCbInts.SetBounds(CTLX, Y, POP_W - CTLX - PAD, ROWH - 2);
FCbInts.Items.Add('16 / 256');
FCbInts.Items.Add('8 / 512');
FCbInts.Items.Add('4 / 1024');
FCbInts.Color := CLR_INPUT;
FCbInts.Font.Color := CLR_INPUT_TEXT;
FCbInts.Font.Name := UI_FONT;
FCbInts.Font.Size := 9;
FCbInts.OnChange := Apply;
NextRow;
MakeLbl('— Two-tone, Hz —', PAD, Y + 3, POP_W - 2 * PAD).Font.Color := CLR_TEXTDIM;
NextRow;
MakeLbl('F1 / F2', PAD, Y + 3, LBLW);
FSeTT1 := MakeIntSpin(Y, 100, 5000, 100);
FSeTT1.Width := (POP_W - CTLX - PAD - 6) div 2;
FSeTT2 := MakeIntSpin(Y, 100, 5000, 100);
FSeTT2.SetBounds(CTLX + FSeTT1.Width + 6, Y, (POP_W - CTLX - PAD - 6) div 2, ROWH - 2);
NextRow;
FBg.Height := Y - 1 + PAD;
Width := POP_W;
Height := Y + 1 + PAD;
end;
procedure TPureSignalPopup.Paint;
begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := CLR_BG;
Canvas.Pen.Style := psClear;
Canvas.FillRect(0, 0, Width, Height);
end;
function TPureSignalPopup.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;
procedure TPureSignalPopup.LoadFrom(C: TRadioController);
begin
FController := C;
if C = nil then Exit;
FLoading := True;
try
FSePk.Value := EnsureRange(C.FTXSettings.PSHWPeak, 0.05, 1.00);
FSeMoxWait.Value := EnsureRange(C.FTXSettings.PSMoxDelay, 0.0, 0.9);
FSeCalWait.Value := EnsureRange(C.FTXSettings.PSLoopDelay, 0.0, 10.0);
FSePhNum.Value := EnsureRange(C.FTXSettings.PSTXDelayNs, 0, 1000);
FChkRelax.Checked := C.FTXSettings.PSRelaxPtol;
FChkAutoAtt.Checked := C.FTXSettings.PSAutoAtten;
FChkPin.Checked := C.FTXSettings.PSPin;
FChkMap.Checked := C.FTXSettings.PSMap;
FChkStbl.Checked := C.FTXSettings.PSStabilize;
FCbInts.ItemIndex := EnsureRange(C.FTXSettings.PSIntsIdx, 0, 2);
FSeTT1.Value := EnsureRange(C.FTXSettings.PSTTFreq1, 100, 5000);
FSeTT2.Value := EnsureRange(C.FTXSettings.PSTTFreq2, 100, 5000);
finally
FLoading := False;
end;
RefreshStatus;
end;
procedure TPureSignalPopup.Apply(Sender: TObject);
begin
if FLoading or (FController = nil) then Exit;
FController.FTXSettings.PSHWPeak := FSePk.Value;
FController.FTXSettings.PSMoxDelay := FSeMoxWait.Value;
FController.FTXSettings.PSLoopDelay := FSeCalWait.Value;
FController.FTXSettings.PSTXDelayNs := FSePhNum.Value;
FController.FTXSettings.PSRelaxPtol := FChkRelax.Checked;
FController.FTXSettings.PSAutoAtten := FChkAutoAtt.Checked;
FController.FTXSettings.PSPin := FChkPin.Checked;
FController.FTXSettings.PSMap := FChkMap.Checked;
FController.FTXSettings.PSStabilize := FChkStbl.Checked;
FController.FTXSettings.PSIntsIdx := EnsureRange(FCbInts.ItemIndex, 0, 2);
FController.FTXSettings.PSTTFreq1 := FSeTT1.Value;
FController.FTXSettings.PSTTFreq2 := FSeTT2.Value;
FController.ApplyPSSettingsToDSP;
if Assigned(FOnChanged) then FOnChanged(Self);
end;
procedure TPureSignalPopup.PSClick(Sender: TObject);
begin
if FController = nil then Exit;
FController.SetPureSignal(not FController.FPSEnabled);
RefreshStatus;
end;
procedure TPureSignalPopup.CalClick(Sender: TObject);
begin
if FController = nil then Exit;
FController.PSSingleCal;
RefreshStatus;
end;
procedure TPureSignalPopup.ResetClick(Sender: TObject);
begin
if FController = nil then Exit;
FController.PSReset;
RefreshStatus;
end;
procedure TPureSignalPopup.TwoToneClick(Sender: TObject);
begin
if FController = nil then Exit;
FController.SetTwoTone(not FController.FTwoTone);
RefreshStatus;
end;
procedure TPureSignalPopup.DefPkClick(Sender: TObject);
// Дефолт SetPk для протокола 2 (Thetis clsHardwareSpecific.PSDefaultPeak).
begin
FSePk.Value := 0.2899; // OnChange → Apply
end;
procedure TPureSignalPopup.CloseClick(Sender: TObject);
begin
Hide;
end;
procedure TPureSignalPopup.RefreshStatus;
var
FB, FBTarget: Integer;
LampClr: TColor;
begin
if (FController = nil) or not Visible then Exit;
FBtnPS.Active := FController.FPSEnabled;
if FController.FPSEnabled then FBtnPS.Caption := 'PS ON'
else FBtnPS.Caption := 'PS OFF';
FBtnCal.Active := FController.PSSingleCalActive;
FBtn2Ton.Active := FController.FTwoTone;
FB := FController.PSFeedbackLevel;
FBTarget := FController.PSFBTarget;
if FController.FPSFeedbackOn then
begin
if FB > Round(FBTarget * 1.5) then LampClr := CLR_FB_HOT
else if FB >= Round(FBTarget * 0.7) then
begin
if FB <= Round(FBTarget * 1.3) then LampClr := CLR_FB_OK
else LampClr := CLR_FB_LOW // 1.3..1.5×: желтовато
end
else if FB >= Round(FBTarget * 0.5) then LampClr := CLR_FB_LOW
else LampClr := CLR_FB_NONE;
end
else
LampClr := CLR_LAMP_OFF;
if FFbLamp.Color <> LampClr then FFbLamp.Color := LampClr;
FLbFbVal.Caption := Format('FB: %d/%d', [FB, FBTarget]);
if FController.PSCorrecting then
begin
if FCorrLamp.Color <> CLR_FB_OK then FCorrLamp.Color := CLR_FB_OK;
end
else if FCorrLamp.Color <> CLR_LAMP_OFF then
FCorrLamp.Color := CLR_LAMP_OFF;
FLbCals.Caption := Format('cals: %d', [FController.PSCalCount]);
FLbAtt.Caption := Format('TX ATT: %d dB', [FController.FTXSettings.AttOnTX]);
FLbGetPk.Caption := Format('GetPk: %.3f', [FController.PSMaxTXVal]);
end;
procedure TPureSignalPopup.PopupBelow(C: TRadioController; Anchor: TControl);
var
Root: TCustomForm;
L, T: Integer;
Cl: TPoint;
begin
if Anchor = nil then Exit;
Root := GetParentForm(Anchor);
if Root = nil then Exit;
LoadFrom(C);
// Позиция под якорем в КЛИЕНТСКИХ координатах формы (не 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;
Parent := Root;
SetBounds(L, T, Width, Height);
Visible := True;
BringToFront;
RefreshStatus;
end;
end.