ew8bak/ewsdr
1
0
Fork 0
mirror of https://git.vladimir.cc/vladimir/ewsdr.git synced 2026-08-25 18:43:51 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge feature/tx-profiles: TX-профили, подвкладки Transmit, заводские EQ ESSB, привязка профиля к «флаг + модуляция» + пласт UI/DPI

Browse Source
This commit is contained in:
ew8bak
2026-08-09 22:06:15 +03:00
parent 24890ca8a7 6195c80ce3
commit 0ec120c2d5
25 changed files with 4028 additions and 1009 deletions
Download Patch File Download Diff File Expand all files Collapse all files
BeaconScopeForm.pas
+308 -77
View File
@@ -17,19 +17,26 @@ interface
uses
Classes, SysUtils, Math, StrUtils,
Forms, Controls, Graphics, ExtCtrls, StdCtrls,
AppTheme, BeaconDecoder, BeaconFEC, RadioController;
AppTheme, BeaconDecoder, BeaconFEC, RadioController, DpiUtils, FlatMemo;
type
TBeaconScopeForm = class(TForm)
private
FCtl: TRadioController;
FHeader: TPanel;
FTitle: TLabel;
FSubtitle: TLabel;
FBox: TPaintBox;
FMemo: TMemo; // декодированный текст бюллетеня (AO-40 кадры)
FBulletin: TPanel;
FBulletinTitle: TLabel;
FBulletinHint: TLabel;
FMemo: TFlatMemo; // декодированный текст бюллетеня (AO-40 кадры)
FTimer: TTimer;
FTheme: TAppTheme;
FLastFrames: Int64; // счётчик кадров на прошлом тике (детект нового)
procedure DoTick(Sender: TObject);
procedure DoPaint(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure PollFrame;
function FrameToText(const Frame: TBeaconFrame): string;
public
@@ -40,34 +47,112 @@ type
implementation
constructor TBeaconScopeForm.CreateWith(AOwner: TComponent; ACtl: TRadioController);
var
WorkArea: TRect;
MaxW, MaxH: Integer;
begin
inherited CreateNew(AOwner);
FCtl := ACtl;
FTheme := DarkTheme;
Caption := 'QO-100 Beacon — Constellation + Bulletin';
// Геометрия формы задаётся ниже уже в DPI-aware координатах.
Scaled := False;
Caption := 'QO-100 Beacon';
BorderStyle := bsSizeable;
Width := 600;
Height := 680;
Position := poScreenCenter;
if AOwner is TCustomForm then
begin
WorkArea := TCustomForm(AOwner).BoundsRect;
WorkArea := Screen.MonitorFromRect(WorkArea).WorkareaRect;
Position := poOwnerFormCenter;
end
else
begin
WorkArea := Screen.PrimaryMonitor.WorkareaRect;
Position := poScreenCenter;
end;
MaxW := WorkArea.Right - WorkArea.Left - DpiScale(48);
MaxH := WorkArea.Bottom - WorkArea.Top - DpiScale(48);
Width := Min(DpiScale(760), MaxW);
Height := Min(DpiScale(700), MaxH);
Constraints.MinWidth := Min(DpiScale(520), Width);
Constraints.MinHeight := Min(DpiScale(560), Height);
Color := FTheme.BG;
// Текст бюллетеня (декодированные AO-40 кадры) — снизу, моноширинный, ReadOnly.
FMemo := TMemo.Create(Self);
FMemo.Parent := Self;
FMemo.Align := alBottom;
FMemo.Height := 230;
FHeader := TPanel.Create(Self);
FHeader.Parent := Self;
FHeader.Align := alTop;
FHeader.Height := DpiScale(72);
FHeader.BevelOuter := bvNone;
FHeader.Color := FTheme.Panel;
FTitle := TLabel.Create(Self);
FTitle.Parent := FHeader;
FTitle.Caption := 'QO-100 BEACON DECODER';
FTitle.AutoSize := False;
FTitle.SetBounds(DpiScale(20), DpiScale(12),
DpiScale(520), DpiScale(26));
FTitle.Font.Size := 15;
FTitle.Font.Style := [fsBold];
FTitle.Font.Color := FTheme.Text;
FSubtitle := TLabel.Create(Self);
FSubtitle.Parent := FHeader;
FSubtitle.Caption :=
'BPSK constellation, carrier recovery and AO-40 telemetry';
FSubtitle.AutoSize := False;
FSubtitle.SetBounds(DpiScale(20), DpiScale(40),
DpiScale(620), DpiScale(20));
FSubtitle.Font.Size := 9;
FSubtitle.Font.Color := FTheme.TextDim;
FBulletin := TPanel.Create(Self);
FBulletin.Parent := Self;
FBulletin.Align := alBottom;
FBulletin.Height := DpiScale(236);
FBulletin.BevelOuter := bvNone;
FBulletin.Color := FTheme.Panel;
FBulletinTitle := TLabel.Create(Self);
FBulletinTitle.Parent := FBulletin;
FBulletinTitle.Caption := 'DECODED BULLETIN';
FBulletinTitle.AutoSize := False;
FBulletinTitle.SetBounds(DpiScale(16), DpiScale(9),
DpiScale(220), DpiScale(20));
FBulletinTitle.Font.Size := 9;
FBulletinTitle.Font.Style := [fsBold];
FBulletinTitle.Font.Color := FTheme.MeterOn;
FBulletinHint := TLabel.Create(Self);
FBulletinHint.Parent := FBulletin;
FBulletinHint.Caption := 'latest AO-40 frames · read-only';
FBulletinHint.AutoSize := False;
FBulletinHint.SetBounds(DpiScale(250), DpiScale(9),
DpiScale(300), DpiScale(20));
FBulletinHint.Anchors := [akTop, akRight];
FBulletinHint.Left := FBulletin.ClientWidth - DpiScale(316);
FBulletinHint.Alignment := taRightJustify;
FBulletinHint.Font.Size := 8;
FBulletinHint.Font.Color := FTheme.TextDim;
// Бюллетень остаётся обычным read-only memo: текст можно выделить и скопировать.
FMemo := TFlatMemo.Create(Self);
FMemo.Parent := FBulletin;
FMemo.Align := alClient;
FMemo.BorderSpacing.Left := DpiScale(12);
FMemo.BorderSpacing.Top := DpiScale(36);
FMemo.BorderSpacing.Right := DpiScale(12);
FMemo.BorderSpacing.Bottom := DpiScale(12);
FMemo.ReadOnly := True;
FMemo.ScrollBars := ssVertical;
FMemo.WordWrap := False;
FMemo.Font.Name := 'Courier New';
FMemo.Font.Size := 9;
FMemo.Color := FTheme.BG;
FMemo.Font.Color := FTheme.Text;
FMemo.SetAppTheme(FTheme);
FBox := TPaintBox.Create(Self);
FBox.Parent := Self;
FBox.Align := alClient;
FBox.OnPaint := @DoPaint;
OnResize := @FormResize;
FormResize(nil);
FTimer := TTimer.Create(Self);
FTimer.Interval := 40; // ~25 Гц
@@ -78,10 +163,39 @@ end;
procedure TBeaconScopeForm.ApplyTheme(const T: TAppTheme);
begin
FTheme := T;
Color := T.BG;
if FHeader <> nil then FHeader.Color := T.Panel;
if FTitle <> nil then FTitle.Font.Color := T.Text;
if FSubtitle <> nil then FSubtitle.Font.Color := T.TextDim;
if FBulletin <> nil then FBulletin.Color := T.Panel;
if FBulletinTitle <> nil then FBulletinTitle.Font.Color := T.MeterOn;
if FBulletinHint <> nil then FBulletinHint.Font.Color := T.TextDim;
if FMemo <> nil then
FMemo.SetAppTheme(T);
if FBox <> nil then FBox.Invalidate;
end;
procedure TBeaconScopeForm.FormResize(Sender: TObject);
var
BulletinH, MaxBulletinH: Integer;
begin
if (FHeader <> nil) and (FBulletin <> nil) then
begin
FMemo.Color := FTheme.BG;
FMemo.Font.Color := FTheme.Text;
MaxBulletinH := ClientHeight - FHeader.Height - DpiScale(270);
BulletinH := Min(DpiScale(236),
Max(DpiScale(150), MaxBulletinH));
if FBulletin.Height <> BulletinH then
FBulletin.Height := BulletinH;
end;
if FTitle <> nil then
FTitle.Width := Max(0, FHeader.ClientWidth - DpiScale(40));
if FSubtitle <> nil then
FSubtitle.Width := Max(0, FHeader.ClientWidth - DpiScale(40));
if FBulletinHint <> nil then
begin
FBulletinHint.Left := DpiScale(250);
FBulletinHint.Width := Max(0,
FBulletin.ClientWidth - DpiScale(266));
end;
if FBox <> nil then FBox.Invalidate;
end;
@@ -134,46 +248,163 @@ end;
procedure TBeaconScopeForm.DoPaint(Sender: TObject);
var
C: TCanvas;
W, H, cx, cy, r, i, px, py: Integer;
W, H, M, Gap, CardGap, GraphSize, cx, cy, r, i, px, py: Integer;
GraphR, MetricsR, PlotR: TRect;
S: TBeaconScope;
ok: Boolean;
C1, C2: TColor;
st: string;
ok, Wide: Boolean;
CarrierText, SymbolText, SNRText, BaudText: string;
OffsetText, ResidText, FramesText, FECText: string;
TechText: string;
CarrierColor, SymbolColor: TColor;
procedure SetUIFont(ASize: Integer; AStyle: TFontStyles = []);
begin
C.Font.Assign(Self.Font);
C.Font.Size := ASize;
C.Font.Style := AStyle;
end;
procedure DrawCard(const R: TRect; const ATitle: string);
begin
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.Panel;
C.Pen.Style := psSolid;
C.Pen.Width := 1;
C.Pen.Color := FTheme.Border;
C.RoundRect(R.Left, R.Top, R.Right, R.Bottom,
DpiScale(8), DpiScale(8));
SetUIFont(8, [fsBold]);
C.Font.Color := FTheme.TextDim;
C.Brush.Style := bsClear;
C.TextOut(R.Left + DpiScale(14), R.Top + DpiScale(10), ATitle);
end;
procedure DrawMetricTile(const R: TRect; const ALabel, AValue: string;
AValueColor: TColor);
begin
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.BG;
C.Pen.Style := psSolid;
C.Pen.Color := FTheme.Border;
C.RoundRect(R.Left, R.Top, R.Right, R.Bottom,
DpiScale(5), DpiScale(5));
C.Brush.Style := bsClear;
SetUIFont(8);
C.Font.Color := FTheme.TextDim;
C.TextOut(R.Left + DpiScale(9), R.Top + DpiScale(6), ALabel);
SetUIFont(9, [fsBold]);
C.Font.Color := AValueColor;
C.TextOut(R.Left + DpiScale(9), R.Top + DpiScale(21), AValue);
end;
procedure DrawMetrics;
const
LABELS: array[0..7] of string =
('CARRIER', 'SYMBOL', 'SNR', 'SYMBOL RATE',
'TUNE OFFSET', 'RESIDUAL', 'FRAMES', 'FEC');
var
Values: array[0..7] of string;
Colors: array[0..7] of TColor;
Cols, Rows, Col, Row, TileW, TileH, X, Y, n: Integer;
R: TRect;
begin
Values[0] := CarrierText; Values[1] := SymbolText;
Values[2] := SNRText; Values[3] := BaudText;
Values[4] := OffsetText; Values[5] := ResidText;
Values[6] := FramesText; Values[7] := FECText;
for n := 0 to 7 do Colors[n] := FTheme.Text;
Colors[0] := CarrierColor;
Colors[1] := SymbolColor;
if ok and S.HasFrame then Colors[6] := FTheme.MeterOn;
if ok and S.HasFrame then Colors[7] := FTheme.MeterOn;
if Wide then begin Cols := 2; Rows := 4; end
else begin Cols := 4; Rows := 2; end;
CardGap := DpiScale(8);
TileW := (MetricsR.Right - MetricsR.Left - DpiScale(28)
- (Cols - 1) * CardGap) div Cols;
TileH := (MetricsR.Bottom - MetricsR.Top - DpiScale(70)
- (Rows - 1) * CardGap) div Rows;
for n := 0 to 7 do
begin
Col := n mod Cols;
Row := n div Cols;
X := MetricsR.Left + DpiScale(14) + Col * (TileW + CardGap);
Y := MetricsR.Top + DpiScale(34) + Row * (TileH + CardGap);
R := Rect(X, Y, X + TileW, Y + TileH);
DrawMetricTile(R, LABELS[n], Values[n], Colors[n]);
end;
SetUIFont(7);
C.Font.Color := FTheme.TextDim;
C.Brush.Style := bsClear;
C.TextOut(MetricsR.Left + DpiScale(14),
MetricsR.Bottom - DpiScale(20), TechText);
end;
begin
C := FBox.Canvas;
W := FBox.Width; H := FBox.Height;
// фон
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.BG;
C.FillRect(0, 0, W, H);
if (W <= 0) or (H <= 0) then Exit;
// область констелляции — квадрат сверху, текст снизу
r := (Min(W, H - 70) - 20) div 2;
if r < 20 then r := 20;
if r > 110 then r := 110; // кап: оставляем место метрикам над memo
cx := W div 2;
cy := 10 + r;
M := DpiScale(16);
Gap := DpiScale(14);
Wide := W >= DpiScale(600);
if Wide then
begin
GraphSize := Min(H - 2 * M, (W - 3 * M) div 2);
GraphR := Rect(M, M, M + GraphSize, H - M);
MetricsR := Rect(GraphR.Right + Gap, M, W - M, H - M);
end
else
begin
GraphSize := Max(DpiScale(74), H - DpiScale(154) - 3 * M);
GraphR := Rect(M, M, W - M, M + GraphSize);
MetricsR := Rect(M, GraphR.Bottom + Gap, W - M, H - M);
end;
DrawCard(GraphR, 'CONSTELLATION');
DrawCard(MetricsR, 'DECODER STATUS');
// сетка/оси
// Квадрат констелляции центрируется внутри своей карточки.
GraphSize := Min(GraphR.Right - GraphR.Left - DpiScale(28),
GraphR.Bottom - GraphR.Top - DpiScale(48));
GraphSize := Max(DpiScale(40), GraphSize);
PlotR.Left := GraphR.Left +
(GraphR.Right - GraphR.Left - GraphSize) div 2;
PlotR.Top := GraphR.Top + DpiScale(34) +
(GraphR.Bottom - GraphR.Top - DpiScale(40) - GraphSize) div 2;
PlotR.Right := PlotR.Left + GraphSize;
PlotR.Bottom := PlotR.Top + GraphSize;
cx := (PlotR.Left + PlotR.Right) div 2;
cy := (PlotR.Top + PlotR.Bottom) div 2;
r := GraphSize div 2 - DpiScale(8);
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.BG;
C.Pen.Style := psSolid;
C.Pen.Color := FTheme.Border;
C.Rectangle(PlotR.Left, PlotR.Top, PlotR.Right, PlotR.Bottom);
C.Pen.Style := psSolid;
C.Pen.Color := FTheme.SpecGrid;
C.Line(cx - r, cy, cx + r, cy); // ось I (горизонт)
C.Line(cx, cy - r, cx, cy + r); // ось Q (вертикаль)
C.Pen.Color := FTheme.Border;
C.Line(cx - r, cy, cx + r, cy);
C.Line(cx, cy - r, cx, cy + r);
C.Brush.Style := bsClear;
C.Rectangle(cx - r, cy - r, cx + r, cy + r);
C.Ellipse(cx - r, cy - r, cx + r, cy + r);
C.Ellipse(cx - r div 2, cy - r div 2, cx + r div 2, cy + r div 2);
// целевые точки BPSK (±1, 0) — ориентир
C.Pen.Color := FTheme.TextDim;
C.Ellipse(cx + r div 2 - 3, cy - 3, cx + r div 2 + 3, cy + 3);
C.Ellipse(cx - r div 2 - 3, cy - 3, cx - r div 2 + 3, cy + 3);
C.Ellipse(cx + r div 2 - DpiScale(3), cy - DpiScale(3),
cx + r div 2 + DpiScale(3), cy + DpiScale(3));
C.Ellipse(cx - r div 2 - DpiScale(3), cy - DpiScale(3),
cx - r div 2 + DpiScale(3), cy + DpiScale(3));
ok := (FCtl <> nil) and FCtl.GetBeaconScope(S);
if ok and S.Enabled then
begin
// точки констелляции (нормированы к ±1; масштаб r/2 → ±1 на половине радиуса)
C.Pen.Style := psClear;
C.Brush.Style := bsSolid;
C.Brush.Color := FTheme.MeterOn;
@@ -182,53 +413,53 @@ begin
px := cx + Round(S.PtI[i] * (r / 2));
py := cy - Round(S.PtQ[i] * (r / 2));
if (px >= cx - r) and (px <= cx + r) and (py >= cy - r) and (py <= cy + r) then
C.FillRect(px - 1, py - 1, px + 2, py + 2);
C.FillRect(px - DpiScale(1), py - DpiScale(1),
px + DpiScale(2), py + DpiScale(2));
end;
end;
// ----- метрики -----
C.Brush.Style := bsClear;
C.Font.Name := 'Courier New';
C.Font.Size := 9;
py := cy + r + 12;
if not ok then
begin
C.Font.Color := FTheme.TextDim;
C.TextOut(14, py, 'decoder unavailable');
Exit;
CarrierText := 'UNAVAILABLE';
SymbolText := 'UNAVAILABLE';
SNRText := '--'; BaudText := '--';
OffsetText := '--'; ResidText := '--';
FramesText := '--'; FECText := '--';
TechText := 'Decoder data unavailable';
CarrierColor := FTheme.TextDim;
SymbolColor := FTheme.TextDim;
end;
if not S.Enabled then
if ok and (not S.Enabled) then
begin
C.Font.Color := FTheme.TextDim;
C.TextOut(14, py, 'decoder OFF (enable via BEACON \ decode)');
Exit;
CarrierText := 'OFF'; SymbolText := 'OFF';
SNRText := '--'; BaudText := '--';
OffsetText := '--'; ResidText := '--';
FramesText := IntToStr(S.Frames);
FECText := '--';
TechText := 'Enable BEACON and select the beacon on the spectrum';
CarrierColor := FTheme.TextDim;
SymbolColor := FTheme.TextDim;
end;
if S.CarrierLock then C1 := FTheme.MeterOn else C1 := FTheme.TextDim;
if S.SymbolLock then C2 := FTheme.MeterOn else C2 := FTheme.TextDim;
C.Font.Color := C1;
C.TextOut(14, py, 'CARRIER ' + IfThen(S.CarrierLock, 'LOCK', '----'));
C.Font.Color := C2;
C.TextOut(14, py + 18, 'SYMBOL ' + IfThen(S.SymbolLock, 'LOCK', '----'));
C.Font.Color := FTheme.Text;
if S.SNRdB > -50 then st := Format('%.1f dB', [S.SNRdB]) else st := '--';
C.TextOut(14, py + 36, 'SNR ' + st);
C.TextOut(14, py + 54, Format('BAUD %.1f (off %.0f Hz)', [S.SymRate, S.OffsetHz]));
C.Font.Color := FTheme.TextDim;
C.TextOut(14, py + 72, Format('CARRIER resid %.0f Hz prom %.0f', [S.ResidHz, S.CarProm]));
if FCtl <> nil then
C.TextOut(14, py + 90, 'INVERT ' + IfThen(FCtl.BeaconDecodeInvert, 'ON', 'OFF'));
C.TextOut(14, py + 108, Format('RATE Fs %.0f Fdec %.0f sps %.1f',
[S.FsHz, S.FdecHz, S.Sps]));
// ----- FEC (AO-40) -----
if S.HasFrame then C.Font.Color := FTheme.MeterOn else C.Font.Color := FTheme.TextDim;
C.TextOut(14, py + 132, Format('FRAMES %d (RS err %d)', [S.Frames, S.LastRSErr]));
C.Font.Color := FTheme.TextDim;
C.TextOut(14, py + 150, Format('MANCHESTER phase %d', [S.ManPhase]));
if ok and S.Enabled then
begin
CarrierText := IfThen(S.CarrierLock, 'LOCKED', 'SEARCH');
SymbolText := IfThen(S.SymbolLock, 'LOCKED', 'SEARCH');
if S.SNRdB > -50 then SNRText := Format('%.1f dB', [S.SNRdB])
else SNRText := '--';
BaudText := Format('%.1f Bd', [S.SymRate]);
OffsetText := Format('%.0f Hz', [S.OffsetHz]);
ResidText := Format('%.0f Hz', [S.ResidHz]);
FramesText := IntToStr(S.Frames);
FECText := Format('RS %d · P%d', [S.LastRSErr, S.ManPhase]);
TechText := Format('INV %s · PROM %.0f · Fs %.0f · Fd %.0f · SPS %.1f',
[IfThen(FCtl.BeaconDecodeInvert, 'ON', 'OFF'), S.CarProm,
S.FsHz, S.FdecHz, S.Sps]);
if S.CarrierLock then CarrierColor := FTheme.MeterOn
else CarrierColor := FTheme.TextDim;
if S.SymbolLock then SymbolColor := FTheme.MeterOn
else SymbolColor := FTheme.TextDim;
end;
DrawMetrics;
end;
end.
ChannelsForm.pas
+247 -92
View File
@@ -14,7 +14,7 @@ uses
Forms, Controls, Graphics, StdCtrls, ExtCtrls,
FlatButton, FlatCheckBox, FlatComboBox, FlatEdit,
FlatSpinEdit, FlatFloatSpinEdit, FlatListBox,
AppTheme, ChannelStore, RadioModes;
AppTheme, ChannelStore, RadioModes, DpiUtils;
const
// Копии из MainForm: нужны для выпадающих списков
@@ -39,10 +39,19 @@ type
FBtnDelete: TFlatButton;
FBtnUp: TFlatButton;
FBtnDown: TFlatButton;
FBtnClose: TFlatButton;
FList: TFlatListBox;
// --- Правая панель (поля редактирования) ---
FPanelRight: TPanel;
FFooterPanel: TPanel;
FCardIdentity: TPanel;
FCardRadio: TPanel;
FCardRepeater: TPanel;
FLeftTitle: TLabel;
FLeftHint: TLabel;
FRightTitle: TLabel;
FRightHint: TLabel;
// Labels (для перекраски темой)
FLbls: array of TLabel;
@@ -66,11 +75,13 @@ type
FUpdating: Boolean;
FOnChanged: TNotifyEvent;
FCurrentDefaults: TChannel; // значения по умолчанию для новых каналов
FTheme: TAppTheme;
procedure BuildUI;
procedure StyleBtn(B: TFlatButton; AActive: Boolean = False);
function MakeLabel(AParent: TWinControl; const Cap: string;
X, Y, W, H: Integer): TLabel;
function MakeGroupPanel(const Cap: string; Y, H: Integer): TPanel;
procedure LoadChannelToFields(Idx: Integer);
procedure SaveFieldsToChannel;
procedure RefreshList(KeepIdx: Integer = -1);
@@ -90,6 +101,7 @@ type
procedure OnCTCSSChkChange(Sender: TObject);
procedure OnCTCSSCmbChange(Sender: TObject);
// Handlers — форма
procedure OnCloseClick(Sender: TObject);
procedure OnFormClose(Sender: TObject; var CloseAction: TCloseAction);
public
constructor Create(AOwner: TComponent; AStore: TChannelStore;
@@ -103,31 +115,54 @@ implementation
const
// Геометрия
LPANEL_W = 185; // ширина левой панели
TOOLBAR_H = 32; // высота тулбара с кнопками Add/Del/Up/Down
BTN_H = 24;
LPANEL_W = 240;
TOOLBAR_Y = 66;
TOOLBAR_H = 30;
BTN_H = 26;
FORM_W = 820;
FORM_H = 540;
PAGE_MARGIN = 18;
// Правая панель
LBL_X = 8;
LBL_W = 95;
CTRL_X = 106;
ROW_H = 30; // высота строки
CTRL_H = 24; // высота контрола
LBL_X = 14;
LBL_W = 106;
CTRL_X = 126;
ROW_H = 28;
CTRL_H = 24;
constructor TChannelsForm.Create(AOwner: TComponent; AStore: TChannelStore;
AOnChanged: TNotifyEvent);
var
WorkArea: TRect;
MaxW, MaxH: Integer;
begin
inherited CreateNew(AOwner);
FStore := AStore;
FOnChanged := AOnChanged;
FUpdating := False;
FTheme := DarkTheme;
TChannelStore.DefaultChannel(FCurrentDefaults);
Scaled := False;
Caption := 'Channels';
BorderStyle := bsSizeable;
Width := 720;
Height := 480;
Position := poScreenCenter;
if AOwner is TCustomForm then
begin
WorkArea := TCustomForm(AOwner).BoundsRect;
WorkArea := Screen.MonitorFromRect(WorkArea).WorkareaRect;
Position := poOwnerFormCenter;
end
else
begin
WorkArea := Screen.PrimaryMonitor.WorkareaRect;
Position := poScreenCenter;
end;
MaxW := WorkArea.Right - WorkArea.Left - DpiScale(48);
MaxH := WorkArea.Bottom - WorkArea.Top - DpiScale(48);
Width := Min(DpiScale(FORM_W), MaxW);
Height := Min(DpiScale(FORM_H), MaxH);
Constraints.MinWidth := Min(DpiScale(680), Width);
Constraints.MinHeight := Min(DpiScale(530), Height);
KeyPreview := True;
OnClose := @OnFormClose;
@@ -138,46 +173,72 @@ end;
procedure TChannelsForm.BuildUI;
var
i: Integer;
BtnW: Integer;
RW: Integer; // ширина правой панели
Y: Integer;
i, BtnW, CardW, Y: Integer;
L: TLabel;
procedure PlaceRightUnit(AParent: TWinControl; const Cap: string;
ATop: Integer);
begin
L := MakeLabel(AParent, Cap, 0, ATop + 1, 42, CTRL_H);
L.SetBounds(AParent.ClientWidth - DpiScale(50), DpiScale(ATop + 1),
DpiScale(42), DpiScale(CTRL_H));
L.Anchors := [akTop, akRight];
end;
begin
SetLength(FLbls, 0);
// ----- Левая панель -----
FPanelLeft := TPanel.Create(Self);
FPanelLeft.Parent := Self;
FPanelLeft.Align := alLeft;
FPanelLeft.Width := LPANEL_W;
FPanelLeft.Width := DpiScale(LPANEL_W);
FPanelLeft.BevelOuter := bvNone;
BtnW := (LPANEL_W - 4 - 3 * 2) div 4; // 4 кнопки с зазорами
FLeftTitle := MakeLabel(FPanelLeft, 'CHANNEL MEMORY',
14, 12, LPANEL_W - 28, 24);
FLeftTitle.Font.Size := 9;
FLeftTitle.Font.Style := [fsBold];
FLeftTitle.Font.Color := FTheme.Text;
FLeftHint := MakeLabel(FPanelLeft, 'Saved frequencies and modes',
14, 37, LPANEL_W - 28, 18);
FLeftHint.Font.Size := 8;
BtnW := (DpiScale(LPANEL_W - 24) - 3 * DpiScale(6)) div 4;
FBtnAdd := TFlatButton.Create(Self);
FBtnAdd.Parent := FPanelLeft;
FBtnAdd.SetBounds(2, 4, BtnW, BTN_H);
FBtnAdd.SetBounds(DpiScale(12), DpiScale(TOOLBAR_Y),
BtnW, DpiScale(BTN_H));
FBtnAdd.Caption := 'ADD';
FBtnAdd.OnClick := @OnAddClick;
FBtnDelete := TFlatButton.Create(Self);
FBtnDelete.Parent := FPanelLeft;
FBtnDelete.SetBounds(2 + (BtnW + 2), 4, BtnW, BTN_H);
FBtnDelete.SetBounds(FBtnAdd.Left + BtnW + DpiScale(6),
FBtnAdd.Top, BtnW, FBtnAdd.Height);
FBtnDelete.Caption := 'DEL';
FBtnDelete.OnClick := @OnDeleteClick;
FBtnUp := TFlatButton.Create(Self);
FBtnUp.Parent := FPanelLeft;
FBtnUp.SetBounds(2 + 2 * (BtnW + 2), 4, BtnW, BTN_H);
FBtnUp.SetBounds(FBtnDelete.Left + BtnW + DpiScale(6),
FBtnAdd.Top, BtnW, FBtnAdd.Height);
FBtnUp.Caption := '↑';
FBtnUp.OnClick := @OnUpClick;
FBtnDown := TFlatButton.Create(Self);
FBtnDown.Parent := FPanelLeft;
FBtnDown.SetBounds(2 + 3 * (BtnW + 2), 4, BtnW, BTN_H);
FBtnDown.SetBounds(FBtnUp.Left + BtnW + DpiScale(6),
FBtnAdd.Top, BtnW, FBtnAdd.Height);
FBtnDown.Caption := '↓';
FBtnDown.OnClick := @OnDownClick;
FList := TFlatListBox.Create(Self);
FList.Parent := FPanelLeft;
FList.SetBounds(0, TOOLBAR_H, LPANEL_W, FPanelLeft.Height - TOOLBAR_H);
FList.SetBounds(DpiScale(12), DpiScale(TOOLBAR_Y + TOOLBAR_H + 10),
FPanelLeft.ClientWidth - DpiScale(24),
FPanelLeft.ClientHeight - DpiScale(TOOLBAR_Y + TOOLBAR_H + 22));
FList.Anchors := [akLeft, akTop, akRight, akBottom];
FList.OnClick := @OnListClick;
FList.OnDblClick := @OnListDblClick;
@@ -188,34 +249,62 @@ begin
FPanelRight.Align := alClient;
FPanelRight.BevelOuter := bvNone;
SetLength(FLbls, 0);
RW := Width - LPANEL_W;
FFooterPanel := TPanel.Create(Self);
FFooterPanel.Parent := FPanelRight;
FFooterPanel.Align := alBottom;
FFooterPanel.Height := DpiScale(50);
FFooterPanel.BevelOuter := bvNone;
Y := 8;
FBtnClose := TFlatButton.Create(Self);
FBtnClose.Parent := FFooterPanel;
FBtnClose.Caption := 'Close';
FBtnClose.SetBounds(FFooterPanel.ClientWidth - DpiScale(110),
DpiScale(10), DpiScale(92), DpiScale(30));
FBtnClose.Anchors := [akTop, akRight];
FBtnClose.OnClick := @OnCloseClick;
// Group
MakeLabel(FPanelRight, 'Group', LBL_X, Y + 1, LBL_W, CTRL_H);
FRightTitle := MakeLabel(FPanelRight, 'CHANNEL DETAILS',
PAGE_MARGIN, 10, 420, 22);
FRightTitle.Font.Size := 9;
FRightTitle.Font.Style := [fsBold];
FRightTitle.Font.Color := FTheme.Text;
FRightTitle.Anchors := [akLeft, akTop, akRight];
FRightHint := MakeLabel(FPanelRight,
'Changes are saved automatically', PAGE_MARGIN, 31, 420, 18);
FRightHint.Font.Size := 8;
FRightHint.Anchors := [akLeft, akTop, akRight];
FCardIdentity := MakeGroupPanel('IDENTITY', 56, 90);
CardW := FCardIdentity.ClientWidth;
Y := 34;
MakeLabel(FCardIdentity, 'Group', LBL_X, Y + 1, LBL_W, CTRL_H);
FEdGroup := TFlatEdit.Create(Self);
FEdGroup.Parent := FPanelRight;
FEdGroup.SetBounds(CTRL_X, Y, RW - CTRL_X - 8, CTRL_H);
FEdGroup.Parent := FCardIdentity;
FEdGroup.SetBounds(DpiScale(CTRL_X), DpiScale(Y),
CardW - DpiScale(CTRL_X + 14), DpiScale(CTRL_H));
FEdGroup.Anchors := [akLeft, akTop, akRight];
FEdGroup.OnChange := @OnFieldChange;
Inc(Y, ROW_H);
// Name
MakeLabel(FPanelRight, 'Name', LBL_X, Y + 1, LBL_W, CTRL_H);
MakeLabel(FCardIdentity, 'Name', LBL_X, Y + 1, LBL_W, CTRL_H);
FEdName := TFlatEdit.Create(Self);
FEdName.Parent := FPanelRight;
FEdName.SetBounds(CTRL_X, Y, RW - CTRL_X - 8, CTRL_H);
FEdName.Parent := FCardIdentity;
FEdName.SetBounds(DpiScale(CTRL_X), DpiScale(Y),
CardW - DpiScale(CTRL_X + 14), DpiScale(CTRL_H));
FEdName.Anchors := [akLeft, akTop, akRight];
FEdName.OnChange := @OnFieldChange;
Inc(Y, ROW_H);
// RX Freq
MakeLabel(FPanelRight, 'RX Freq', LBL_X, Y + 1, LBL_W, CTRL_H);
FCardRadio := MakeGroupPanel('RADIO', 156, 120);
CardW := FCardRadio.ClientWidth;
Y := 34;
MakeLabel(FCardRadio, 'RX frequency', LBL_X, Y + 1, LBL_W, CTRL_H);
FSpinRXFreq := TFlatFloatSpinEdit.Create(Self);
FSpinRXFreq.Parent := FPanelRight;
FSpinRXFreq.SetBounds(CTRL_X, Y, RW - CTRL_X - 50, CTRL_H);
FSpinRXFreq.Parent := FCardRadio;
FSpinRXFreq.SetBounds(DpiScale(CTRL_X), DpiScale(Y),
CardW - DpiScale(CTRL_X + 56), DpiScale(CTRL_H));
FSpinRXFreq.Anchors := [akLeft, akTop, akRight];
FSpinRXFreq.MinValue := 0.001;
FSpinRXFreq.MaxValue := 2000.0;
@@ -223,14 +312,14 @@ begin
FSpinRXFreq.DecimalPlaces := 6;
FSpinRXFreq.Value := 145.5;
FSpinRXFreq.OnChange := @OnFieldChange;
MakeLabel(FPanelRight, 'MHz', RW - 46, Y + 1, 40, CTRL_H);
PlaceRightUnit(FCardRadio, 'MHz', Y);
Inc(Y, ROW_H);
// TX Freq
MakeLabel(FPanelRight, 'TX Freq', LBL_X, Y + 1, LBL_W, CTRL_H);
MakeLabel(FCardRadio, 'TX frequency', LBL_X, Y + 1, LBL_W, CTRL_H);
FSpinTXFreq := TFlatFloatSpinEdit.Create(Self);
FSpinTXFreq.Parent := FPanelRight;
FSpinTXFreq.SetBounds(CTRL_X, Y, RW - CTRL_X - 50, CTRL_H);
FSpinTXFreq.Parent := FCardRadio;
FSpinTXFreq.SetBounds(DpiScale(CTRL_X), DpiScale(Y),
CardW - DpiScale(CTRL_X + 56), DpiScale(CTRL_H));
FSpinTXFreq.Anchors := [akLeft, akTop, akRight];
FSpinTXFreq.MinValue := 0.001;
FSpinTXFreq.MaxValue := 2000.0;
@@ -238,48 +327,53 @@ begin
FSpinTXFreq.DecimalPlaces := 6;
FSpinTXFreq.Value := 145.5;
FSpinTXFreq.OnChange := @OnFieldChange;
MakeLabel(FPanelRight, 'MHz', RW - 46, Y + 1, 40, CTRL_H);
PlaceRightUnit(FCardRadio, 'MHz', Y);
Inc(Y, ROW_H);
// Mode
MakeLabel(FPanelRight, 'Mode', LBL_X, Y + 1, LBL_W, CTRL_H);
MakeLabel(FCardRadio, 'Mode', LBL_X, Y + 1, LBL_W, CTRL_H);
FCmbMode := TFlatComboBox.Create(Self);
FCmbMode.Parent := FPanelRight;
FCmbMode.SetBounds(CTRL_X, Y, 160, CTRL_H);
FCmbMode.Parent := FCardRadio;
FCmbMode.SetBounds(DpiScale(CTRL_X), DpiScale(Y),
DpiScale(180), DpiScale(CTRL_H));
for i := 0 to CH_MODE_COUNT - 1 do FCmbMode.Items.Add(CH_MODE_NAMES[i]);
FCmbMode.ItemIndex := 5; // FM default
FCmbMode.OnChange := @OnFieldChange;
Inc(Y, ROW_H);
// RPTR direction
MakeLabel(FPanelRight, 'RPTR', LBL_X, Y + 1, LBL_W, CTRL_H);
FCardRepeater := MakeGroupPanel('REPEATER / TRANSMIT', 286, 148);
CardW := FCardRepeater.ClientWidth;
Y := 34;
MakeLabel(FCardRepeater, 'Direction', LBL_X, Y + 1, LBL_W, CTRL_H);
FBtnRptNone := TFlatButton.Create(Self);
FBtnRptNone.Parent := FPanelRight;
FBtnRptNone.SetBounds(CTRL_X, Y, 55, CTRL_H);
FBtnRptNone.Parent := FCardRepeater;
FBtnRptNone.SetBounds(DpiScale(CTRL_X), DpiScale(Y),
DpiScale(72), DpiScale(CTRL_H));
FBtnRptNone.Caption := 'NONE';
FBtnRptNone.Tag := 0;
FBtnRptNone.OnClick := @OnRptBtnClick;
FBtnRptMinus := TFlatButton.Create(Self);
FBtnRptMinus.Parent := FPanelRight;
FBtnRptMinus.SetBounds(CTRL_X + 58, Y, 38, CTRL_H);
FBtnRptMinus.Parent := FCardRepeater;
FBtnRptMinus.SetBounds(DpiScale(CTRL_X + 78), DpiScale(Y),
DpiScale(46), DpiScale(CTRL_H));
FBtnRptMinus.Caption := '−';
FBtnRptMinus.Tag := 1;
FBtnRptMinus.OnClick := @OnRptBtnClick;
FBtnRptPlus := TFlatButton.Create(Self);
FBtnRptPlus.Parent := FPanelRight;
FBtnRptPlus.SetBounds(CTRL_X + 99, Y, 38, CTRL_H);
FBtnRptPlus.Parent := FCardRepeater;
FBtnRptPlus.SetBounds(DpiScale(CTRL_X + 130), DpiScale(Y),
DpiScale(46), DpiScale(CTRL_H));
FBtnRptPlus.Caption := '+';
FBtnRptPlus.Tag := 2;
FBtnRptPlus.OnClick := @OnRptBtnClick;
Inc(Y, ROW_H);
// RPTR Offset
MakeLabel(FPanelRight, 'RPT Offset', LBL_X, Y + 1, LBL_W, CTRL_H);
MakeLabel(FCardRepeater, 'Offset', LBL_X, Y + 1, LBL_W, CTRL_H);
FSpinRptOffset := TFlatFloatSpinEdit.Create(Self);
FSpinRptOffset.Parent := FPanelRight;
FSpinRptOffset.SetBounds(CTRL_X, Y, RW - CTRL_X - 50, CTRL_H);
FSpinRptOffset.Parent := FCardRepeater;
FSpinRptOffset.SetBounds(DpiScale(CTRL_X), DpiScale(Y),
CardW - DpiScale(CTRL_X + 56), DpiScale(CTRL_H));
FSpinRptOffset.Anchors := [akLeft, akTop, akRight];
FSpinRptOffset.MinValue := 0.0;
FSpinRptOffset.MaxValue := 100.0;
@@ -287,37 +381,38 @@ begin
FSpinRptOffset.DecimalPlaces := 3;
FSpinRptOffset.Value := 0.6;
FSpinRptOffset.OnChange := @OnFieldChange;
MakeLabel(FPanelRight, 'MHz', RW - 46, Y + 1, 40, CTRL_H);
PlaceRightUnit(FCardRepeater, 'MHz', Y);
Inc(Y, ROW_H);
// CTCSS
MakeLabel(FPanelRight, 'CTCSS', LBL_X, Y + 1, LBL_W, CTRL_H);
MakeLabel(FCardRepeater, 'CTCSS tone', LBL_X, Y + 1, LBL_W, CTRL_H);
FChkCTCSS := TFlatCheckBox.Create(Self);
FChkCTCSS.Parent := FPanelRight;
FChkCTCSS.SetBounds(CTRL_X, Y, 26, CTRL_H);
FChkCTCSS.Parent := FCardRepeater;
FChkCTCSS.SetBounds(DpiScale(CTRL_X), DpiScale(Y),
DpiScale(28), DpiScale(CTRL_H));
FChkCTCSS.Caption := '';
FChkCTCSS.Checked := False;
FChkCTCSS.OnChange := @OnCTCSSChkChange;
FCmbCTCSS := TFlatComboBox.Create(Self);
FCmbCTCSS.Parent := FPanelRight;
FCmbCTCSS.SetBounds(CTRL_X + 30, Y, RW - CTRL_X - 38, CTRL_H);
FCmbCTCSS.Parent := FCardRepeater;
FCmbCTCSS.SetBounds(DpiScale(CTRL_X + 34), DpiScale(Y),
CardW - DpiScale(CTRL_X + 48), DpiScale(CTRL_H));
FCmbCTCSS.Anchors := [akLeft, akTop, akRight];
for i := 0 to CH_CTCSS_COUNT - 1 do FCmbCTCSS.Items.Add(CH_CTCSS_NAMES[i]);
FCmbCTCSS.ItemIndex := 0;
FCmbCTCSS.OnChange := @OnCTCSSCmbChange;
Inc(Y, ROW_H);
// Power
MakeLabel(FPanelRight, 'Power', LBL_X, Y + 1, LBL_W, CTRL_H);
MakeLabel(FCardRepeater, 'Power', LBL_X, Y + 1, LBL_W, CTRL_H);
FSpinPower := TFlatSpinEdit.Create(Self);
FSpinPower.Parent := FPanelRight;
FSpinPower.SetBounds(CTRL_X, Y, 80, CTRL_H);
FSpinPower.Parent := FCardRepeater;
FSpinPower.SetBounds(DpiScale(CTRL_X), DpiScale(Y),
DpiScale(92), DpiScale(CTRL_H));
FSpinPower.MinValue := 0;
FSpinPower.MaxValue := 100;
FSpinPower.Value := 100;
FSpinPower.OnChange := @OnFieldChange;
MakeLabel(FPanelRight, '%', CTRL_X + 84, Y + 1, 20, CTRL_H);
MakeLabel(FCardRepeater, '%', CTRL_X + 98, Y + 1, 24, CTRL_H);
end;
function TChannelsForm.MakeLabel(AParent: TWinControl; const Cap: string;
@@ -327,37 +422,86 @@ begin
L := TLabel.Create(Self);
L.Parent := AParent;
L.Caption := Cap;
L.SetBounds(X, Y, W, H);
L.Font.Name := 'Courier New';
L.AutoSize := False;
L.SetBounds(DpiScale(X), DpiScale(Y), DpiScale(W), DpiScale(H));
L.Layout := tlCenter;
L.Font.Size := 8;
L.Font.Color := DarkTheme.TextDim;
L.Font.Color := FTheme.TextDim;
// Сохраняем для последующей перекраски темой
SetLength(FLbls, Length(FLbls) + 1);
FLbls[High(FLbls)] := L;
Result := L;
end;
procedure TChannelsForm.StyleBtn(B: TFlatButton; AActive: Boolean);
var T: TAppTheme;
function TChannelsForm.MakeGroupPanel(const Cap: string; Y, H: Integer): TPanel;
var
Title: TLabel;
Divider: TPanel;
begin
T := DarkTheme;
Result := TPanel.Create(Self);
Result.Parent := FPanelRight;
Result.SetBounds(DpiScale(PAGE_MARGIN), DpiScale(Y),
FPanelRight.ClientWidth - DpiScale(2 * PAGE_MARGIN), DpiScale(H));
Result.Anchors := [akLeft, akTop, akRight];
Result.BevelOuter := bvNone;
Result.Color := FTheme.Panel;
Title := MakeLabel(Result, Cap, 12, 2, 300, 24);
Title.Font.Size := 8;
Title.Font.Style := [fsBold];
Title.Font.Color := FTheme.FreqActive;
Divider := TPanel.Create(Self);
Divider.Parent := Result;
Divider.SetBounds(0, DpiScale(28), Result.ClientWidth, 1);
Divider.Anchors := [akLeft, akTop, akRight];
Divider.BevelOuter := bvNone;
Divider.Color := FTheme.Border;
end;
procedure TChannelsForm.StyleBtn(B: TFlatButton; AActive: Boolean);
begin
// Прямо созданные TFlatButton не проходят через MakeFlatBtn, поэтому
// явно даём им тот же системный шрифт, что и остальному интерфейсу.
B.Font.Assign(Font);
B.Font.Size := 8;
B.Font.Style := [];
B.Active := AActive;
B.ClrNorm := T.BtnNorm;
B.ClrActive := T.BtnActive;
B.ClrHot := T.BtnHot;
B.ClrBorder := IfThen(AActive, T.BtnBorderActive, T.BtnBorderNorm);
B.ClrText := T.BtnText;
B.ClrTextAct := T.BtnTextActive;
B.ClrNorm := FTheme.BtnNorm;
B.ClrActive := FTheme.BtnActive;
B.ClrHot := FTheme.BtnHot;
B.ClrBorder := IfThen(AActive,
FTheme.BtnBorderActive, FTheme.BtnBorderNorm);
B.ClrText := FTheme.BtnText;
B.ClrTextAct := FTheme.BtnTextActive;
B.Invalidate;
end;
procedure TChannelsForm.ApplyTheme(const T: TAppTheme);
var
i: Integer;
Ch: TChannel;
procedure ThemeCard(P: TPanel);
var
n: Integer;
begin
if P = nil then Exit;
P.Color := T.Panel;
for n := 0 to P.ControlCount - 1 do
if (P.Controls[n] is TPanel) and (P.Controls[n].Height = 1) then
TPanel(P.Controls[n]).Color := T.Border;
end;
begin
Color := T.Panel;
FTheme := T;
Color := T.BG;
FPanelLeft.Color := T.Panel;
FPanelRight.Color := T.Panel;
FPanelRight.Color := T.BG;
FFooterPanel.Color := T.BG;
ThemeCard(FCardIdentity);
ThemeCard(FCardRadio);
ThemeCard(FCardRepeater);
FList.SetAppTheme(T);
@@ -365,6 +509,7 @@ begin
StyleBtn(FBtnDelete);
StyleBtn(FBtnUp);
StyleBtn(FBtnDown);
StyleBtn(FBtnClose);
// RPT buttons — пересчитываем Active из текущего состояния
if SelectedIdx >= 0 then
@@ -393,9 +538,15 @@ begin
for i := 0 to High(FLbls) do
begin
FLbls[i].Font.Color := T.TextDim;
FLbls[i].Color := T.Panel;
FLbls[i].ParentColor := False;
if FLbls[i] = FLeftTitle then
FLbls[i].Font.Color := T.Text
else if FLbls[i] = FRightTitle then
FLbls[i].Font.Color := T.Text
else if fsBold in FLbls[i].Font.Style then
FLbls[i].Font.Color := T.FreqActive
else
FLbls[i].Font.Color := T.TextDim;
FLbls[i].Transparent := True;
end;
end;
@@ -476,7 +627,6 @@ procedure TChannelsForm.SaveFieldsToChannel;
var
Idx: Integer;
Ch: TChannel;
i: Integer;
begin
if FUpdating then Exit;
Idx := SelectedIdx;
@@ -607,6 +757,11 @@ begin
SaveFieldsToChannel;
end;
procedure TChannelsForm.OnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TChannelsForm.OnFormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
CloseAction := caHide; // скрываем, не уничтожаем — указатель в MainForm остаётся валидным
DeviceForm.pas
+14 -27
View File
@@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, FlatButton, FlatEdit, FlatListBox, AppTheme, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, LCLType,
BoardUtils, PlatformUtils, DeviceStore, RadioBackend, DpiUtils;
BoardUtils, DeviceStore, RadioBackend, DpiUtils;
type
// Результат диалога
@@ -26,8 +26,6 @@ type
FResult: TDeviceDialogResult;
// UI
PanelTop: TPanel;
PanelBottom: TPanel;
PanelLeft: TPanel;
PanelRight: TPanel;
@@ -40,6 +38,7 @@ type
EdIP: TFlatEdit;
LblName: TLabel;
LblIP: TLabel;
LblAutoHint: TLabel;
LblFound: TLabel;
LstFound: TFlatListBox;
@@ -52,7 +51,6 @@ type
FOnDiscover: TNotifyEvent; // внешний callback для запуска discovery
procedure BuildUI;
procedure ApplyTheme;
procedure SetStore(AStore: TDeviceStore);
procedure RefreshSavedList;
@@ -105,7 +103,6 @@ const
CLR_PANEL = TColor($001A1A1A);
CLR_TEXT = TColor($00E0E0E0);
CLR_TEXTDIM = TColor($00888888);
CLR_BORDER = TColor($00303030);
CLR_ACCENT = TColor($0040FF80);
CLR_AUTO = TColor($0000CCFF); // цвет авто-устройства
DLG_W = 760;
@@ -123,18 +120,20 @@ const
constructor TDeviceDialog.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
// Форма целиком строится кодом и уже масштабирует геометрию через DpiScale.
// Автоскейл LCL поверх неё дал бы повторный множитель (125% -> 156.25%).
Scaled := False;
Caption := 'Device Selection';
Width := DpiScale(DLG_W);
Height := DpiScale(DLG_H);
Position := poScreenCenter;
BorderStyle := bsDialog;
Color := CLR_BG;
Font.Name := 'Courier New';
Font.Size := 8;
Font.Color := CLR_TEXT;
FStore := nil; // назначается владельцем через property Store до показа
FResult.Accepted := False;
ClearResult;
BuildUI;
SetTheme(DarkTheme);
@@ -163,7 +162,6 @@ begin
Result.Parent := AParent;
Result.Caption := Cap;
Result.Left := DpiScale(X); Result.Top := DpiScale(Y);
Result.Font.Name := 'Courier New';
Result.Font.Size := 8;
Result.Font.Color := CLR_TEXTDIM;
end;
@@ -172,7 +170,6 @@ procedure TDeviceDialog.BuildUI;
const
LabelH = 18;
var
LblHint: TLabel;
FieldTop, ButtonsTop, BottomTop: Integer;
begin
// --- Левая панель: сохранённые устройства ---
@@ -182,36 +179,33 @@ begin
PanelLeft.BevelOuter := bvNone;
PanelLeft.Color := CLR_PANEL;
MakeLbl(PanelLeft, 'SAVED DEVICES', PAD, PAD);
LblSaved := MakeLbl(PanelLeft, 'SAVED DEVICES', PAD, PAD);
LstSaved := TFlatListBox.Create(Self);
LstSaved.Parent := PanelLeft;
LstSaved.SetBounds(DpiScale(PAD), DpiScale(PAD + LabelH), DpiScale(LEFT_W - PAD * 2), DpiScale(174));
LstSaved.Color := CLR_BG;
LstSaved.Font.Color:= CLR_TEXT;
LstSaved.Font.Name := 'Courier New';
LstSaved.Font.Size := 8;
LstSaved.OnClick := @LstSavedClick;
LstSaved.OnDblClick := @LstSavedDblClick;
FieldTop := 212;
MakeLbl(PanelLeft, 'Name:', PAD, FieldTop + 5);
LblName := MakeLbl(PanelLeft, 'Name:', PAD, FieldTop + 5);
EdName := TFlatEdit.Create(Self);
EdName.Parent := PanelLeft;
EdName.SetBounds(DpiScale(76), DpiScale(FieldTop), DpiScale(LEFT_W - 76 - PAD), DpiScale(EDIT_H));
EdName.Color := CLR_BG;
EdName.Font.Color:= CLR_TEXT;
EdName.Font.Name := 'Courier New';
EdName.Font.Size := 8;
Inc(FieldTop, EDIT_H + 10);
MakeLbl(PanelLeft, 'IP:', PAD, FieldTop + 5);
LblIP := MakeLbl(PanelLeft, 'IP:', PAD, FieldTop + 5);
EdIP := TFlatEdit.Create(Self);
EdIP.Parent := PanelLeft;
EdIP.SetBounds(DpiScale(76), DpiScale(FieldTop), DpiScale(LEFT_W - 76 - PAD), DpiScale(EDIT_H));
EdIP.Color := CLR_BG;
EdIP.Font.Color:= CLR_TEXT;
EdIP.Font.Name := 'Courier New';
EdIP.Font.Size := 8;
EdIP.TextHint := '192.168.1.x';
@@ -221,8 +215,9 @@ begin
Inc(ButtonsTop, BTN_H + 8);
BtnSetAuto := MakeBtn(PanelLeft, 'SET AUTOSTART', PAD, ButtonsTop, 154, BTN_H, @BtnSetAutoClick);
LblHint := MakeLbl(PanelLeft, '* = autostart', PAD + 168, ButtonsTop + 6);
LblHint.Font.Color := CLR_AUTO;
LblAutoHint := MakeLbl(PanelLeft, '* = autostart',
PAD + 168, ButtonsTop + 6);
LblAutoHint.Font.Color := CLR_AUTO;
BottomTop := PANEL_H - PAD - BTN_H - 6;
BtnConnect := MakeBtn(PanelLeft, 'CONNECT', PAD, BottomTop, LEFT_W - PAD * 2, BTN_H + 6, @BtnConnectClick);
@@ -236,14 +231,13 @@ begin
PanelRight.BevelOuter := bvNone;
PanelRight.Color := CLR_PANEL;
MakeLbl(PanelRight, 'DISCOVERED DEVICES', PAD, PAD);
LblFound := MakeLbl(PanelRight, 'DISCOVERED DEVICES', PAD, PAD);
LstFound := TFlatListBox.Create(Self);
LstFound.Parent := PanelRight;
LstFound.SetBounds(DpiScale(PAD), DpiScale(PAD + LabelH), DpiScale(RIGHT_W - PAD * 2), DpiScale(250));
LstFound.Color := CLR_BG;
LstFound.Font.Color:= CLR_TEXT;
LstFound.Font.Name := 'Courier New';
LstFound.Font.Size := 8;
LstFound.OnDblClick := @LstFoundDblClick;
@@ -254,11 +248,6 @@ begin
BtnCancel := MakeBtn(PanelRight, 'CANCEL', RIGHT_W - PAD - 116, BottomTop, 116, BTN_H + 6, @BtnCancelClick);
end;
procedure TDeviceDialog.ApplyTheme;
begin
SetTheme(DarkTheme);
end;
procedure TDeviceDialog.SetTheme(const T: TAppTheme);
procedure StyleButton(B: TFlatButton; Active: Boolean);
@@ -272,7 +261,6 @@ procedure TDeviceDialog.SetTheme(const T: TAppTheme);
else B.ClrBorder := T.BtnBorderNorm;
B.ClrText := T.BtnText;
B.ClrTextAct := T.BtnTextActive;
B.Font.Name := 'Courier New';
B.Font.Size := 8;
B.Font.Color := T.Text;
B.Invalidate;
@@ -288,7 +276,6 @@ procedure TDeviceDialog.SetTheme(const T: TAppTheme);
B.ClrBorder := T.TbDiscoverBorder;
B.ClrText := T.TbDiscoverText;
B.ClrTextAct := T.TbDiscoverText;
B.Font.Name := 'Courier New';
B.Font.Size := 8;
B.Font.Color := T.TbDiscoverText;
B.Invalidate;
@@ -304,7 +291,6 @@ procedure TDeviceDialog.SetTheme(const T: TAppTheme);
B.ClrBorder := T.TbStartBorder;
B.ClrText := T.TbStartText;
B.ClrTextAct := T.TbStartText;
B.Font.Name := 'Courier New';
B.Font.Size := 8;
B.Font.Color := T.TbStartText;
B.Invalidate;
@@ -340,6 +326,7 @@ begin
if EdName <> nil then EdName.SetAppTheme(T);
if EdIP <> nil then EdIP.SetAppTheme(T);
WalkLabels(Self);
if LblAutoHint <> nil then LblAutoHint.Font.Color := T.Amber;
Invalidate;
end;
EqualizerControl.pas
+136 -23
View File
@@ -31,6 +31,7 @@ type
FBtnBands3: TFlatButton;
FBtnBands10: TFlatButton;
FButtonTheme: TAppTheme;
FRespDB: array of Double; // АЧХ по бинам (дБ), пересчитывается в Paint
function GetBandGain(Index: Integer): Double;
function GetBandFreq(Index: Integer): Double;
procedure SetEnabledEQ(V: Boolean);
@@ -47,7 +48,9 @@ type
function BandX(Index: Integer; const R: TRect): Integer;
function XToFreq(X: Integer; const R: TRect): Double;
function BandColor(Index: Integer): TColor;
function GridBandFreq(Index: Integer): Double;
function InternalBandFreq(Index: Integer): Double;
procedure BuildResponse;
function ResponseAtFreq(AFreq: Double): Double;
function FormatFreq(AFreq: Double): string;
function HitTestControl(X, Y: Integer): Integer;
@@ -93,6 +96,20 @@ const
MAX_FREQ = 20000.0;
TOP_H = 44;
BOTTOM_H = 82;
// Кривая = точное повторение расчёта WDSP (wdsp/eq.c, eq_impulse) под
// геометрию НАШЕГО TXA: канал открыт с dsp_rate = FAudioRate (48 кГц),
// eqp создаётся с nc = max(2048, dsp_size) и ctfmode = 0 (TXA.c) —
// SetTXAEQNC/SetTXAEQCtfmode мы не зовём. Отсюда N = 2048 ⇒ N/2 бинов
// до Найквиста. Рисовать «колокольчики», как принято у графических EQ,
// нельзя: WDSP строит ломаную по точкам и обрывает всё за крайними.
RESP_RATE = 48000.0;
RESP_MID = 1024; // N/2
RESP_BIN_HZ = RESP_RATE / 2.0 / RESP_MID; // 23.4375 Hz
RESP_FLOOR = -2000.0; // 1e-100 в амплитуде — пол WDSP
// Legacy-раскладка 3-полосного EQ у самого WDSP (SetTXAGrphEQ) — её же
// отдаёт движок (WDSPEngine.PushTXEQProfile). Частоты фиксированы, ручка
// Low держит полку 150..400 Гц, High тянется до 6 кГц.
EQ3_F: array[1..3] of Double = (150.0, 1500.0, 6000.0);
constructor TEqualizerControl.Create(AOwner: TComponent);
var
@@ -300,7 +317,8 @@ begin
else Result := FClrAccent;
end;
function TEqualizerControl.InternalBandFreq(Index: Integer): Double;
function TEqualizerControl.GridBandFreq(Index: Integer): Double;
// Узел 10-полосной сетки профиля (то, что реально хранится и сохраняется).
begin
if (Index >= 1) and (Index <= 10) and (FFreqs[Index] > 0.0) then
Result := FFreqs[Index]
@@ -308,24 +326,113 @@ begin
Result := MIN_FREQ * Power(MAX_FREQ / MIN_FREQ, EnsureRange((Index - 1) / 9, 0.0, 1.0));
end;
function TEqualizerControl.ResponseAtFreq(AFreq: Double): Double;
var
i, N: Integer;
D, W, Sum, LF, LBand: Double;
function TEqualizerControl.InternalBandFreq(Index: Integer): Double;
// Частота, на которой ручка ДЕЙСТВУЕТ. В 3-полосном режиме это не наша сетка,
// а legacy-раскладка WDSP; FFreqs при этом не трогается, поэтому возврат к
// 10 полосам отдаёт пользователю его же кривую.
begin
Result := FPreampGain;
LF := Ln(EnsureRange(AFreq, MIN_FREQ, MAX_FREQ));
Sum := 0.0;
N := FBandCount;
for i := 1 to N do
if FBandCount = 3 then
Result := EQ3_F[EnsureRange(Index, 1, 3)]
else
Result := GridBandFreq(Index);
end;
procedure TEqualizerControl.BuildResponse;
// Порт eq_impulse (wdsp/eq.c) в дБ, без построения самого FIR. Точки F/G —
// узлы ломаной: между ними линейная интерполяция ПО ДЕЦИБЕЛАМ, ниже первой и
// выше последней точки ctfmode=0 даёт кумулятивный скат (f/f0)^4 НА КАЖДЫЙ
// бин — то есть фактически обрыв. Именно поэтому включённый EQ работает как
// второй полосовой фильтр, и верхняя точка обязана лежать за краем TX-фильтра.
var
N, i, j, k, Lo, Hi: Integer;
Fp, Gp: array[0..11] of Double;
TF, TG, F, Frac, Preamp, MagDB, RefDB: Double;
begin
if Length(FRespDB) <> RESP_MID then SetLength(FRespDB, RESP_MID);
Preamp := FPreampGain;
if FBandCount = 3 then
begin
LBand := Ln(InternalBandFreq(i));
D := (LF - LBand) / 0.30;
W := Exp(-0.5 * D * D);
Sum := Sum + FGains[i] * W;
// Ровно то, что уходит в WDSP из PushTXEQProfile: 4 узла, полка на низах.
N := 4;
Fp[1] := 2.0 * 150.0 / RESP_RATE; Gp[1] := FGains[1];
Fp[2] := 2.0 * 400.0 / RESP_RATE; Gp[2] := FGains[1];
Fp[3] := 2.0 * 1500.0 / RESP_RATE; Gp[3] := FGains[2];
Fp[4] := 2.0 * 6000.0 / RESP_RATE; Gp[4] := FGains[3];
end
else
begin
N := EnsureRange(FBandCount, 1, 10);
for i := 1 to N do
begin
Fp[i] := EnsureRange(2.0 * InternalBandFreq(i) / RESP_RATE, 0.0, 1.0);
Gp[i] := FGains[i];
end;
end;
// WDSP сортирует точки по частоте (qsort) — порядок ручек значения не имеет.
for i := 1 to N - 1 do
for j := 1 to N - i do
if Fp[j] > Fp[j + 1] then
begin
TF := Fp[j]; Fp[j] := Fp[j + 1]; Fp[j + 1] := TF;
TG := Gp[j]; Gp[j] := Gp[j + 1]; Gp[j + 1] := TG;
end;
Fp[0] := 0.0; Gp[0] := Gp[1];
Fp[N + 1] := 1.0; Gp[N + 1] := Gp[N];
j := 0;
for i := 0 to RESP_MID - 1 do
begin
F := (i + 0.5) / RESP_MID;
while (j < N) and (F > Fp[j + 1]) do Inc(j);
if Fp[j + 1] > Fp[j] then Frac := (F - Fp[j]) / (Fp[j + 1] - Fp[j])
else Frac := 0.0;
FRespDB[i] := Frac * Gp[j + 1] + (1.0 - Frac) * Gp[j] + Preamp;
end;
// Скаты за крайними точками (ctfmode = 0, чётная ветка N). Множитель на бин
// — (f/f0)^4 в АМПЛИТУДЕ, в децибелах 80*log10(f/f0), и он накапливается.
Lo := Trunc(Fp[1] * RESP_MID - 0.5);
Hi := Trunc(Fp[N] * RESP_MID - 0.5);
if (Lo > 0) and (Lo < RESP_MID) then
begin
MagDB := FRespDB[Lo];
RefDB := 80.0 * Log10(Lo / RESP_MID);
for k := Lo - 1 downto 0 do
begin
if k > 0 then MagDB := MagDB + 80.0 * Log10(k / RESP_MID) - RefDB
else MagDB := RESP_FLOOR;
if MagDB < RESP_FLOOR then MagDB := RESP_FLOOR;
FRespDB[k] := MagDB;
end;
end;
if (Hi >= 0) and (Hi < RESP_MID - 1) then
begin
MagDB := FRespDB[Hi];
RefDB := 80.0 * Log10(Hi / RESP_MID);
for k := Hi + 1 to RESP_MID - 1 do
begin
MagDB := MagDB + RefDB - 80.0 * Log10(k / RESP_MID);
if MagDB < RESP_FLOOR then MagDB := RESP_FLOOR;
FRespDB[k] := MagDB;
end;
end;
end;
function TEqualizerControl.ResponseAtFreq(AFreq: Double): Double;
// Значение готовой АЧХ на частоте: линейная интерполяция между центрами бинов.
var
Pos: Double;
K: Integer;
begin
if Length(FRespDB) <> RESP_MID then BuildResponse;
Pos := AFreq / RESP_BIN_HZ - 0.5;
if Pos <= 0.0 then
Result := FRespDB[0]
else if Pos >= RESP_MID - 1 then
Result := FRespDB[RESP_MID - 1]
else
begin
K := Trunc(Pos);
Result := FRespDB[K] + (Pos - K) * (FRespDB[K + 1] - FRespDB[K]);
end;
Result := Result + Sum;
Result := EnsureRange(Result, -24.0, 24.0);
end;
function TEqualizerControl.FormatFreq(AFreq: Double): string;
@@ -387,7 +494,10 @@ begin
Canvas.Brush.Style := bsClear;
Canvas.Font.Color := FClrTextDim;
S := FormatFreq(InternalBandFreq(i));
// Активные плитки подписаны рабочей частотой, погашенные — своим узлом
// сетки: иначе в 3-полосном режиме все семь показывали бы 6 кГц.
if i <= FBandCount then S := FormatFreq(InternalBandFreq(i))
else S := FormatFreq(GridBandFreq(i));
Canvas.TextOut(TR.Left + 6, TR.Top + 34, S);
Canvas.Font.Color := C;
Canvas.TextOut(TR.Left + 6, TR.Top + 49, FormatFloat('0.0', FGains[i]));
@@ -419,7 +529,6 @@ begin
B.ClrBorder := FButtonTheme.BtnBorderNorm;
B.ClrText := FButtonTheme.BtnText;
B.ClrTextAct := FButtonTheme.BtnTextActive;
B.Font.Name := 'Courier New';
B.Font.Size := 8;
B.Invalidate;
end;
@@ -527,6 +636,7 @@ begin
Canvas.Pen.Color := FClrBorder;
Canvas.Line(R.Left + 1, ZeroY, R.Right - 1, ZeroY);
BuildResponse; // кривая считается заново на каждую отрисовку (1024 бина)
Canvas.Brush.Color := TColor($00304438);
Canvas.Pen.Color := TColor($00304438);
FillBottom := ZeroY;
@@ -537,7 +647,9 @@ begin
begin
F := XToFreq(GX, R);
G := ResponseAtFreq(F);
GY := GainToY(EnsureRange(G, MIN_GAIN, MAX_GAIN), R);
// Клампа по ±15 дБ нет намеренно: за крайними точками WDSP обрывает АЧХ,
// и кривая обязана уходить в пол графика — иначе обрыв не виден.
GY := GainToY(G, R);
if GX = R.Left then
LastFillY := GY
else
@@ -547,13 +659,13 @@ begin
end;
PrevX := CurveL;
PrevY := GainToY(EnsureRange(ResponseAtFreq(XToFreq(CurveL, R)), MIN_GAIN, MAX_GAIN), R);
PrevY := GainToY(ResponseAtFreq(XToFreq(CurveL, R)), R);
Canvas.Pen.Color := FClrCurve;
Canvas.Pen.Width := 2;
for GX := CurveL + 1 to CurveR do
begin
F := XToFreq(GX, R);
GY := GainToY(EnsureRange(ResponseAtFreq(F), MIN_GAIN, MAX_GAIN), R);
GY := GainToY(ResponseAtFreq(F), R);
Canvas.Line(PrevX, PrevY, GX, GY);
PrevX := GX;
PrevY := GY;
@@ -621,7 +733,8 @@ begin
begin
FDragging := H;
BandGain[H] := YToGain(Y, GraphRect);
BandFreq[H] := XToFreq(X, GraphRect);
// В 3-полосном режиме частоты задаёт WDSP (EQ3_F) — двигаем только гейн.
if FBandCount <> 3 then BandFreq[H] := XToFreq(X, GraphRect);
end;
end;
end;
@@ -636,7 +749,7 @@ begin
else if FDragging > 0 then
begin
BandGain[FDragging] := YToGain(Y, GraphRect);
BandFreq[FDragging] := XToFreq(X, GraphRect);
if FBandCount <> 3 then BandFreq[FDragging] := XToFreq(X, GraphRect);
end
else
begin
FlatButton.pas
-1
View File
@@ -204,7 +204,6 @@ begin
Result.ClrBorder := ClrBorder;
Result.ClrText := ClrText;
Result.ClrTextAct := ClrTextAct;
Result.Font.Name := 'Courier New';
Result.Font.Size := 8;
Result.Font.Color := ClrText;
end;
FlatCheckBox.pas
-1
View File
@@ -77,7 +77,6 @@ begin
TabStop := True;
Cursor := crHandPoint;
Font.Name := 'Courier New';
Font.Size := 9;
FClrBG := TColor($00181818);
FlatComboBox.pas
-1
View File
@@ -272,7 +272,6 @@ begin
TabStop := True;
Cursor := crDefault;
Font.Name := 'Courier New';
Font.Size := 9;
FClrBG := TColor($001A1A1A);
FlatDropDown.pas
+35 -16
View File
@@ -18,7 +18,7 @@ unit FlatDropDown;
interface
uses
Classes, SysUtils, Controls, Graphics, ExtCtrls, FlatButton;
Classes, SysUtils, Controls, Graphics, ExtCtrls, Math, FlatButton;
type
TButtonStyleProc = procedure(B: TFlatButton; Active: Boolean) of object;
@@ -32,14 +32,17 @@ type
FItemBtns: array of TFlatButton;
FItemIndex: Integer;
FColumns: Integer;
FItemBtnH: Integer;
FItemBtnH96: Integer;
FRightInset96: Integer;
FIsOpen: Boolean;
FStyleProc: TButtonStyleProc;
FPanelColor: TColor;
FOnSelect: TDropDownSelectEvent;
procedure ItemClick(Sender: TObject);
procedure PositionPopup;
public
constructor Create(AAnchor: TFlatButton; APopupParent: TWinControl;
ACols, ABtnH: Integer);
ACols, ABtnH: Integer; ARightInset96: Integer = 0);
destructor Destroy; override;
procedure SetItems(const ANames: array of string);
procedure SetItemIndex(Idx: Integer);
@@ -54,19 +57,23 @@ type
implementation
constructor TFlatDropDown.Create(AAnchor: TFlatButton; APopupParent: TWinControl;
ACols, ABtnH: Integer);
ACols, ABtnH: Integer;
ARightInset96: Integer = 0);
begin
inherited Create;
FAnchor := AAnchor;
FPopupParent := APopupParent;
FColumns := ACols;
FItemBtnH := ABtnH;
FColumns := Max(1, ACols);
FItemBtnH96 := Max(1, ABtnH);
FRightInset96 := Max(0, ARightInset96);
FItemIndex := 0;
FIsOpen := False;
FStyleProc := nil;
FPanelColor := TColor($00181818);
FPopup := TPanel.Create(nil);
FPopup.Parent := APopupParent;
FPopup.BevelOuter := bvNone;
FPopup.Color := TColor($00181818);
FPopup.Color := FPanelColor;
FPopup.Visible := False;
end;
@@ -78,25 +85,34 @@ end;
procedure TFlatDropDown.SetItems(const ANames: array of string);
var
I, Count, BtnW, PopW: Integer;
I, Count, BtnW, PopW, ItemBtnH, EdgePad, ItemGap: Integer;
B: TFlatButton;
begin
while FPopup.ControlCount > 0 do
FPopup.Controls[0].Free;
Count := Length(ANames);
SetLength(FItemBtns, Count);
PopW := FPopupParent.ClientWidth;
BtnW := (PopW - 4) div FColumns;
// Popup может жить в контейнере с постоянно зарезервированным overlay-
// scrollbar gutter. Inset задаётся в 96-DPI координатах и пересчитывается
// при каждом наполнении: SetItems бывает и до, и после DPI-scale формы.
PopW := Max(1, FPopupParent.ClientWidth -
FPopupParent.Scale96ToForm(FRightInset96));
ItemBtnH := FPopupParent.Scale96ToForm(FItemBtnH96);
EdgePad := FPopupParent.Scale96ToForm(2);
ItemGap := FPopupParent.Scale96ToForm(2);
BtnW := Max(1, (PopW - 2 * EdgePad) div FColumns);
FPopup.SetBounds(0, 0, PopW,
((Count + FColumns - 1) div FColumns) * FItemBtnH);
((Count + FColumns - 1) div FColumns) * ItemBtnH);
for I := 0 to Count - 1 do
begin
B := MakeFlatBtn(FPopup, ANames[I],
2 + (I mod FColumns) * BtnW,
(I div FColumns) * FItemBtnH,
BtnW - 2, FItemBtnH, @ItemClick);
EdgePad + (I mod FColumns) * BtnW,
(I div FColumns) * ItemBtnH,
Max(1, BtnW - ItemGap), ItemBtnH, @ItemClick);
B.Tag := I;
B.Active := (I = FItemIndex);
if Assigned(FStyleProc) then
FStyleProc(B, B.Active);
FItemBtns[I] := B;
end;
end;
@@ -134,9 +150,10 @@ var
begin
P := FAnchor.ClientToScreen(Point(0, FAnchor.Height));
P := FPopupParent.ScreenToClient(P);
Y0 := P.Y + 2;
Y0 := P.Y + FPopupParent.Scale96ToForm(2);
if Y0 + FPopup.Height > FPopupParent.ClientHeight then
Y0 := P.Y - FAnchor.Height - FPopup.Height - 2;
Y0 := P.Y - FAnchor.Height - FPopup.Height -
FPopupParent.Scale96ToForm(2);
if Y0 < 0 then Y0 := 0;
FPopup.Top := Y0;
FPopup.Left := 0;
@@ -166,6 +183,8 @@ procedure TFlatDropDown.ApplyStyle(AStyleProc: TButtonStyleProc; APanelColor: TC
var
I: Integer;
begin
FStyleProc := AStyleProc;
FPanelColor := APanelColor;
FPopup.Color := APanelColor;
for I := 0 to High(FItemBtns) do
if FItemBtns[I] <> nil then
FlatEdit.pas
-1
View File
@@ -112,7 +112,6 @@ begin
FEditing := False;
FDragging := False;
Font.Name := 'Courier New';
Font.Size := 9;
FClrOuterBG := TColor($00181818);
FlatFloatSpinEdit.pas
-1
View File
@@ -127,7 +127,6 @@ begin
TabStop := True;
Cursor := crIBeam;
Font.Name := 'Courier New';
Font.Size := 9;
FMinValue := 0.0;
FlatListBox.pas
-1
View File
@@ -93,7 +93,6 @@ begin
TabStop := True;
Cursor := crDefault;
Font.Name := 'Courier New';
Font.Size := 8;
FClrOuterBG := TColor($00181818);
FlatMemo.pas
+279
View File
@@ -0,0 +1,279 @@
unit FlatMemo;
{
Read-only/editable memo с полностью управляемым оформлением и тонким
overlay-scrollbar. Внутри остаётся обычный TMemo, поэтому выделение,
клавиатура и копирование работают штатно на всех LCL widgetset.
}
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Math, Types,
Forms, Controls, Graphics, StdCtrls, ExtCtrls,
AppTheme, DpiUtils, OverlayScrollBar;
type
TFlatMemo = class(TCustomControl)
private
FMemo: TMemo;
FScrollHost: TPanel;
FScrollBar: TOverlayScrollBar;
FTheme: TAppTheme;
FSyncing: Boolean;
function GetLines: TStrings;
function GetReadOnly: Boolean;
procedure SetReadOnly(AValue: Boolean);
function GetWordWrap: Boolean;
procedure SetWordWrap(AValue: Boolean);
function GetSelStart: Integer;
procedure SetSelStart(AValue: Integer);
function GetText: string;
procedure SetText(const AValue: string);
procedure MemoChange(Sender: TObject);
procedure MemoKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure MemoMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MemoMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
procedure ScrollChanged(Sender: TObject);
procedure UpdateScrollBar;
procedure LayoutChildren;
protected
procedure Paint; override;
procedure Resize; override;
procedure FontChanged(Sender: TObject); override;
public
constructor Create(AOwner: TComponent); override;
procedure Append(const AValue: string);
procedure SetAppTheme(const T: TAppTheme);
procedure SyncScrollBar;
property Lines: TStrings read GetLines;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
property WordWrap: Boolean read GetWordWrap write SetWordWrap;
property SelStart: Integer read GetSelStart write SetSelStart;
property Text: string read GetText write SetText;
property Align;
property Anchors;
property BorderSpacing;
property Color;
property Font;
property Enabled;
property TabOrder;
property TabStop;
property Visible;
end;
implementation
constructor TFlatMemo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
Width := DpiScale(300);
Height := DpiScale(160);
FTheme := DarkTheme;
Color := FTheme.BG;
TabStop := False;
FMemo := TMemo.Create(Self);
FMemo.Parent := Self;
FMemo.Align := alClient;
FMemo.BorderSpacing.Around := 1;
FMemo.BorderStyle := bsNone;
FMemo.ScrollBars := ssVertical;
FMemo.WordWrap := False;
FMemo.ParentFont := True;
FMemo.Color := FTheme.BG;
FMemo.Font.Color := FTheme.Text;
FMemo.OnChange := @MemoChange;
FMemo.OnKeyUp := @MemoKeyUp;
FMemo.OnMouseUp := @MemoMouseUp;
FMemo.OnMouseWheel := @MemoMouseWheel;
// TPaintBox сам не может перекрыть оконный TMemo, поэтому scrollbar живёт
// внутри отдельного оконного TPanel, поднятого над нативной полосой.
FScrollHost := TPanel.Create(Self);
FScrollHost.Parent := Self;
FScrollHost.BevelOuter := bvNone;
FScrollHost.Color := FTheme.BG;
FScrollHost.OnMouseWheel := @MemoMouseWheel;
FScrollBar := TOverlayScrollBar.Create(Self);
FScrollBar.Parent := FScrollHost;
FScrollBar.Align := alClient;
FScrollBar.HoverTarget := Self;
FScrollBar.OnMouseWheel := @MemoMouseWheel;
FScrollBar.OnPositionChange := @ScrollChanged;
LayoutChildren;
SetAppTheme(FTheme);
end;
procedure TFlatMemo.Paint;
begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := FTheme.Border;
Canvas.FillRect(ClientRect);
end;
procedure TFlatMemo.Resize;
begin
inherited Resize;
LayoutChildren;
UpdateScrollBar;
end;
procedure TFlatMemo.FontChanged(Sender: TObject);
begin
inherited FontChanged(Sender);
if FMemo <> nil then
begin
FMemo.Font.Assign(Font);
UpdateScrollBar;
end;
end;
procedure TFlatMemo.LayoutChildren;
var
GutterW: Integer;
begin
if (FMemo = nil) or (FScrollHost = nil) then Exit;
GutterW := Max(DpiScale(8), FMemo.VertScrollBar.Size);
FScrollHost.SetBounds(Max(1, ClientWidth - GutterW - 1), 1,
GutterW, Max(0, ClientHeight - 2));
FScrollHost.BringToFront;
end;
procedure TFlatMemo.UpdateScrollBar;
var
MaxPos, Viewport: Integer;
begin
if FSyncing or (FMemo = nil) or (FScrollBar = nil) then Exit;
FSyncing := True;
try
MaxPos := Max(0, FMemo.VertScrollBar.Range - FMemo.VertScrollBar.Page);
Viewport := Max(1, FMemo.VertScrollBar.Page);
FScrollBar.SetRange(MaxPos, Viewport);
FScrollBar.Position := EnsureRange(FMemo.VertScrollBar.Position, 0, MaxPos);
LayoutChildren;
finally
FSyncing := False;
end;
end;
procedure TFlatMemo.SyncScrollBar;
begin
UpdateScrollBar;
end;
procedure TFlatMemo.ScrollChanged(Sender: TObject);
begin
if FSyncing or (FMemo = nil) or (FScrollBar = nil) then Exit;
FMemo.VertScrollBar.Position := FScrollBar.Position;
end;
procedure TFlatMemo.MemoMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
Step: Integer;
begin
UpdateScrollBar;
if (FScrollBar = nil) or (FScrollBar.Maximum <= 0) then Exit;
Step := Max(1, FMemo.VertScrollBar.Increment * 3);
if WheelDelta > 0 then FScrollBar.ScrollBy(-Step)
else if WheelDelta < 0 then FScrollBar.ScrollBy(Step);
Handled := WheelDelta <> 0;
end;
procedure TFlatMemo.MemoChange(Sender: TObject);
begin
UpdateScrollBar;
end;
procedure TFlatMemo.MemoKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
UpdateScrollBar;
end;
procedure TFlatMemo.MemoMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
UpdateScrollBar;
end;
function TFlatMemo.GetLines: TStrings;
begin
Result := FMemo.Lines;
end;
function TFlatMemo.GetReadOnly: Boolean;
begin
Result := FMemo.ReadOnly;
end;
procedure TFlatMemo.SetReadOnly(AValue: Boolean);
begin
FMemo.ReadOnly := AValue;
end;
function TFlatMemo.GetWordWrap: Boolean;
begin
Result := FMemo.WordWrap;
end;
procedure TFlatMemo.SetWordWrap(AValue: Boolean);
begin
FMemo.WordWrap := AValue;
UpdateScrollBar;
end;
function TFlatMemo.GetSelStart: Integer;
begin
Result := FMemo.SelStart;
end;
procedure TFlatMemo.SetSelStart(AValue: Integer);
begin
FMemo.SelStart := AValue;
UpdateScrollBar;
end;
function TFlatMemo.GetText: string;
begin
Result := FMemo.Text;
end;
procedure TFlatMemo.SetText(const AValue: string);
begin
FMemo.Text := AValue;
UpdateScrollBar;
end;
procedure TFlatMemo.Append(const AValue: string);
begin
FMemo.Append(AValue);
UpdateScrollBar;
end;
procedure TFlatMemo.SetAppTheme(const T: TAppTheme);
begin
FTheme := T;
Color := T.BG;
if FMemo <> nil then
begin
FMemo.Color := T.BG;
FMemo.Font.Color := T.Text;
end;
if FScrollHost <> nil then FScrollHost.Color := T.BG;
if FScrollBar <> nil then
FScrollBar.SetColors(T.BG, T.Border,
T.SliderThumbHot, T.SliderThumbDrag);
Invalidate;
end;
end.
FlatRadioButton.pas
-1
View File
@@ -78,7 +78,6 @@ begin
TabStop := True;
Cursor := crHandPoint;
Font.Name := 'Courier New';
Font.Size := 9;
FClrBG := TColor($00181818);
FlatSpinEdit.pas
-1
View File
@@ -121,7 +121,6 @@ begin
TabStop := True;
Cursor := crIBeam;
Font.Name := 'Courier New';
Font.Size := 9;
FMinValue := 0;
MainForm.lfm
-1
View File
@@ -7,7 +7,6 @@ object MainForm: TMainForm
Color = clBlack
Font.Color = clSilver
Font.Height = -13
Font.Name = 'Courier New'
Position = poDesigned
LCLVersion = '4.6.0.0'
OnClose = FormClose
MainForm.pas
+567 -138
View File
File diff suppressed because it is too large Load Diff
OverlayScrollBar.pas
+237
View File
@@ -0,0 +1,237 @@
unit OverlayScrollBar;
{
Тонкий вертикальный overlay-scrollbar без системного оформления.
Сам контрол всегда занимает зарезервированный gutter, но трек и бегунок
рисуются только при Max > 0 и наведении мыши на HoverTarget. Содержимое
контрол не двигает: владелец подписывается на OnPositionChange.
}
{$mode objfpc}{$H+}
interface
uses
Classes, Controls, ExtCtrls, Forms, Graphics, Math, Types, LCLType;
type
TOverlayScrollBar = class(TPaintBox)
private
FHoverTarget: TControl;
FMaximum: Integer;
FPosition: Integer;
FViewportSize: Integer;
FHover: Boolean;
FDragging: Boolean;
FDragY: Integer;
FDragPosition: Integer;
FBGColor: TColor;
FTrackColor: TColor;
FThumbColor: TColor;
FThumbDragColor: TColor;
FOnPositionChange: TNotifyEvent;
procedure AppUserInput(Sender: TObject; Msg: Cardinal);
procedure SetPosition(AValue: Integer);
function CursorOverTarget: Boolean;
function ThumbRect: TRect;
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetRange(AMaximum, AViewportSize: Integer);
procedure ScrollBy(ADelta: Integer);
procedure SetColors(ABG, ATrack, AThumb, AThumbDrag: TColor);
property HoverTarget: TControl read FHoverTarget write FHoverTarget;
property Maximum: Integer read FMaximum;
property Position: Integer read FPosition write SetPosition;
property OnPositionChange: TNotifyEvent
read FOnPositionChange write FOnPositionChange;
end;
implementation
constructor TOverlayScrollBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 8;
FMaximum := 0;
FPosition := 0;
FViewportSize := 0;
FHover := False;
FDragging := False;
FBGColor := TColor($00181818);
FTrackColor := TColor($00303030);
FThumbColor := TColor($00407040);
FThumbDragColor := TColor($00509050);
Application.AddOnUserInputHandler(@AppUserInput);
end;
destructor TOverlayScrollBar.Destroy;
begin
Application.RemoveOnUserInputHandler(@AppUserInput);
if GetCaptureControl = Self then SetCaptureControl(nil);
inherited Destroy;
end;
procedure TOverlayScrollBar.SetColors(ABG, ATrack, AThumb,
AThumbDrag: TColor);
begin
FBGColor := ABG;
FTrackColor := ATrack;
FThumbColor := AThumb;
FThumbDragColor := AThumbDrag;
Invalidate;
end;
procedure TOverlayScrollBar.SetRange(AMaximum, AViewportSize: Integer);
var
OldMaximum: Integer;
begin
OldMaximum := FMaximum;
FMaximum := Max(0, AMaximum);
FViewportSize := Max(0, AViewportSize);
if FPosition > FMaximum then
SetPosition(FMaximum)
else if OldMaximum <> FMaximum then
Invalidate;
end;
procedure TOverlayScrollBar.SetPosition(AValue: Integer);
var
NewValue: Integer;
begin
NewValue := EnsureRange(AValue, 0, FMaximum);
if NewValue = FPosition then Exit;
FPosition := NewValue;
if Assigned(FOnPositionChange) then FOnPositionChange(Self);
Invalidate;
end;
procedure TOverlayScrollBar.ScrollBy(ADelta: Integer);
begin
SetPosition(FPosition + ADelta);
end;
function TOverlayScrollBar.CursorOverTarget: Boolean;
var
P: TPoint;
begin
Result := False;
if (FHoverTarget = nil) or (not FHoverTarget.Visible) then Exit;
P := FHoverTarget.ScreenToClient(Mouse.CursorPos);
Result := (P.X >= 0) and (P.Y >= 0) and
(P.X < FHoverTarget.Width) and (P.Y < FHoverTarget.Height);
end;
procedure TOverlayScrollBar.AppUserInput(Sender: TObject; Msg: Cardinal);
var
NewHover: Boolean;
begin
NewHover := CursorOverTarget;
if NewHover = FHover then Exit;
FHover := NewHover;
Invalidate;
end;
function TOverlayScrollBar.ThumbRect: TRect;
var
TrackTop, TrackH, ThumbH, Travel, ContentH: Integer;
begin
Result := Rect(0, 0, 0, 0);
if (FMaximum <= 0) or (FViewportSize <= 0) then Exit;
TrackTop := Scale96ToForm(4);
TrackH := Height - 2 * TrackTop;
if TrackH <= 0 then Exit;
ContentH := FViewportSize + FMaximum;
ThumbH := Max(Scale96ToForm(28),
MulDiv(TrackH, FViewportSize, Max(1, ContentH)));
ThumbH := Min(ThumbH, TrackH);
Travel := TrackH - ThumbH;
Result.Left := Max(1, (Width - Scale96ToForm(4)) div 2);
Result.Right := Width - Result.Left;
Result.Top := TrackTop;
if (Travel > 0) and (FMaximum > 0) then
Inc(Result.Top, MulDiv(Travel, FPosition, FMaximum));
Result.Bottom := Result.Top + ThumbH;
end;
procedure TOverlayScrollBar.Paint;
var
R: TRect;
TrackX: Integer;
begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := FBGColor;
Canvas.FillRect(ClientRect);
if (FMaximum <= 0) or ((not FHover) and (not FDragging)) then Exit;
TrackX := Width div 2;
Canvas.Pen.Color := FTrackColor;
Canvas.Pen.Width := Max(1, Scale96ToForm(1));
Canvas.Line(TrackX, Scale96ToForm(4),
TrackX, Height - Scale96ToForm(4));
R := ThumbRect;
if IsRectEmpty(R) then Exit;
if FDragging then Canvas.Brush.Color := FThumbDragColor
else Canvas.Brush.Color := FThumbColor;
Canvas.Pen.Style := psClear;
Canvas.RoundRect(R.Left, R.Top, R.Right, R.Bottom,
Scale96ToForm(3), Scale96ToForm(3));
Canvas.Pen.Style := psSolid;
end;
procedure TOverlayScrollBar.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
R: TRect;
begin
inherited MouseDown(Button, Shift, X, Y);
if (Button <> mbLeft) or (FMaximum <= 0) then Exit;
R := ThumbRect;
if PtInRect(R, Point(X, Y)) then
begin
FDragging := True;
FDragY := Y;
FDragPosition := FPosition;
SetCaptureControl(Self);
end
else if Y < R.Top then
ScrollBy(-FViewportSize + Scale96ToForm(40))
else
ScrollBy(FViewportSize - Scale96ToForm(40));
Invalidate;
end;
procedure TOverlayScrollBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var
R: TRect;
TrackH, Travel: Integer;
begin
inherited MouseMove(Shift, X, Y);
if not FDragging then Exit;
R := ThumbRect;
TrackH := Height - 2 * Scale96ToForm(4);
Travel := TrackH - (R.Bottom - R.Top);
if Travel <= 0 then Exit;
SetPosition(FDragPosition + MulDiv(Y - FDragY, FMaximum, Travel));
end;
procedure TOverlayScrollBar.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if Button <> mbLeft then Exit;
FDragging := False;
if GetCaptureControl = Self then SetCaptureControl(nil);
Invalidate;
end;
end.
PanafallPanel.pas
+32
View File
@@ -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;
RadioController.pas
+368 -3
View File
@@ -80,6 +80,7 @@ type
rfFMDeviation, rfFMCTCSS, rfFMCTCSSTone, rfFMSQ, rfFMSQLevel,
rfFMStep, rfFMStepIdx, rfFMRpt,
rfChannel,
rfTXProfile, // сменился активный TX-профиль
rfSMeter, rfPower, rfSWR, rfSupply, rfPLL, // телеметрия
rfADCOverload, // ADC overload (рендер индикатора)
rfBeaconLock, // QO-100 beacon lock: статус/коррекция
@@ -177,6 +178,10 @@ type
InDeviceIndex: Integer; // PortAudio-индекс ввода (-1 = общий)
InDevName: string;
AudioIn: TAudioInput; // НЕ владеет: ссылка на поток из mic-пула
// TX-профиль слайса ПО РЕЖИМУ: индекс в FTXProfiles или -1 = «не
// переключать». Применяется, когда слайс становится TX-источником
// (SetTxSlice) и когда он меняет режим, будучи источником.
TXProfByMode: TTXProfModeTable;
DMR: TDMRSliceDecoder; // владеет; nil для не-DMR слайса
end;
@@ -424,6 +429,10 @@ type
// ---- Конфиги / устройство (per-MAC) ----
FTXSettings: TTXSettings;
// Именованные TX-профили («звуковая» часть FTXSettings + drive, см.
// TTXProfile). Истина для эфира — всегда живые FTXSettings/FDrivePercent;
// активный профиль ведётся за ними (StoreActiveTXProfile).
FTXProfiles: TTXProfileList;
FAlexSettings: TAlexSettings;
FOCSettings: TOCSettings; // OC Control (Open Collector, openHPSDR-only)
// Антенные разъёмы AD936x (Pluto/LibreSDR) на диапазон/трансвертер.
@@ -577,6 +586,36 @@ type
procedure ApplyTXSettingsToDSP; // TX-цепь (фильтр/gain/EQ/comp/...) → WDSP
function PSOutlierSigmaEff: Double; // σ outlier-фильтра calcc (авто по плате)
// ---- TX-профили --------------------------------------------------------
// Профиль — именованный снимок «звуковой» части TX-цепи (состав в
// TTXProfile). Отдельной кнопки «сохранить» нет: правки ручками пишутся в
// активный профиль сразу (StoreActiveTXProfile), как и всё остальное в
// EWSDR. Переключение применяет снимок в эфир немедленно.
function TXProfileCount: Integer;
function TXProfileName(Idx: Integer): string;
function ActiveTXProfile: Integer;
// Auto=True — переключение сделала автоматика привязок; ручной выбор
// (дропдаун, список настроек) дополнительно ЗАПОМИНАЕТСЯ за текущей парой
// «источник + модуляция» (BindTXProfileToCurrentMode).
procedure SelectTXProfile(Idx: Integer; Auto: Boolean = False);
procedure StoreActiveTXProfile(Persist: Boolean = False);
function AddTXProfile(const AName: string): Integer; // форк текущего звука
procedure RenameTXProfile(Idx: Integer; const AName: string);
procedure DeleteTXProfile(Idx: Integer);
procedure ResetTXProfilesToFactory; // заводской набор заново
// Профиль на TX-источник, ключ — режим этого флага (-1 = не переключать,
// звучит активный). Таблица у каждого флага своя: главный в FTXProfiles,
// слайсы в своих записях.
function FlagMode(SliceId: Integer): Integer;
procedure BindTXProfileToCurrentMode(Idx: Integer); // ручной выбор → в таблицу
function SliceTXProfile(SliceId: Integer): Integer;
procedure SetSliceTXProfile(SliceId, ProfIdx: Integer);
function SliceTXProfileTable(SliceId: Integer): TTXProfModeTable;
procedure SetSliceTXProfileTable(SliceId: Integer; const T: TTXProfModeTable);
procedure RemapTXProfileBindings(Deleted: Integer); // после удаления/замены списка
procedure ApplyBoundTXProfile; // профиль текущего TX-источника → в эфир
procedure SaveTXProfilesToConfig;
// ---- Управление диапазонами (состояние + DSP; рендер через события) ----
// MakeBandSettings — снимок текущего состояния в запись диапазона.
// SaveCurrentBand — сохраняет текущее состояние в кэш+конфиг (или в XVTR-слот).
@@ -2127,6 +2166,7 @@ begin
FSlices[slot].RxMuteOnTx := True; // себя на передаче по умолчанию не слышим
FSlices[slot].FMSQOn := False; // squelch по умолчанию выключен
FSlices[slot].FMSQLevel := 40;
ClearTXProfModeTable(FSlices[slot].TXProfByMode); // звучит активный профиль
FSlices[slot].NRMode := 0; // DSP слайса стартует выключенным
FSlices[slot].NBMode := 0;
FSlices[slot].SNB := False;
@@ -2201,6 +2241,8 @@ begin
// Этот слайс — источник передачи: передающий тракт идёт за его режимом
// (иначе после смены режима в эфир ушёл бы прежний вид модуляции). Вход FM
// RAW — внешний PCM, поэтому заодно пересматриваем источник модуляции.
// Профиль этого слайса в НОВОМ режиме — до пуша цепи (см. SetMode).
if (FTxSliceId = Id) and (Mode <> OldMode) then ApplyBoundTXProfile;
if (FTxSliceId = Id) and (Mode <> OldMode) and
FWDSPReady and Assigned(FDSPEngine) then
begin
@@ -2919,6 +2961,9 @@ begin
else if FTransmitting then SetMOX(False);
end;
FTxSliceId := SliceId;
// Профиль, привязанный к новому источнику, — ДО пуша режима и цепи: иначе
// ApplyTXSettingsToDSP внутри SelectTXProfile лёг бы на старый режим.
ApplyBoundTXProfile;
// Передающий тракт под режим нового источника (idle-канал, применится к PTT).
if FWDSPReady and Assigned(FDSPEngine) then
begin
@@ -3340,10 +3385,15 @@ begin
if FTuning then
begin
// Уровень настройки всегда идёт от глобального TUN Level — иначе ручка в
// Transmit в трансвертере оказывалась мёртвой. Мощность слота (если
// включена галка) работает МНОЖИТЕЛЕМ, ровно как для обычного drive ниже:
// это «сколько мощности трансиверa разрешено этому трансвертеру», и к
// настройке оно относится так же, как к передаче.
Pos := EnsureRange(FTXSettings.TUNLevel, 0, 100);
if XvtrActive and FXvtrSettings.UseXVTRTunePower then
Pos := EnsureRange(FXvtrSettings.Entries[FCurrentXvtr].TXPower, 0, 100)
else
Pos := EnsureRange(FTXSettings.TUNLevel, 0, 100);
Pos := Round(Pos * EnsureRange(FXvtrSettings.Entries[FCurrentXvtr].TXPower,
0, 100) / 100.0);
end
else
begin
@@ -3590,6 +3640,16 @@ begin
FFMRptOffsetHz := B.FMRptOffsetHz;
if FFMRptOffsetHz <= 0 then FFMRptOffsetHz := RptDefaultOffsetHz(B.VfoA);
// --- TX-профиль под новый режим ---
// Смена диапазона и вход/выход трансвертера меняют режим ГЛАВНОГО здесь, а
// не через SetMode, поэтому автоматику привязок надо звать и отсюда — иначе
// при переходе КВ↔трансвертер оставался профиль прошлого режима.
if FTxSliceId = 0 then ApplyBoundTXProfile;
// FDSPEngine.SetMode выше насильно выставил TXA в режим главного приёмника,
// но передавать можем со слайса — возвращаем режим настоящего источника.
if FWDSPReady and Assigned(FDSPEngine) and (ActiveTXMode <> FMode) then
FDSPEngine.SetTXMode(ActiveTXMode);
// --- CTUN ---
FCTun := B.CTun;
if FWDSPReady and Assigned(FDSPEngine) and not FCTun then FDSPEngine.SetShift(0.0);
@@ -3963,6 +4023,10 @@ begin
if Assigned(FDMRDec) then FDMRDec.SetEnabled(FMode = MODE_DMR);
ApplyModeDefaults; // дефолтный фильтр/девиация под режим
FBandCache[FCurrentBand].Mode := FMode;
// Профиль привязан к паре «флаг + модуляция»: если передаём с главного,
// новый режим приносит свой профиль. До пуша в WDSP — ApplyTXChainSettings
// внутри SetTXMode ниже перешьёт цепь уже с новыми значениями.
if FTxSliceId = 0 then ApplyBoundTXProfile;
if FWDSPReady and Assigned(FDSPEngine) then
begin
FDSPEngine.SetMode(FMode);
@@ -4222,6 +4286,10 @@ procedure TRadioController.SetDrive(V: Integer);
begin
if V < 0 then V := 0 else if V > 100 then V := 100;
FDrivePercent := V;
// Мощность входит в профиль: ведём её в активном без записи на диск (слайдер
// шлёт события пачками; на диск профили уходят на переключении/остановке).
if (FTXProfiles.ActiveIdx >= 0) and (FTXProfiles.ActiveIdx < FTXProfiles.Count) then
FTXProfiles.Items[FTXProfiles.ActiveIdx].DrivePercent := FDrivePercent;
FDriveLevel := CalcDriveByte;
ApplyWDSPDrive(FDrivePercent);
ApplyPlutoTxAtten; // Pluto: drive живьём меняет TX-аттенюацию во время передачи
@@ -4904,6 +4972,293 @@ begin
FNetwork.SendDUCSpecific(DUCPkt);
end;
// ---------------------------------------------------------------------------
// TX-профили
// ---------------------------------------------------------------------------
function TRadioController.TXProfileCount: Integer;
begin
Result := FTXProfiles.Count;
end;
function TRadioController.TXProfileName(Idx: Integer): string;
begin
if (Idx < 0) or (Idx >= FTXProfiles.Count) then Result := ''
else Result := FTXProfiles.Items[Idx].Name;
end;
function TRadioController.ActiveTXProfile: Integer;
begin
Result := FTXProfiles.ActiveIdx;
end;
procedure TRadioController.SaveTXProfilesToConfig;
begin
if (not FDevConnected) or (not Assigned(FSettings)) then Exit;
FSettings.SaveTXProfiles(FDevMAC, FTXProfiles);
FSettings.Save;
end;
procedure TRadioController.StoreActiveTXProfile(Persist: Boolean = False);
// Живое состояние → активный профиль. Зовётся на каждой правке TX-настроек и
// на смене drive; Persist=False не трогает диск (drive ездит слайдером).
var Idx: Integer;
begin
Idx := FTXProfiles.ActiveIdx;
if (Idx < 0) or (Idx >= FTXProfiles.Count) then Exit;
TXProfileCapture(FTXSettings, FDrivePercent, FTXProfiles.Items[Idx]);
if Persist then SaveTXProfilesToConfig;
end;
procedure TRadioController.SelectTXProfile(Idx: Integer; Auto: Boolean);
var
OldMic: Byte;
NewDrive: Integer;
begin
if (Idx < 0) or (Idx >= FTXProfiles.Count) then Exit;
// Уходящий профиль дописываем живыми значениями — ручные правки не теряются.
StoreActiveTXProfile;
OldMic := BuildMicLineSelectByte;
NewDrive := FDrivePercent;
FTXProfiles.ActiveIdx := Idx;
TXProfileApply(FTXProfiles.Items[Idx], FTXSettings, NewDrive);
ApplyTXSettingsToDSP;
// Маршрутизация микрофона живёт в железе (DUC Specific byte 50) — при смене
// Mic In/Line In/boost/bias пакет надо перепослать, WDSP тут ни при чём.
if BuildMicLineSelectByte <> OldMic then SendDUCSpecificFromSettings;
// SetDrive пересчитает калиброванный байт, толкнёт WDSP/Pluto и HP-кадр;
// зовём безусловно — при активном TUN уровень берётся из TUNLevel профиля.
SetDrive(NewDrive);
if FTuning and FWDSPReady then
FDSPEngine.SetDriveLevel(EnsureRange(FTXSettings.TUNLevel, 0, 100) / 100.0);
// ★Ручной выбор ЗАПОМИНАЕТСЯ за парой «источник передачи + его модуляция» —
// это и есть обещанное «профиль помнится по виду модуляции». Без этого в
// таблице оказывалось только то, что назначено пилюлей во флаге, а профиль,
// выбранный дропдауном в блоке TX, нигде не оставался следа.
if not Auto then BindTXProfileToCurrentMode(Idx);
if FDevConnected and Assigned(FSettings) then
begin
FSettings.SaveTX(FDevMAC, FTXSettings);
FSettings.SaveTXProfiles(FDevMAC, FTXProfiles);
FSettings.Save;
end;
Changed(rfTXProfile);
end;
function TRadioController.AddTXProfile(const AName: string): Integer;
// Форк: новый профиль = текущий звук под новым именем, он же становится активным.
begin
Result := -1;
if FTXProfiles.Count >= TXPROF_MAX then Exit;
Result := FTXProfiles.Count;
TXProfileCapture(FTXSettings, FDrivePercent, FTXProfiles.Items[Result]);
FTXProfiles.Items[Result].Name := Copy(Trim(AName), 1, 31);
if FTXProfiles.Items[Result].Name = '' then
FTXProfiles.Items[Result].Name := 'Profile ' + IntToStr(Result + 1);
Inc(FTXProfiles.Count);
FTXProfiles.ActiveIdx := Result;
SaveTXProfilesToConfig;
Changed(rfTXProfile);
end;
procedure TRadioController.RenameTXProfile(Idx: Integer; const AName: string);
var S: string;
begin
if (Idx < 0) or (Idx >= FTXProfiles.Count) then Exit;
S := Copy(Trim(AName), 1, 31);
if S = '' then Exit;
FTXProfiles.Items[Idx].Name := S;
SaveTXProfilesToConfig;
Changed(rfTXProfile);
end;
procedure TRadioController.DeleteTXProfile(Idx: Integer);
// Последний профиль не удаляем: список без активного элемента сломал бы
// авто-сохранение (StoreActiveTXProfile писать некуда).
var i: Integer;
begin
if (Idx < 0) or (Idx >= FTXProfiles.Count) or (FTXProfiles.Count <= 1) then Exit;
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
// Удалили активный: встаём на соседний и применяем его в эфир. ActiveIdx
// гасим — иначе StoreActiveTXProfile внутри Select затрёт соседа живым
// звуком удалённого профиля.
FTXProfiles.ActiveIdx := -1;
SelectTXProfile(EnsureRange(Idx, 0, FTXProfiles.Count - 1));
Exit; // SelectTXProfile уже сохранил и отрендерил
end;
SaveTXProfilesToConfig;
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, m: Integer;
begin
for m := 0 to CFG_MODE_MAX do Fix(FTXProfiles.MainByMode[m]);
for i := 0 to High(FSlices) do
if FSlices[i].Active then
for m := 0 to CFG_MODE_MAX do Fix(FSlices[i].TXProfByMode[m]);
end;
procedure TRadioController.BindTXProfileToCurrentMode(Idx: Integer);
// Пишет профиль в ячейку «текущий TX-источник + его модуляция». Отдельно от
// SetSliceTXProfile: там ещё и применение в эфир, а здесь профиль уже применён
// (нас зовут из SelectTXProfile), повторный ApplyBoundTXProfile был бы циклом.
var m, Slot: Integer;
begin
if (Idx < 0) or (Idx >= FTXProfiles.Count) then Exit;
m := FlagMode(FTxSliceId);
if FTxSliceId <= 0 then
FTXProfiles.MainByMode[m] := Idx // персист — общим блоком в SelectTXProfile
else
begin
Slot := FindSliceIndex(FTxSliceId);
if Slot >= 0 then FSlices[Slot].TXProfByMode[m] := Idx;
end;
end;
function TRadioController.FlagMode(SliceId: Integer): Integer;
// Режим, в котором сейчас стоит этот флаг: у главного — FMode, у слайса — свой.
var idx: Integer;
begin
Result := FMode;
if SliceId > 0 then
begin
idx := FindSliceIndex(SliceId);
if idx >= 0 then Result := FSlices[idx].Mode;
end;
Result := EnsureRange(Result, 0, CFG_MODE_MAX);
end;
function TRadioController.SliceTXProfile(SliceId: Integer): Integer;
// Привязка «этот источник передачи В ЭТОМ РЕЖИМЕ → этот профиль».
// -1 = не переключать. Ключ — режим самого флага, поэтому смена модуляции
// сама достаёт профиль, с которым в этом виде работали в прошлый раз.
var idx: Integer;
begin
Result := -1;
if SliceId <= 0 then
Result := FTXProfiles.MainByMode[FlagMode(SliceId)]
else
begin
idx := FindSliceIndex(SliceId);
if idx >= 0 then Result := FSlices[idx].TXProfByMode[FlagMode(SliceId)];
end;
if (Result < 0) or (Result >= FTXProfiles.Count) then Result := -1;
end;
procedure TRadioController.SetSliceTXProfile(SliceId, ProfIdx: Integer);
// Пишем в ячейку ТЕКУЩЕГО режима этого флага: выбор запоминается за модуляцией.
var idx, m: Integer;
begin
if (ProfIdx < -1) or (ProfIdx >= FTXProfiles.Count) then ProfIdx := -1;
m := FlagMode(SliceId);
if SliceId <= 0 then
begin
if FTXProfiles.MainByMode[m] = ProfIdx then Exit;
FTXProfiles.MainByMode[m] := ProfIdx;
SaveTXProfilesToConfig;
end
else
begin
idx := FindSliceIndex(SliceId);
if (idx < 0) or (FSlices[idx].TXProfByMode[m] = ProfIdx) then Exit;
FSlices[idx].TXProfByMode[m] := ProfIdx;
// Персист слайсов делает MainForm на общем сохранении панов — здесь только
// состояние. Привязку главного пишем сразу: она живёт в секции профилей.
end;
// Привязали источник, который передаёт прямо сейчас, — применяем немедленно,
// иначе профиль подхватился бы только при следующей смене TX-источника.
if SliceId = FTxSliceId then ApplyBoundTXProfile;
Changed(rfTXProfile);
end;
procedure TRadioController.SetSliceTXProfileTable(SliceId: Integer;
const T: TTXProfModeTable);
// Восстановление сохранённой таблицы целиком (персист слайсов/панов).
var idx, m: Integer;
begin
if SliceId <= 0 then
begin
FTXProfiles.MainByMode := T;
Exit;
end;
idx := FindSliceIndex(SliceId);
if idx < 0 then Exit;
for m := 0 to CFG_MODE_MAX do
if (T[m] >= 0) and (T[m] < FTXProfiles.Count) then
FSlices[idx].TXProfByMode[m] := T[m]
else
FSlices[idx].TXProfByMode[m] := -1;
end;
function TRadioController.SliceTXProfileTable(SliceId: Integer): TTXProfModeTable;
var idx: Integer;
begin
ClearTXProfModeTable(Result);
if SliceId <= 0 then Result := FTXProfiles.MainByMode
else
begin
idx := FindSliceIndex(SliceId);
if idx >= 0 then Result := FSlices[idx].TXProfByMode;
end;
end;
procedure TRadioController.ApplyBoundTXProfile;
// Активный профиль ОДНОЗНАЧНО определяется парой «TX-источник + его модуляция»:
// ячейка таблицы заполнена → её профиль;
// ячейка пуста (−1) → базовый профиль (первый в списке).
// Фолбэк обязателен: без него профиль прошлого режима оставался висеть в новом
// (симптом «перешёл из FM в USB, а звучит FM»). Правило детерминированное —
// работает и после перезапуска, в отличие от «вернуть, что было до автоматики».
var P, M: Integer;
begin
if FTXProfiles.Count = 0 then Exit;
M := FlagMode(FTxSliceId);
// В DMR передатчика нет, в FM RAW профиль ни на что не влияет
// (ApplyTXModeSettings глушит там всю обработку) — активный не трогаем вовсе,
// иначе заход в эти режимы молча перебивал бы выбор оператора.
if (M = MODE_DMR) or (M = MODE_FMRAW) then Exit;
P := SliceTXProfile(FTxSliceId);
if P < 0 then P := 0;
if P <> FTXProfiles.ActiveIdx then SelectTXProfile(P, True);
end;
procedure TRadioController.ResetTXProfilesToFactory;
// Пересобирает заводской набор поверх текущего списка. База — ЖИВЫЕ настройки,
// поэтому «Default» = микрофонный вход, полоса, динамика и мощность как сейчас,
// но с заводским (ровным) EQ. Единственный способ доехать до обновлённых
// заводских профилей с уже записанной секцией tx_profiles: она читается, а не
// пересоздаётся.
begin
DefaultTXProfiles(FTXSettings, FDrivePercent, FTXProfiles);
RemapTXProfileBindings(-1); // список другой — старые привязки бессмысленны
// ActiveIdx гасим перед Select: иначе StoreActiveTXProfile внутри него
// впишет в свежий «Default» живой EQ и сброс тембра тут же отменится.
FTXProfiles.ActiveIdx := -1;
// Применяем «Default» в эфир — иначе живой EQ остался бы кривым, а профиль
// говорил бы «ровный», и первая же правка TX-настроек вернула бы кривую.
SelectTXProfile(0); // сам сохранит и отрендерит
end;
procedure TRadioController.ApplyTXSettingsToDSP;
begin
if not FWDSPReady then Exit;
@@ -5847,6 +6202,12 @@ begin
// drive% (0..100) — раньше грузился через TrkDrive.Position; теперь напрямую,
// слайдер выставит rfDevice-рендер. Калиброванный байт считаем после FCurrentBand.
FDrivePercent := EnsureRange(FLoadedGlobal.DriveLevel, 0, 100);
// TX-профили. Секции нет (конфиг до этой версии) — строим заводской набор из
// ТЕКУЩИХ настроек: «Default» повторяет их один в один, звук после
// обновления не меняется. Активный профиль на старте не применяем — живая
// секция "tx" уже хранит последнее состояние, оно и есть истина.
if not FSettings.LoadTXProfiles(FDevMAC, FTXProfiles) then
DefaultTXProfiles(FTXSettings, FDrivePercent, FTXProfiles);
// Клампим LastBand — иначе битый/старый конфиг → RestoreBand выйдет по гарду,
// а последующие SetMode/SetFilterIdx запишут в FBandCache[невалид] за массив.
FCurrentBand := EnsureRange(FLoadedGlobal.LastBand, 0, CFG_BAND_COUNT - 1);
@@ -5999,6 +6360,10 @@ begin
FSettings.SaveAnt936x(FDevMAC, FAnt936x);
FSettings.SaveOC(FDevMAC, FOCSettings);
FSettings.SaveFilters(FDevMAC, FFilterTable);
// Активный TX-профиль дописываем живыми значениями (drive/громкость микро-
// фона ездят мимо диалога настроек) и пишем список целиком.
StoreActiveTXProfile;
FSettings.SaveTXProfiles(FDevMAC, FTXProfiles);
// XVTR LastFreq → актуальная видимая частота в момент остановки.
if (FCurrentXvtr >= 0) and (FCurrentXvtr < CFG_XVTR_COUNT) then
FXvtrSettings.Entries[FCurrentXvtr].LastFreq := FVfoA;
SampleRateOverlay.pas
+45 -24
View File
@@ -13,7 +13,7 @@ unit SampleRateOverlay;
interface
uses
Classes, SysUtils, Controls, Graphics, Types, Math;
Classes, SysUtils, Controls, Graphics, Types, Math, AppTheme;
type
TSpanSelectEvent = procedure(SampleRate: Integer) of object;
@@ -35,6 +35,7 @@ type
FTop: Integer;
FWidth: Integer;
FHeight: Integer;
FTheme: TAppTheme;
FHitRects: array[0..10] of TRect; // [0]=hide button, [1..]=span buttons
FHitValues: array[0..10] of Integer; // 0=hide, else sample rate
@@ -76,6 +77,7 @@ type
procedure SetRatePresets(const Rates: array of Integer);
procedure SetRatePresetsDefault; // HPSDR 48k..1536k
procedure SetPanelHidden(Hidden: Boolean);
procedure SetTheme(const T: TAppTheme);
property Left: Integer read FLeft;
property Top: Integer read FTop;
property Width: Integer read FWidth;
@@ -97,9 +99,6 @@ const
PAD_Y = 4;
BTN_GAP = 3;
CLR_TEXT = TColor($00D8E6EE);
CLR_BTN_BDR = TColor($00685624);
procedure BlendRect(Target: TBitmap; const Rct: TRect; R, G, B, Alpha: Byte);
var
Y, X, InvA: Integer;
@@ -141,6 +140,16 @@ begin
end;
end;
procedure BlendColorRect(Target: TBitmap; const Rct: TRect;
Color: TColor; Alpha: Byte);
var
C: LongInt;
begin
C := ColorToRGB(Color);
BlendRect(Target, Rct, C and $FF, (C shr 8) and $FF,
(C shr 16) and $FF, Alpha);
end;
function SpanBtnWidth(const Name: string; C: TCanvas): Integer;
begin
C.Font.Name := 'Courier New';
@@ -160,6 +169,7 @@ begin
FHotIdx := -1;
FWidth := 320;
FHeight := SPAN_H + PAD_Y * 2;
FTheme := DarkTheme;
FCache := TBitmap.Create;
FCache.PixelFormat := pf32bit;
FCacheW := 0;
@@ -224,30 +234,34 @@ begin
if ContentW > W then ContentW := W;
FullR := Rect(OriginX, OriginY, OriginX + ContentW, OriginY + H);
BlendRect(Target, FullR, $14, $14, $14, 104);
BlendRect(Target, Rect(FullR.Left, FullR.Top, FullR.Right, FullR.Top + 1),
$80, $80, $80, 56);
BlendRect(Target, Rect(FullR.Left, FullR.Bottom - 1, FullR.Right, FullR.Bottom),
$00, $00, $00, 48);
BlendRect(Target, Rect(FullR.Left, FullR.Top, FullR.Left + 1, FullR.Bottom),
$80, $80, $80, 42);
BlendRect(Target, Rect(FullR.Right - 1, FullR.Top, FullR.Right, FullR.Bottom),
$00, $00, $00, 42);
BlendColorRect(Target, FullR, FTheme.Panel, 210);
BlendColorRect(Target,
Rect(FullR.Left, FullR.Top, FullR.Right, FullR.Top + 1),
FTheme.Border, 150);
BlendColorRect(Target,
Rect(FullR.Left, FullR.Bottom - 1, FullR.Right, FullR.Bottom),
FTheme.Border, 120);
BlendColorRect(Target,
Rect(FullR.Left, FullR.Top, FullR.Left + 1, FullR.Bottom),
FTheme.Border, 120);
BlendColorRect(Target,
Rect(FullR.Right - 1, FullR.Top, FullR.Right, FullR.Bottom),
FTheme.Border, 120);
X := OriginX + PAD_X;
HR := Rect(X, OriginY + PAD_Y, X + HIDE_W, OriginY + PAD_Y + SPAN_H);
IsHot := FHotIdx = 0;
if IsHot then BlendRect(Target, HR, $1D, $4B, $62, 206)
else BlendRect(Target, HR, $18, $3F, $54, 182);
if IsHot then BlendColorRect(Target, HR, FTheme.SpanActive, 230)
else BlendColorRect(Target, HR, FTheme.SpanNorm, 215);
C.Pen.Style := psSolid;
C.Pen.Color := CLR_BTN_BDR;
C.Pen.Color := FTheme.SpanBorder;
C.Brush.Style := bsClear;
C.Rectangle(HR);
C.Font.Size := 8;
if FPanelHidden then Cap := '>' else Cap := '<';
TW := C.TextWidth(Cap);
C.Font.Color := CLR_TEXT;
C.Font.Color := FTheme.SpanText;
C.Brush.Style := bsClear;
C.TextOut(HR.Left + (HIDE_W - TW) div 2,
HR.Top + (SPAN_H - TH) div 2, Cap);
@@ -262,16 +276,16 @@ begin
IsAct := FRates[I] = FCurrentRate;
IsHot := FHotIdx = I + 1;
if IsAct then BlendRect(Target, HR, $20, $5A, $78, 220)
else if IsHot then BlendRect(Target, HR, $1D, $4B, $62, 206)
else BlendRect(Target, HR, $18, $3F, $54, 182);
if IsAct then BlendColorRect(Target, HR, FTheme.SpanActive, 240)
else if IsHot then BlendColorRect(Target, HR, FTheme.SpanActive, 230)
else BlendColorRect(Target, HR, FTheme.SpanNorm, 215);
C.Pen.Style := psSolid;
C.Pen.Color := CLR_BTN_BDR;
C.Pen.Color := FTheme.SpanBorder;
C.Brush.Style := bsClear;
C.Rectangle(HR);
TW := C.TextWidth(FNames[I]);
C.Font.Color := CLR_TEXT;
C.Font.Color := FTheme.SpanText;
C.Brush.Style := bsClear;
C.TextOut(HR.Left + (BtnW - TW) div 2,
HR.Top + (SPAN_H - TH) div 2, FNames[I]);
@@ -470,7 +484,7 @@ begin
ContentW := Min(ContentW, W);
Target.SetSize(ContentW, H);
Target.Canvas.Brush.Color := TColor($00141414);
Target.Canvas.Brush.Color := FTheme.Panel;
Target.Canvas.Brush.Style := bsSolid;
Target.Canvas.Pen.Style := psClear;
Target.Canvas.FillRect(Rect(0, 0, ContentW, H));
@@ -480,7 +494,7 @@ begin
try
HitTarget.PixelFormat := pf32bit;
HitTarget.SetSize(Max(1, FLeft + ContentW), Max(1, FTop + H));
HitTarget.Canvas.Brush.Color := TColor($00141414);
HitTarget.Canvas.Brush.Color := FTheme.Panel;
HitTarget.Canvas.FillRect(Rect(0, 0, HitTarget.Width, HitTarget.Height));
DrawSelf(HitTarget, HitTarget.Canvas, FLeft, FTop, ContentW, H);
finally
@@ -575,4 +589,11 @@ begin
RequestInvalidate;
end;
procedure TSampleRateOverlay.SetTheme(const T: TAppTheme);
begin
FTheme := T;
FCacheDirty := True;
RequestInvalidate;
end;
end.
Settings.pas
+468 -7
View File
@@ -28,6 +28,7 @@ const
CFG_PANS_MAX = 4; // потолок панадаптеров (пан 0 + доп.) — = WDSPEngine.MAX_PANS
CFG_CAT_SLICE_COUNT = 6; // слотов доп. слайсов (B..G) — = WDSPEngine.MAX_SLICES
CFG_CAT_SLICE_PORT0 = 19091; // порт слайса B по умолчанию (главный — 19090)
TXPROF_MAX = 16; // потолок именованных TX-профилей на устройство
QO100_SLOT = CFG_XVTR_COUNT - 1; // последний слот зарезервирован под QO-100
// (split-LO транспондер; настраивается на
// отдельной странице, не в общей XVTR-таблице)
@@ -163,6 +164,10 @@ type
// Персист панадаптеров и слайсов (секция "pans" под MAC). Восстанавливается
// один раз при выходе в Run. Слайс = приёмный WDSP-канал внутри пана; частоты
// абсолютные (видимые). См. [[project_slices_plan]].
// Привязка «режим → индекс TX-профиля» (-1 = не переключать). Такая таблица
// есть у каждого флага: у главного в TTXProfileList, у слайса в TSliceCfg.
TTXProfModeTable = array[0..CFG_MODE_MAX] of Integer;
TSliceCfg = record
TargetHz: Double; // абсолютная видимая частота слайса
Mode: Integer;
@@ -176,6 +181,9 @@ type
FMSQLevel: Integer;
DevName: string; // имя PortAudio-устройства вывода ('' = default)
InDevName: string; // имя устройства ВВОДА слайса ('' = общий вход)
// TX-профиль слайса ПО РЕЖИМУ: -1 = какой активен, тот и звучит. Таблица,
// а не одно значение: слайс на FT8 и слайс голосом помнят каждый своё.
TXProfByMode: TTXProfModeTable;
end;
TPanCfg = record
@@ -298,6 +306,65 @@ type
// (Orion MkII → 5.0, иначе выкл.), 0 = выкл.
end;
// ---- TX-профили (именованные снимки «как я звучу») ----------------------
// Профиль хранит ТОЛЬКО то, что определяет звук в эфире: маршрутизацию
// микрофонного входа, усиление, кромки TX-фильтра, динамическую обработку,
// эквалайзер, уровень несущей AM и мощность. Всё остальное из TTXSettings
// (FIR-длина/фаза/окно фильтра, ATT on TX, FM/CTCSS, параметры анализатора
// и сетки, калибровка PureSignal) — свойство устройства, от профиля НЕ
// зависит: переключение профиля не должно перерисовывать спектр, менять
// задержку тракта или ломать калибровку PS.
// Разбиение — по образцу таблицы TXProfile у Thetis (database.cs), но без
// её хвоста из VAC/DSP-буферов, которых у нас нет.
TTXProfile = record
Name: string[31];
// Микрофонный вход (гарнитура / микшер-ESSB — физически разные входы)
MicLineIn: Boolean;
MicBoost: Boolean;
MicPTTEnabled: Boolean;
MicTipRing: Boolean;
MicBias: Boolean;
LineInGainDB: Double;
MicGainDB: Double;
// Кромки TX-фильтра (FIR-длина/фаза/окно остаются у устройства)
FilterLow: Integer;
FilterHigh: Integer;
// Динамическая обработка
CompressorOn: Boolean;
CompressorGain: Double;
LevelerOn: Boolean;
LevelerTop: Double;
LevelerDecay: Integer;
ALCOn: Boolean;
ALCMaxGain: Double;
ALCDecay: Integer;
PhaseRotOn: Boolean;
PhaseRotStages: Integer;
PhaseRotFreq: Double;
// Эквалайзер
EQOn: Boolean;
EQNumBands: Integer;
EQGains: array[0..10] of Double;
EQFreqs: array[0..10] of Double;
// Модуляция AM (несущая — часть «звука», в отличие от девиации FM)
AMCarrierLevel: Double;
// Мощность (Thetis держит Power/Tune_Power в профиле)
DrivePercent: Integer; // 0..100
TUNLevel: Integer; // 0..100
end;
TTXProfileList = record
Count: Integer;
ActiveIdx: Integer;
// Привязка профиля к ГЛАВНОМУ приёмнику (слайс A) ПО РЕЖИМУ; -1 = ничего
// не переключать. У слайсов B..G своя такая же в TSliceCfg.TXProfByMode.
// Таблица главного одна на устройство — общая для КВ и трансвертера
// (решение пользователя); у слайсов она сама разъезжается по контекстам,
// потому что их записи хранятся отдельно для КВ и трансвертера.
MainByMode: TTXProfModeTable;
Items: array[0..TXPROF_MAX-1] of TTXProfile;
end;
// Web-сервер — глобальные настройки (не привязаны к устройству, секция "web").
TWebSettings = record
Enabled: Boolean;
@@ -625,8 +692,30 @@ type
// только режимы, отличающиеся от заводских, — конфиг не пухнет.
function LoadFilters(const MAC: array of Byte; out T: TFilterTable): Boolean;
procedure SaveFilters(const MAC: array of Byte; const T: TFilterTable);
// TX-профили per-device (JSON-секция "tx_profiles" под MAC). LoadTXProfiles
// возвращает False, если секции ещё нет: вызывающий строит заводской набор
// из текущих TX-настроек (DefaultTXProfiles) — миграция старого конфига.
function LoadTXProfiles(const MAC: array of Byte; out L: TTXProfileList): Boolean;
procedure SaveTXProfiles(const MAC: array of Byte; const L: TTXProfileList);
end;
// ---- TX-профили ------------------------------------------------------------
// Снимок «звуковых» полей живых настроек в профиль (имя не трогается) и
// обратное применение. Единственные две точки, знающие состав профиля, —
// добавляя поле в TTXProfile, правь обе.
procedure TXProfileCapture(const T: TTXSettings; DrivePct: Integer; var P: TTXProfile);
procedure TXProfileApply(const P: TTXProfile; var T: TTXSettings; var DrivePct: Integer);
// Заводской набор профилей. Base — текущие настройки устройства: из них
// наследуются микрофонный вход, мощность и всё, что профиль не переопределяет
// (иначе переключение на «ESSB» сбрасывало бы Mic In/Line In и drive).
procedure DefaultTXProfiles(const Base: TTXSettings; DrivePct: Integer;
out L: TTXProfileList);
// Таблица «режим → профиль» ↔ JSON-массив. Все элементы вне 0..TXPROF_MAX-1
// читаются как -1 («не переключать»), поэтому чужой/старый конфиг безопасен.
procedure ClearTXProfModeTable(var T: TTXProfModeTable);
function ModeTableToJSON(const T: TTXProfModeTable): TJSONArray;
procedure JSONToModeTable(Node: TJSONData; var T: TTXProfModeTable);
// Сколько пресетов реально есть у режима (VAR1/VAR2 идут сверх этого числа).
function FilterPresetCount(Mode: Integer): Integer;
// Заводской индекс фильтра режима.
@@ -1465,6 +1554,14 @@ begin
end;
end;
const
// Заводская 10-полосная голосовая сетка EQ (Hz). [0]=слот преампа (частота
// не используется), [1..10]=узлы кривой. Подобрано под голос, а не под
// музыку: больше точек в 100..3500 Hz. Нужна и DefaultTX, и заводским
// профилям (сброс тембра в ноль), поэтому живёт на уровне модуля.
DEF_EQ_FREQS: array[0..10] of Double = (
0, 100, 200, 400, 700, 1100, 1500, 2000, 2500, 3000, 3500);
// ---------------------------------------------------------------------------
// TX settings (per-device, JSON-секция "tx" под MAC)
// ---------------------------------------------------------------------------
@@ -1472,12 +1569,6 @@ end;
class procedure TSettingsManager.DefaultTX(out T: TTXSettings);
var
i: Integer;
const
// 10-полосный голосовой EQ (Hz). [0]=preamp slot, [1..10]=bands.
// Подобрано под голос, а не под музыку: больше точек в 100..3500 Hz.
DefaultEQFreqs: array[0..10] of Double = (
0, // [0] preamp slot — частота не используется
100, 200, 400, 700, 1100, 1500, 2000, 2500, 3000, 3500);
begin
FillChar(T, SizeOf(T), 0);
T.MicLineIn := False;
@@ -1519,7 +1610,7 @@ begin
for i := 0 to 10 do
begin
T.EQGains[i] := 0.0;
T.EQFreqs[i] := DefaultEQFreqs[i];
T.EQFreqs[i] := DEF_EQ_FREQS[i];
end;
// AM
T.AMCarrierLevel := 0.5;
@@ -1715,6 +1806,372 @@ begin
JW(O,'ps_outlier_sigma',T.PSOutlierSigma);
end;
// ---------------------------------------------------------------------------
// TX-профили: снимок/применение + заводской набор + персист
// ---------------------------------------------------------------------------
procedure TXProfileCapture(const T: TTXSettings; DrivePct: Integer; var P: TTXProfile);
var i: Integer;
begin
P.MicLineIn := T.MicLineIn;
P.MicBoost := T.MicBoost;
P.MicPTTEnabled := T.MicPTTEnabled;
P.MicTipRing := T.MicTipRing;
P.MicBias := T.MicBias;
P.LineInGainDB := T.LineInGainDB;
P.MicGainDB := T.MicGainDB;
P.FilterLow := T.FilterLow;
P.FilterHigh := T.FilterHigh;
P.CompressorOn := T.CompressorOn;
P.CompressorGain := T.CompressorGain;
P.LevelerOn := T.LevelerOn;
P.LevelerTop := T.LevelerTop;
P.LevelerDecay := T.LevelerDecay;
P.ALCOn := T.ALCOn;
P.ALCMaxGain := T.ALCMaxGain;
P.ALCDecay := T.ALCDecay;
P.PhaseRotOn := T.PhaseRotOn;
P.PhaseRotStages := T.PhaseRotStages;
P.PhaseRotFreq := T.PhaseRotFreq;
P.EQOn := T.EQOn;
P.EQNumBands := T.EQNumBands;
for i := 0 to 10 do
begin
P.EQGains[i] := T.EQGains[i];
P.EQFreqs[i] := T.EQFreqs[i];
end;
P.AMCarrierLevel := T.AMCarrierLevel;
P.DrivePercent := EnsureRange(DrivePct, 0, 100);
P.TUNLevel := EnsureRange(T.TUNLevel, 0, 100);
end;
procedure TXProfileApply(const P: TTXProfile; var T: TTXSettings; var DrivePct: Integer);
var i: Integer;
begin
T.MicLineIn := P.MicLineIn;
T.MicBoost := P.MicBoost;
T.MicPTTEnabled := P.MicPTTEnabled;
T.MicTipRing := P.MicTipRing;
T.MicBias := P.MicBias;
T.LineInGainDB := EnsureRange(P.LineInGainDB, -34.5, 12.0);
T.MicGainDB := P.MicGainDB;
T.FilterLow := P.FilterLow;
T.FilterHigh := P.FilterHigh;
T.CompressorOn := P.CompressorOn;
T.CompressorGain := P.CompressorGain;
T.LevelerOn := P.LevelerOn;
T.LevelerTop := P.LevelerTop;
T.LevelerDecay := P.LevelerDecay;
T.ALCOn := P.ALCOn;
T.ALCMaxGain := P.ALCMaxGain;
T.ALCDecay := P.ALCDecay;
T.PhaseRotOn := P.PhaseRotOn;
T.PhaseRotStages := P.PhaseRotStages;
T.PhaseRotFreq := P.PhaseRotFreq;
T.EQOn := P.EQOn;
T.EQNumBands := P.EQNumBands;
for i := 0 to 10 do
begin
T.EQGains[i] := P.EQGains[i];
T.EQFreqs[i] := P.EQFreqs[i];
end;
T.AMCarrierLevel := P.AMCarrierLevel;
T.TUNLevel := EnsureRange(P.TUNLevel, 0, 100);
DrivePct := EnsureRange(P.DrivePercent, 0, 100);
end;
procedure ClearTXProfModeTable(var T: TTXProfModeTable);
var i: Integer;
begin
for i := 0 to CFG_MODE_MAX do T[i] := -1;
end;
function ModeTableToJSON(const T: TTXProfModeTable): TJSONArray;
var i: Integer;
begin
Result := TJSONArray.Create;
for i := 0 to CFG_MODE_MAX do Result.Add(T[i]);
end;
procedure JSONToModeTable(Node: TJSONData; var T: TTXProfModeTable);
var
Arr: TJSONArray;
i, V: Integer;
begin
ClearTXProfModeTable(T);
if not (Node is TJSONArray) then Exit;
Arr := TJSONArray(Node);
for i := 0 to Min(CFG_MODE_MAX, Arr.Count - 1) do
begin
V := Arr.Integers[i];
if (V >= 0) and (V < TXPROF_MAX) then T[i] := V;
end;
end;
procedure DefaultTXProfiles(const Base: TTXSettings; DrivePct: Integer;
out L: TTXProfileList);
var
// Заводской звук + ЖИВАЯ обвязка микрофона. Всё, что определяет тембр
// (полоса, динамика, EQ, AM carrier, TUN level), берётся из DefaultTX:
// «сброс к заводским» обязан сбрасывать именно это, иначе Default наследует
// ту полосу, на которой оператора застали (например 5000 от ESSB 5k).
// Не сбрасываем то, что описывает ЖЕЛЕЗО и безопасность: разъём и режим
// микрофона с его усилением (иначе слетит Line In у микшера) и мощность
// (внезапный скачок drive пошёл бы в усилитель).
Stock: TTXSettings;
const
// Кривые EQ для заводских ESSB. Значения — УЗЛЫ ломаной АЧХ WDSP (eq.c),
// а не «полосы»: между узлами интерполяция по дБ, а ЗА крайними узлами
// ctfmode=0 обрывает АЧХ на нет. Отсюда железное правило, по которому
// подобраны частоты: нижний узел ≤ FilterLow, верхний ≥ FilterHigh, иначе
// включённый EQ сам срежет полосу, ради которой ESSB и включают.
// Форма: срез бубнения снизу, ровная середина, мягкий подъём присутствия
// к верху. Преамп в минус — EQ стоит ДО компрессора и ALC, и плюсовые
// гейны иначе просто загоняют ALC в ограничение.
ESSB35_F: array[1..10] of Double = (100, 160, 250, 400, 700, 1200, 1800, 2500, 3100, 3600);
ESSB35_G: array[1..10] of Double = ( -6, -4, -2, 0, 0, 1, 2, 3, 4, 4);
ESSB35_PRE = -2.0;
ESSB50_F: array[1..10] of Double = (100, 180, 300, 550, 950, 1600, 2400, 3300, 4200, 5100);
ESSB50_G: array[1..10] of Double = ( -5, -3, -1, 0, 0, 1, 2, 3.5, 5, 5);
ESSB50_PRE = -3.0;
// FM: узлы охватывают AF-полосу модулятора (штатно 300..3000, вкладка
// Hardware), крайние с запасом — за ними EQ обрывает АЧХ. Верх НЕ поднимаем:
// предыскажение (pre-emphasis) само задирает его 6 дБ/окт и по умолчанию
// стоит ПОСЛЕ динамики (xemphp вторым, сразу перед xfmmod), то есть
// компрессор его уже не удержит — лишний буст ушёл бы в перемодуляцию на
// свистящих. Снизу режем бубнение, лёгкий подъём разборчивости 1.4..2.3 кГц.
FM_F: array[1..10] of Double = (200, 300, 450, 700, 1000, 1400, 1800, 2300, 2800, 3400);
FM_G: array[1..10] of Double = ( -8, -4, -1, 0, 0, 1, 2, 2, 1, -2);
FM_PRE = -1.0;
// Тембр у заводского профиля — заводской: EQ выключен, все усиления и
// преамп в нуле, сетка узлов штатная. Наследовать сюда живой EQ нельзя —
// иначе «сброс к заводским» не сбрасывал бы то, ради чего его жмут.
procedure FlatEQ(var P: TTXProfile);
var i: Integer;
begin
P.EQOn := False;
P.EQNumBands := 10;
for i := 0 to 10 do
begin
P.EQGains[i] := 0.0;
P.EQFreqs[i] := DEF_EQ_FREQS[i];
end;
end;
procedure Add(const AName: string; ALow, AHigh: Integer;
AComp: Boolean; ACompGain: Double);
begin
if L.Count >= TXPROF_MAX then Exit;
TXProfileCapture(Stock, DrivePct, L.Items[L.Count]);
L.Items[L.Count].Name := AName;
L.Items[L.Count].FilterLow := ALow;
L.Items[L.Count].FilterHigh := AHigh;
L.Items[L.Count].CompressorOn := AComp;
L.Items[L.Count].CompressorGain := ACompGain;
FlatEQ(L.Items[L.Count]);
Inc(L.Count);
end;
// То же плюс своя кривая EQ: у ESSB тембр — часть профиля, наследовать
// сетку 100..3500 от текущих настроек здесь нельзя (см. правило выше).
procedure AddEQ(const AName: string; ALow, AHigh: Integer;
AComp: Boolean; ACompGain: Double;
const AF, AG: array of Double; APreamp: Double);
var
i, Before: Integer;
begin
Before := L.Count;
Add(AName, ALow, AHigh, AComp, ACompGain);
if L.Count = Before then Exit; // упёрлись в TXPROF_MAX — ничего не добавлено
with L.Items[L.Count - 1] do
begin
EQOn := True;
EQNumBands := 10;
EQFreqs[0] := 0.0; // слот преампа — частота не используется
EQGains[0] := APreamp;
for i := 1 to 10 do
begin
EQFreqs[i] := AF[i - 1];
EQGains[i] := AG[i - 1];
end;
end;
end;
begin
FillChar(L, SizeOf(L), 0);
L.Count := 0;
L.ActiveIdx := 0;
ClearTXProfModeTable(L.MainByMode); // главный ничего не переключает
// База всех заводских профилей: заводской звук, живая обвязка микрофона.
TSettingsManager.DefaultTX(Stock);
Stock.MicLineIn := Base.MicLineIn;
Stock.MicBoost := Base.MicBoost;
Stock.MicBias := Base.MicBias;
Stock.MicPTTEnabled := Base.MicPTTEnabled;
Stock.MicTipRing := Base.MicTipRing;
Stock.LineInGainDB := Base.LineInGainDB;
Stock.MicGainDB := Base.MicGainDB;
// «Default» — ровно заводской звук: полоса 200..3100, компрессор выкл,
// leveler/ALC как в DefaultTX, EQ ровный.
TXProfileCapture(Stock, DrivePct, L.Items[0]);
L.Items[0].Name := 'Default';
FlatEQ(L.Items[0]);
L.Count := 1;
// SSB-профили отличаются от Default только полосой и компрессором;
// микрофонный вход и мощность наследуются, EQ у всех троих заводской-ровный.
// ESSB несут ещё и свою кривую: без неё «широкий» профиль звучит тем же
// телефонным тембром, а с чужой сеткой (верхний узел 3500) EQ обрезал бы
// верх ESSB 5k.
Add('SSB DX', 300, 2700, True, 8.0);
Add('SSB Wide', 200, 3100, False, 5.0);
AddEQ('ESSB 3.5k', 100, 3500, False, 5.0, ESSB35_F, ESSB35_G, ESSB35_PRE);
AddEQ('ESSB 5k', 100, 5000, False, 5.0, ESSB50_F, ESSB50_G, ESSB50_PRE);
// FM: плотная модуляция за счёт компрессора — девиация ограничена жёстко,
// поэтому громкость даёт средний уровень, а не пики. Полоса 300..3000 здесь
// косметическая: в FM края bp0 считает сам движок по Карсону (девиация +
// AF-срез), профильные значения работают, только если привязать этот профиль
// к голосовому режиму. Девиация и AF-срез — свойства аппарата (вкладка
// Hardware), профилем не переключаются.
AddEQ('FM', 300, 3000, True, 8.0, FM_F, FM_G, FM_PRE);
end;
function TSettingsManager.LoadTXProfiles(const MAC: array of Byte;
out L: TTXProfileList): Boolean;
var
MacStr: string;
DevObj, Root, O: TJSONObject;
Node: TJSONData;
Arr: TJSONArray;
BaseTX: TTXSettings;
DefP: TTXProfile;
i, j: Integer;
begin
FillChar(L, SizeOf(L), 0);
L.Count := 0;
L.ActiveIdx := 0;
ClearTXProfModeTable(L.MainByMode);
Result := False;
MacStr := MacToStr(MAC);
if FRoot.Find(MacStr) = nil then Exit;
DevObj := GetDevObj(MacStr);
if DevObj.Find('tx_profiles') = nil then Exit;
Root := EnsureObj(DevObj, 'tx_profiles');
Node := Root.Find('list');
if not (Node is TJSONArray) then Exit;
Arr := TJSONArray(Node);
// Заводской профиль как источник значений по умолчанию для отсутствующих
// ключей: конфиг, записанный старой версией, дочитывается без дыр.
DefaultTX(BaseTX);
TXProfileCapture(BaseTX, 50, DefP);
DefP.Name := 'Profile';
for i := 0 to Arr.Count - 1 do
begin
if L.Count >= TXPROF_MAX then Break;
if not (Arr.Items[i] is TJSONObject) then Continue;
O := TJSONObject(Arr.Items[i]);
L.Items[L.Count] := DefP;
with L.Items[L.Count] do
begin
Name := Copy(JS(O,'name', DefP.Name), 1, 31);
MicLineIn := JB(O,'mic_line_in', MicLineIn);
MicBoost := JB(O,'mic_boost', MicBoost);
MicPTTEnabled := JB(O,'mic_ptt', MicPTTEnabled);
MicTipRing := JB(O,'mic_tip_ring', MicTipRing);
MicBias := JB(O,'mic_bias', MicBias);
LineInGainDB := EnsureRange(JD(O,'line_in_gain_db', LineInGainDB), -34.5, 12.0);
MicGainDB := JD(O,'mic_gain_db', MicGainDB);
FilterLow := JI(O,'filter_low', FilterLow);
FilterHigh := JI(O,'filter_high', FilterHigh);
CompressorOn := JB(O,'comp_on', CompressorOn);
CompressorGain := JD(O,'comp_gain', CompressorGain);
LevelerOn := JB(O,'lev_on', LevelerOn);
LevelerTop := JD(O,'lev_top', LevelerTop);
LevelerDecay := JI(O,'lev_decay', LevelerDecay);
ALCOn := JB(O,'alc_on', ALCOn);
ALCMaxGain := JD(O,'alc_max_gain', ALCMaxGain);
ALCDecay := JI(O,'alc_decay', ALCDecay);
PhaseRotOn := JB(O,'phr_on', PhaseRotOn);
PhaseRotStages := JI(O,'phr_stages', PhaseRotStages);
PhaseRotFreq := JD(O,'phr_freq', PhaseRotFreq);
EQOn := JB(O,'eq_on', EQOn);
EQNumBands := JI(O,'eq_bands', EQNumBands);
for j := 0 to 10 do
begin
EQGains[j] := JD(O,'eq_g_'+IntToStr(j), EQGains[j]);
EQFreqs[j] := JD(O,'eq_f_'+IntToStr(j), EQFreqs[j]);
end;
AMCarrierLevel := JD(O,'am_carrier', AMCarrierLevel);
DrivePercent := EnsureRange(JI(O,'drive', DrivePercent), 0, 100);
TUNLevel := EnsureRange(JI(O,'tun_level', TUNLevel), 0, 100);
if Name = '' then Name := 'Profile ' + IntToStr(L.Count + 1);
end;
Inc(L.Count);
end;
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;
JSONToModeTable(Root.Find('main_prof_modes'), L.MainByMode);
for i := 0 to CFG_MODE_MAX do
if L.MainByMode[i] >= L.Count then L.MainByMode[i] := -1;
Result := True;
end;
procedure TSettingsManager.SaveTXProfiles(const MAC: array of Byte;
const L: TTXProfileList);
var
Root, O: TJSONObject;
Arr: TJSONArray;
i, j, Idx: Integer;
begin
Root := EnsureObj(GetDevObj(MacToStr(MAC)), 'tx_profiles');
JW(Root, 'active', EnsureRange(L.ActiveIdx, 0, Max(0, L.Count - 1)));
Idx := Root.IndexOfName('main_prof_modes');
if Idx >= 0 then Root.Delete(Idx);
Root.Add('main_prof_modes', ModeTableToJSON(L.MainByMode));
// Список пересоздаётся целиком: удаление профиля не должно оставлять хвост.
Idx := Root.IndexOfName('list');
if Idx >= 0 then Root.Delete(Idx);
Arr := TJSONArray.Create;
Root.Add('list', Arr);
for i := 0 to L.Count - 1 do
begin
O := TJSONObject.Create;
Arr.Add(O);
JWS(O,'name', L.Items[i].Name);
JW(O,'mic_line_in', L.Items[i].MicLineIn);
JW(O,'mic_boost', L.Items[i].MicBoost);
JW(O,'mic_ptt', L.Items[i].MicPTTEnabled);
JW(O,'mic_tip_ring', L.Items[i].MicTipRing);
JW(O,'mic_bias', L.Items[i].MicBias);
JW(O,'line_in_gain_db', L.Items[i].LineInGainDB);
JW(O,'mic_gain_db', L.Items[i].MicGainDB);
JW(O,'filter_low', L.Items[i].FilterLow);
JW(O,'filter_high', L.Items[i].FilterHigh);
JW(O,'comp_on', L.Items[i].CompressorOn);
JW(O,'comp_gain', L.Items[i].CompressorGain);
JW(O,'lev_on', L.Items[i].LevelerOn);
JW(O,'lev_top', L.Items[i].LevelerTop);
JW(O,'lev_decay', L.Items[i].LevelerDecay);
JW(O,'alc_on', L.Items[i].ALCOn);
JW(O,'alc_max_gain', L.Items[i].ALCMaxGain);
JW(O,'alc_decay', L.Items[i].ALCDecay);
JW(O,'phr_on', L.Items[i].PhaseRotOn);
JW(O,'phr_stages', L.Items[i].PhaseRotStages);
JW(O,'phr_freq', L.Items[i].PhaseRotFreq);
JW(O,'eq_on', L.Items[i].EQOn);
JW(O,'eq_bands', L.Items[i].EQNumBands);
for j := 0 to 10 do
begin
JW(O,'eq_g_'+IntToStr(j), L.Items[i].EQGains[j]);
JW(O,'eq_f_'+IntToStr(j), L.Items[i].EQFreqs[j]);
end;
JW(O,'am_carrier', L.Items[i].AMCarrierLevel);
JW(O,'drive', L.Items[i].DrivePercent);
JW(O,'tun_level', L.Items[i].TUNLevel);
end;
end;
class procedure TSettingsManager.DefaultAlex(out A: TAlexSettings);
var i: Integer;
begin
@@ -2362,6 +2819,8 @@ 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_prof_modes',
ModeTableToJSON(P.Pans[i].Slices[j].TXProfByMode));
end;
end;
end;
@@ -2442,6 +2901,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', '');
JSONToModeTable(SliceObj.Find('tx_prof_modes'),
P.Pans[id].Slices[n].TXProfByMode);
end;
end;
end;
SettingsForm.pas
+966 -529
View File
File diff suppressed because it is too large Load Diff
StatusBar.pas
-1
View File
@@ -84,7 +84,6 @@ begin
FLabels[Index].Alignment := taLeftJustify;
FLabels[Index].Layout := tlCenter;
FLabels[Index].Caption := Cap;
FLabels[Index].Font.Name := 'Courier New';
FLabels[Index].Font.Size := 8;
end;
VfoOverlay.pas
+256 -41
View File
@@ -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, TxtY, TriY: 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,50 @@ 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);
TxtY := R.Top + (HDR_BADGE_H - C.TextHeight('A')) div 2;
C.TextOut(R.Left + 4, TxtY, PStr);
// Треугольник «список» справа — рисуем, а не пишем: в Courier New
// юникодных стрелок может не оказаться. Центрируем не по прямоугольнику
// текста, а по САМИМ буквам: TextHeight включает выносные элементы, а в
// подписи одни заглавные, они сидят в верхней части бокса — иначе
// треугольник визуально проваливается ниже надписи.
TriY := TxtY + C.TextHeight('A') div 2 - 2;
C.Brush.Color := C.Font.Color; C.Brush.Style := bsSolid;
C.Pen.Color := C.Font.Color;
Tri3[0] := Point(R.Right - 9, TriY - 2);
Tri3[1] := Point(R.Right - 3, TriY - 2);
Tri3[2] := Point(R.Right - 6, TriY + 2);
C.Polygon(Tri3);
C.Font.Size := 8;
RegisterHit(R, HIT_TXPROF);
end;
Inc(CurY, HDR_H);
{ --- Метр: индикаторы + сигнал-бар --- }
@@ -1259,6 +1437,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 +1518,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 +1545,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 +1730,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 +1845,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;
WDSPEngine.pas
+70 -22
View File
@@ -78,6 +78,10 @@ const
WFM_AF_HIGH = 15000.0;
WFM_TAU_DE_US = 50.0e-6; // Европа/Россия (Америка — 75 мкс)
DMR_DEVIATION = 2500.0;
// FM RAW: плоский baseband для внешних декодеров — одна величина на RX-AF,
// TX-AF и bp0 (раньше 20/7000 стояли числами в трёх местах).
RAW_AF_LOW = 20.0;
RAW_AF_HIGH = 7000.0;
// Потолок dsp_rate для WFM. Вещательному каналу (200 кГц) хватает 192 кГц,
// а гнать цепь на полном IQ-rate нельзя: при 576 кГц dsp_size стал бы 12288,
// и fircore спланировал бы FFT на 2*12288 = 24576 точек. Это не степень
@@ -554,6 +558,7 @@ type
procedure ProcessTXBlock; // вызывается из TTXDSPThread
procedure FeedTXDisplaySample(const I, Q: Double);
procedure ApplyTXChainSettings; // прокидывает все FTX* поля в WDSP
procedure PushTXEQProfile; // кривая EQ в WDSP (узлы + legacy 3 полосы)
procedure ApplyPSParams; // прокидывает FPS*-параметры в WDSP calcc
procedure ApplyRXAnalyzerSettings; // применяет RX FFT/Window/Det/Avg к RX_DISP_ID
procedure ApplyTXAnalyzerSettings; // применяет TX FFT/Window/Det/Avg к TX_DISP_ID
@@ -1166,7 +1171,7 @@ procedure TWDSPEngine.ApplyRXRawToChan(Chan: Integer);
begin
// Decoder-grade discriminator: no broadcast de-emphasis or limiter.
SetRXAWFMDeviation (Chan, FRawFMDeviation);
SetRXAWFMAFFilter (Chan, 20.0, 7000.0);
SetRXAWFMAFFilter (Chan, RAW_AF_LOW, RAW_AF_HIGH);
SetRXAWFMDeemphRun (Chan, 0);
SetRXAWFMLimRun (Chan, 0);
end;
@@ -1220,7 +1225,7 @@ begin
// Плоский baseband для внешних декодеров (совпадает с RX AF в ApplyRXRawToChan
// и с явным SetTXABandpassFreqs в ApplyTXModeSettings). РЧ-ширина FILT_RAW_BW
// (6..25 кГц) — селективность RX, к аудио-полосовику отношения не имеет.
begin Lo := 20.0; Hi := 7000.0; end;
begin Lo := RAW_AF_LOW; Hi := RAW_AF_HIGH; end;
else
begin Lo := L; Hi := H; end; // прочее — как есть
end;
@@ -1235,9 +1240,9 @@ begin
// selected peak deviation. Keep only a broad linear-phase AF bandpass;
// APRS and other external modems must not see voice EQ, dynamics or emphasis.
SetTXAWFMDeviation (TXA_CHAN, FRawFMDeviation);
SetTXAWFMAFFreqs (TXA_CHAN, 20.0, 7000.0);
SetTXAWFMAFFreqs (TXA_CHAN, RAW_AF_LOW, RAW_AF_HIGH);
SetTXAWFMPreEmphRun (TXA_CHAN, 0);
SetTXABandpassFreqs (TXA_CHAN, 20.0, 7000.0);
SetTXABandpassFreqs (TXA_CHAN, RAW_AF_LOW, RAW_AF_HIGH);
SetTXAPanelGain1 (TXA_CHAN, 1.0);
SetTXACompressorRun (TXA_CHAN, 0);
SetTXALevelerSt (TXA_CHAN, 0);
@@ -3542,8 +3547,6 @@ procedure TWDSPEngine.ApplyTXChainSettings;
// Вызывается после OpenChannel(TXA) и при старте TX. Прокидывает все
// FTX*-поля в WDSP. Идемпотентна, ничего не меняет если канал не открыт.
var
i: Integer;
Gains, Freqs, Qs: array[0..10] of Double;
BpLo, BpHi: Double;
begin
if not FInitialized then Exit;
@@ -3584,15 +3587,8 @@ begin
SetTXAPHROTNstages(TXA_CHAN, FTXPhaseRotStages);
SetTXAPHROTCorner(TXA_CHAN, FTXPhaseRotFreq);
// EQ TX (10-band: [0]=preamp, [1..10]=bands)
for i := 0 to 10 do
begin
Gains[i] := FTXEQGains[i];
Freqs[i] := FTXEQFreqs[i];
Qs[i] := 0.707; // умолчание Q
end;
SetTXAEQProfile(TXA_CHAN, FTXEQNumBands, @Freqs[0], @Gains[0]);
SetTXAEQRun(TXA_CHAN, Ord(FTXEQOn));
// EQ TX ([0]=preamp, [1..10]=точки кривой)
PushTXEQProfile;
// AM
SetTXAAMCarrierLevel(TXA_CHAN, FTXAMCarrier);
@@ -3723,8 +3719,27 @@ begin
end;
procedure TWDSPEngine.TXFilterEdgesHz(out Lo, Hi: Integer);
var L, H: Double;
// ЭКРАННЫЕ кромки — занимаемая полоса вокруг несущей, а НЕ bp0. У SSB/CW/DIGI/
// AM/DSB это одно и то же, поэтому здесь и стояла обёртка над TXSignedEdges.
// Но у ЧМ bp0 — АУДИО-полосовик ПЕРЕД модулятором: у FM RAW он (20..7000), у
// WFM (20..15000), и полоса на спектре уезжала вверх от несущей — визуально
// «переключалась на USB». Для ЧМ считаем по Карсону: ±(девиация + верхний срез
// аудио), симметрично несущей. У MODE_FM TXSignedEdges отдаёт ровно эту
// величину и без нас (порт Thetis), но пусть формула будет в одном месте.
var L, H, Half: Double;
begin
Half := 0.0;
case FTXMode of
MODE_FM: Half := FTXFMDeviation + FTXFMHighCut;
MODE_WFM: Half := WFM_DEVIATION + WFM_AF_HIGH;
MODE_FMRAW: Half := FRawFMDeviation + RAW_AF_HIGH;
end;
if Half > 0.0 then
begin
Lo := -Round(Half);
Hi := Round(Half);
Exit;
end;
TXSignedEdges(FTXMode, L, H);
Lo := Round(L);
Hi := Round(H);
@@ -3791,11 +3806,48 @@ begin
SetTXAPHROTRun(TXA_CHAN, Ord(Enable));
end;
procedure TWDSPEngine.PushTXEQProfile;
// Единственная точка, отдающая кривую EQ в WDSP.
// F[1..n] — УЗЛЫ ломаной АЧХ (eq.c/eq_impulse), между ними интерполяция по
// децибелам, а за крайними узлами при ctfmode=0 (так создаётся eqp в TXA.c)
// идёт кумулятивный скат (f/f0)^4 на бин — фактически обрыв. Поэтому:
// • 10 полос — узлы берём из профиля как есть (за краями обязан быть запас,
// см. заводские ESSB-профили в Settings.DefaultTXProfiles);
// • 3 полосы — legacy-раскладка самого WDSP (SetTXAGrphEQ): 150/400/1500/
// 6000, ручка Low держит полку 150..400, High тянет до 6 кГц. Отдавать
// здесь первые три узла 10-полосной сетки (100/200/400) нельзя — весь
// голос выше 400 Гц ушёл бы в ноль.
var
F, G: array[0..10] of Double;
i, NF: Integer;
begin
if not FInitialized then Exit;
if FTXEQNumBands = 3 then
begin
NF := 4;
F[0] := 0.0; G[0] := FTXEQGains[0]; // preamp
F[1] := 150.0; G[1] := FTXEQGains[1]; // Low
F[2] := 400.0; G[2] := FTXEQGains[1];
F[3] := 1500.0; G[3] := FTXEQGains[2]; // Mid
F[4] := 6000.0; G[4] := FTXEQGains[3]; // High
end
else
begin
NF := 10;
for i := 0 to 10 do
begin
F[i] := FTXEQFreqs[i];
G[i] := FTXEQGains[i];
end;
end;
SetTXAEQProfile(TXA_CHAN, NF, @F[0], @G[0]);
SetTXAEQRun(TXA_CHAN, Ord(FTXEQOn));
end;
procedure TWDSPEngine.SetTXEQ(Enable: Boolean; NumBands: Integer;
const Gains, Freqs: array of Double);
var
i, n: Integer;
G, F: array[0..10] of Double;
begin
FTXEQOn := Enable;
FTXEQNumBands := NumBands;
@@ -3804,12 +3856,8 @@ begin
begin
FTXEQGains[i] := Gains[i];
FTXEQFreqs[i] := Freqs[i];
G[i] := Gains[i];
F[i] := Freqs[i];
end;
if not FInitialized then Exit;
SetTXAEQProfile(TXA_CHAN, NumBands, @F[0], @G[0]);
SetTXAEQRun(TXA_CHAN, Ord(Enable));
PushTXEQProfile;
end;
procedure TWDSPEngine.SetTXAMCarrierLevel(Level: Double);