mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:37:33 +00:00
feat(dxcluster): споты DX-кластера на панадаптере
Telnet-клиент DX-кластера, база спотов и подписи позывных прямо на спектре на своих частотах. Разложено на три слоя, как бэндплан и лупа маяка. DXClusterClient.pas — один рабочий поток: резолв, неблокирующий connect с select квантами по 200 мс (Stop не ждёт таймаут соединения), логин позывным, чтение строк, реконнект с backoff. Приглашения логина И пароля ловятся в незавершённом хвосте буфера — типичный telnet-prompt приходит без CR/LF. Ошибки recv отличаются от таймаута кванта (EAGAIN/EINTR/WSAETIMEDOUT), иначе на ECONNRESET поток крутился бы в пустом цикле вместо реконнекта. Отправка дописывает частичный send. LCL-free. DXSpotStore.pas — потокобезопасная база: дедуп по позывному, TTL, потолок записей, монотонный Version. Единственная точка обмена потока с UI: никакого Synchronize, UI сам замечает правки по Version, как оверлеи — по ключам кэша. DXSpotOverlay.pas — рендер по модели BandPlanOverlay/VfoOverlay: кэшируется только полоса подписей (W × BandH) в key-color битмап, пересборка строго по dirty-ключу, на кадр — один keyed-композит. Штрихи от полосы до низа спектра рисует вызывающая сторона теми же примитивами, что и прочие маркеры: CPU — RawVLine внутри RawBegin/RawEnd, GL — DrawLine по готовому списку X/цвет. GL берёт тот же битмап текстурой и заливает её только при смене RenderVersion. Пересекающиеся подписи раскладываются лесенкой, цвет гаснет с возрастом, свой позывной выделен; палитра парная под тёмную и светлую тему. DXClusterForm.pas — окно списка: споты, лог соединения, строка команды кластеру (диалект set/filter у всех свой — не угадываем). Двойной клик или Enter = QSY. Данные тянутся поллингом по Version/LogVersion. Интеграция: кнопка DX в тулбаре (ЛКМ — подписи на спектре, ПКМ — окно), клик по подписи спота = QSY с автовыбором моды по комментарию кластера, страница SETUP → DX Cluster с персистом в секции "dxcluster". Правки SETUP прилетают посимвольно, поэтому запись конфига, TTL стора и переподключение откладываются до паузы в наборе — иначе набор позывного стоил бы шесть реконнектов, а промежуточный TTL «3» необратимо выбросил бы споты. Частота спота кладётся как есть и сравнивается с GetViewWindow: на QO-100 кластеры постят downlink 10489.xxx, что совпадает со шкалой пана само собой. Побочно в общих юнитах: WebUtils.SockSetRcvTimeout, FlatMemo.OnChange, FlatListBox.OnKeyDown, BlendBitmapKey вынесен в interface VfoOverlay (одна копия дворд-блендера на проект). Проверено на локальном фейковом кластере: логин и пароль по prompt без CR/LF, разбор спотов (включая QO-100), уход в RETRY по RST, Stop за 200 мс на висящем connect. На железе рендер не проверялся. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Claude Opus 5
@@ -0,0 +1,883 @@
|
|||||||
|
unit DXClusterClient;
|
||||||
|
|
||||||
|
{
|
||||||
|
DXClusterClient.pas — telnet-клиент DX-кластера (одно соединение).
|
||||||
|
|
||||||
|
Один рабочий поток: резолв → connect (неблокирующий + select, чтобы не висеть
|
||||||
|
минуту на мёртвом хосте) → логин позывным → чтение строк. Разобранные споты
|
||||||
|
кладутся ПРЯМО в TDXSpotStore (он потокобезопасен), лог соединения — во
|
||||||
|
внутреннее кольцо. В главный поток ничего не маршалим: UI сам замечает
|
||||||
|
изменения по Version стора и по LogVersion — как оверлеи замечают смену вида
|
||||||
|
по ключам кэша. Никаких LCL-зависимостей.
|
||||||
|
|
||||||
|
Разрыв → реконнект с backoff (RECONNECT_MIN..RECONNECT_MAX). Stop() делает
|
||||||
|
SockShutdown, что разблокирует recv в потоке (на Linux одного close мало —
|
||||||
|
см. WebUtils.SockShutdown).
|
||||||
|
|
||||||
|
Формат спота (общий для DXSpider / AR-Cluster / CC Cluster):
|
||||||
|
DX de UA3XYZ: 14025.0 DL1ABC CW 599 tnx qso 1832Z
|
||||||
|
Всё, что не начинается с 'DX de ', в стор не идёт — только в лог.
|
||||||
|
}
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$MODE Delphi}
|
||||||
|
{$LONGSTRINGS ON}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, SyncObjs, StrUtils, DateUtils,
|
||||||
|
WebUtils, // SockClose/SockShutdown/SockRecv/SockSend/SOCK_INVALID
|
||||||
|
DXSpotStore
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
, Windows, WinSock2
|
||||||
|
{$ELSE}
|
||||||
|
, BaseUnix, Sockets, netdb
|
||||||
|
{$ENDIF};
|
||||||
|
|
||||||
|
const
|
||||||
|
DX_DEFAULT_HOST = 'cluster.dxfun.com';
|
||||||
|
DX_DEFAULT_PORT = 8000;
|
||||||
|
DX_CONNECT_MS = 8000; // потолок ожидания connect
|
||||||
|
DX_CONNECT_SLICE_MS = 200; // квант ожидания connect (чтобы Stop не ждал 8 с)
|
||||||
|
DX_RECV_MS = 1000; // квант recv: просыпаемся проверить Terminated/очередь
|
||||||
|
DX_RECONNECT_MIN = 5; // с
|
||||||
|
DX_RECONNECT_MAX = 60; // с
|
||||||
|
DX_LOGIN_GRACE_S = 6; // не увидели приглашение — шлём позывной сами
|
||||||
|
DX_POSTLOGIN_S = 2; // пауза после позывного перед post-login командами
|
||||||
|
DX_LOG_LINES = 300; // кольцо лога соединения
|
||||||
|
DX_SEND_RETRIES = 20; // повторов send по таймауту буфера, потом разрыв
|
||||||
|
|
||||||
|
type
|
||||||
|
TDXClusterState = (dxsOff, dxsConnecting, dxsLogin, dxsOnline, dxsRetry, dxsError);
|
||||||
|
|
||||||
|
TDXClusterClient = class
|
||||||
|
private
|
||||||
|
FThread: TThread;
|
||||||
|
FLock: TCriticalSection; // защищает конфиг, лог, очередь, состояние
|
||||||
|
FStopEvent: TEvent;
|
||||||
|
|
||||||
|
// конфиг (копия под FLock — поток читает её через GetConfig)
|
||||||
|
FHost: string;
|
||||||
|
FPort: Integer;
|
||||||
|
FLogin: string;
|
||||||
|
FPassword: string;
|
||||||
|
FPostLogin: string; // строки через LineEnding
|
||||||
|
|
||||||
|
FStore: TDXSpotStore; // не владеет
|
||||||
|
|
||||||
|
FState: TDXClusterState;
|
||||||
|
FStatusMsg: string;
|
||||||
|
FSpotCount: Int64; // сколько спотов принято за сессию
|
||||||
|
|
||||||
|
FLog: array[0..DX_LOG_LINES-1] of string;
|
||||||
|
FLogHead: Integer; // индекс следующей записи
|
||||||
|
FLogCount: Integer;
|
||||||
|
FLogVer: Int64;
|
||||||
|
|
||||||
|
FOutQueue: TStringList; // строки на отправку в кластер
|
||||||
|
|
||||||
|
procedure SetState(St: TDXClusterState; const Msg: string);
|
||||||
|
public
|
||||||
|
constructor Create(AStore: TDXSpotStore);
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
procedure Configure(const AHost: string; APort: Integer;
|
||||||
|
const ALogin, APassword, APostLogin: string);
|
||||||
|
procedure Start;
|
||||||
|
procedure Stop;
|
||||||
|
function Running: Boolean;
|
||||||
|
|
||||||
|
// Отправить сырую строку в кластер (окно списка: sh/dx, set/filter, …).
|
||||||
|
procedure SendCommand(const S: string);
|
||||||
|
|
||||||
|
// Лог соединения — снимок в порядке приёма (старые → новые).
|
||||||
|
procedure GetLog(Dst: TStrings);
|
||||||
|
function LogVersion: Int64;
|
||||||
|
procedure AddLog(const S: string);
|
||||||
|
|
||||||
|
function State: TDXClusterState;
|
||||||
|
function StateText: string;
|
||||||
|
function StatusMessage: string;
|
||||||
|
function SpotsReceived: Int64;
|
||||||
|
|
||||||
|
property Store: TDXSpotStore read FStore;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Разбор строки кластера. True — это спот (Spot заполнен).
|
||||||
|
function ParseDXSpot(const Line: string; out Spot: TDXSpot): Boolean;
|
||||||
|
function DXStateName(St: TDXClusterState): string;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
type
|
||||||
|
TDXClusterThread = class(TThread)
|
||||||
|
private
|
||||||
|
FOwner: TDXClusterClient;
|
||||||
|
FSocket: TSocket;
|
||||||
|
FRxBuf: string; // хвост неполной строки
|
||||||
|
|
||||||
|
// конфиг сессии (снимок на время соединения)
|
||||||
|
FHost: string;
|
||||||
|
FPort: Integer;
|
||||||
|
FLogin: string;
|
||||||
|
FPassword: string;
|
||||||
|
FPostLogin: string;
|
||||||
|
|
||||||
|
FLoginSent: Boolean;
|
||||||
|
FPassSent: Boolean;
|
||||||
|
FPostSent: Boolean;
|
||||||
|
FLoginAt: TDateTime;
|
||||||
|
FConnectAt: TDateTime;
|
||||||
|
|
||||||
|
function Resolve(const Host: string; out Addr: LongWord): Boolean;
|
||||||
|
function ConnectSock: Boolean;
|
||||||
|
procedure CloseSock;
|
||||||
|
function SendAll(const Data: string): Boolean;
|
||||||
|
function SendLine(const S: string): Boolean;
|
||||||
|
procedure FlushOutQueue;
|
||||||
|
procedure HandleChunk(const Data: string);
|
||||||
|
procedure HandleLine(const Line: string);
|
||||||
|
procedure CheckPrompts(const Tail: string);
|
||||||
|
function Session: Boolean; // одно соединение; False — выйти совсем
|
||||||
|
protected
|
||||||
|
procedure Execute; override;
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TDXClusterClient);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DXStateName(St: TDXClusterState): string;
|
||||||
|
begin
|
||||||
|
case St of
|
||||||
|
dxsOff: Result := 'OFF';
|
||||||
|
dxsConnecting: Result := 'CONNECTING';
|
||||||
|
dxsLogin: Result := 'LOGIN';
|
||||||
|
dxsOnline: Result := 'ONLINE';
|
||||||
|
dxsRetry: Result := 'RETRY';
|
||||||
|
else Result := 'ERROR';
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function SockWouldBlock: Boolean;
|
||||||
|
// Последняя ошибка сокета означает «данных пока нет / истёк SO_RCVTIMEO /
|
||||||
|
// прерван сигналом» — соединение живо. Всё остальное (ECONNRESET, ENOTCONN,
|
||||||
|
// EPIPE…) — разрыв: без этой проверки поток крутил бы recv в пустом цикле,
|
||||||
|
// вместо того чтобы уйти на реконнект.
|
||||||
|
var E: Integer;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
E := WSAGetLastError;
|
||||||
|
Result := (E = WSAEWOULDBLOCK) or (E = WSAETIMEDOUT) or (E = WSAEINTR);
|
||||||
|
{$ELSE}
|
||||||
|
E := fpgeterrno;
|
||||||
|
Result := (E = ESysEAGAIN) or (E = ESysEWOULDBLOCK) or (E = ESysEINTR);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ ── Разбор строки спота ──────────────────────────────────────────────────── }
|
||||||
|
|
||||||
|
function ParseDXSpot(const Line: string; out Spot: TDXSpot): Boolean;
|
||||||
|
// 'DX de <spotter>: <кГц> <позывной> <комментарий> <HHMM>Z [грид]'
|
||||||
|
var
|
||||||
|
S, Rest, FreqStr, TimeTok: string;
|
||||||
|
P, i: Integer;
|
||||||
|
KHz: Double;
|
||||||
|
FS: TFormatSettings;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
FillChar(Spot, SizeOf(Spot), 0);
|
||||||
|
Spot.Call := ''; Spot.Spotter := ''; Spot.Comment := ''; Spot.TimeUTC := '';
|
||||||
|
|
||||||
|
S := Trim(Line);
|
||||||
|
if Length(S) < 12 then Exit;
|
||||||
|
if not SameText(Copy(S, 1, 6), 'DX de ') then Exit;
|
||||||
|
|
||||||
|
Rest := Copy(S, 7, MaxInt);
|
||||||
|
P := Pos(':', Rest);
|
||||||
|
if P <= 1 then Exit;
|
||||||
|
Spot.Spotter := Trim(Copy(Rest, 1, P - 1));
|
||||||
|
Rest := Trim(Copy(Rest, P + 1, MaxInt));
|
||||||
|
|
||||||
|
// частота (кГц) — первый токен
|
||||||
|
P := Pos(' ', Rest);
|
||||||
|
if P <= 1 then Exit;
|
||||||
|
FreqStr := Copy(Rest, 1, P - 1);
|
||||||
|
Rest := TrimLeft(Copy(Rest, P + 1, MaxInt));
|
||||||
|
|
||||||
|
FS := DefaultFormatSettings;
|
||||||
|
FS.DecimalSeparator := '.';
|
||||||
|
FreqStr := StringReplace(FreqStr, ',', '.', [rfReplaceAll]);
|
||||||
|
if not TryStrToFloat(FreqStr, KHz, FS) then Exit;
|
||||||
|
if (KHz <= 0) or (KHz > 100000000.0) then Exit; // мусор/битая строка
|
||||||
|
Spot.FreqHz := KHz * 1000.0;
|
||||||
|
|
||||||
|
// позывной DX — второй токен
|
||||||
|
P := Pos(' ', Rest);
|
||||||
|
if P > 0 then
|
||||||
|
begin
|
||||||
|
Spot.Call := Copy(Rest, 1, P - 1);
|
||||||
|
Rest := TrimLeft(Copy(Rest, P + 1, MaxInt));
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Spot.Call := Rest;
|
||||||
|
Rest := '';
|
||||||
|
end;
|
||||||
|
if Spot.Call = '' then Exit;
|
||||||
|
|
||||||
|
// Время: последний токен вида HHMMZ. Всё до него — комментарий, всё после
|
||||||
|
// (обычно грид спотера) приклеиваем к комментарию — терять жалко.
|
||||||
|
Rest := TrimRight(Rest);
|
||||||
|
P := 0;
|
||||||
|
for i := Length(Rest) - 4 downto 1 do
|
||||||
|
if (Rest[i] in ['0'..'9']) and (Rest[i+1] in ['0'..'9']) and
|
||||||
|
(Rest[i+2] in ['0'..'9']) and (Rest[i+3] in ['0'..'9']) and
|
||||||
|
(UpCase(Rest[i+4]) = 'Z') and
|
||||||
|
((i = 1) or (Rest[i-1] = ' ')) then
|
||||||
|
begin
|
||||||
|
P := i;
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
if P > 0 then
|
||||||
|
begin
|
||||||
|
TimeTok := Copy(Rest, P, 4);
|
||||||
|
Spot.TimeUTC := TimeTok;
|
||||||
|
Spot.Comment := Trim(Copy(Rest, 1, P - 1));
|
||||||
|
Rest := Trim(Copy(Rest, P + 5, MaxInt));
|
||||||
|
if Rest <> '' then Spot.Comment := Trim(Spot.Comment + ' ' + Rest);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Spot.Comment := Trim(Rest);
|
||||||
|
|
||||||
|
Spot.Mode := DXModeFromComment(Spot.Comment);
|
||||||
|
Spot.Stamp := Now;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ ── TDXClusterClient ─────────────────────────────────────────────────────── }
|
||||||
|
|
||||||
|
constructor TDXClusterClient.Create(AStore: TDXSpotStore);
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
var wsa: TWSAData;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FStore := AStore;
|
||||||
|
FLock := TCriticalSection.Create;
|
||||||
|
FStopEvent := TEvent.Create(nil, True, False, '');
|
||||||
|
FOutQueue := TStringList.Create;
|
||||||
|
FHost := DX_DEFAULT_HOST;
|
||||||
|
FPort := DX_DEFAULT_PORT;
|
||||||
|
FState := dxsOff;
|
||||||
|
FLogHead := 0;
|
||||||
|
FLogCount := 0;
|
||||||
|
FLogVer := 0;
|
||||||
|
FSpotCount := 0;
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
WSAStartup($0202, wsa);
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TDXClusterClient.Destroy;
|
||||||
|
begin
|
||||||
|
Stop;
|
||||||
|
FOutQueue.Free;
|
||||||
|
FStopEvent.Free;
|
||||||
|
FLock.Free;
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
WSACleanup;
|
||||||
|
{$ENDIF}
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterClient.Configure(const AHost: string; APort: Integer;
|
||||||
|
const ALogin, APassword, APostLogin: string);
|
||||||
|
begin
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
// Смена адреса/учётки — команды, набранные для ПРЕЖНЕГО кластера, теряют
|
||||||
|
// смысл (и ушли бы на новый). Чистим очередь.
|
||||||
|
if (FHost <> Trim(AHost)) or (FPort <> APort) or (FLogin <> Trim(ALogin)) then
|
||||||
|
FOutQueue.Clear;
|
||||||
|
FHost := Trim(AHost);
|
||||||
|
FPort := APort;
|
||||||
|
FLogin := Trim(ALogin);
|
||||||
|
FPassword := APassword;
|
||||||
|
FPostLogin := APostLogin;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterClient.Start;
|
||||||
|
begin
|
||||||
|
if FThread <> nil then Exit;
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
if (FHost = '') or (FLogin = '') then
|
||||||
|
begin
|
||||||
|
FState := dxsError;
|
||||||
|
FStatusMsg := 'host or callsign not set';
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
FStopEvent.ResetEvent;
|
||||||
|
SetState(dxsConnecting, '');
|
||||||
|
FThread := TDXClusterThread.Create(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterClient.Stop;
|
||||||
|
var T: TThread;
|
||||||
|
begin
|
||||||
|
// Всё, что не успели отправить, к следующему соединению уже неактуально.
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
FOutQueue.Clear;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
|
||||||
|
T := FThread;
|
||||||
|
if T = nil then
|
||||||
|
begin
|
||||||
|
SetState(dxsOff, '');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
FThread := nil;
|
||||||
|
T.Terminate;
|
||||||
|
FStopEvent.SetEvent;
|
||||||
|
// Сокет закрывает сам поток (TDXClusterThread.CloseSock из Execute);
|
||||||
|
// FStopEvent + Terminate выводят его из ожиданий, а recv рвётся по таймауту.
|
||||||
|
T.WaitFor;
|
||||||
|
T.Free;
|
||||||
|
SetState(dxsOff, '');
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXClusterClient.Running: Boolean;
|
||||||
|
begin
|
||||||
|
Result := FThread <> nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterClient.SetState(St: TDXClusterState; const Msg: string);
|
||||||
|
begin
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
FState := St;
|
||||||
|
FStatusMsg := Msg;
|
||||||
|
Inc(FLogVer); // UI перечитает и статус тоже
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXClusterClient.State: TDXClusterState;
|
||||||
|
begin
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
Result := FState;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXClusterClient.StateText: string;
|
||||||
|
begin
|
||||||
|
Result := DXStateName(State);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXClusterClient.StatusMessage: string;
|
||||||
|
begin
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
Result := FStatusMsg;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXClusterClient.SpotsReceived: Int64;
|
||||||
|
begin
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
Result := FSpotCount;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterClient.SendCommand(const S: string);
|
||||||
|
begin
|
||||||
|
if Trim(S) = '' then Exit;
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
FOutQueue.Add(S);
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterClient.AddLog(const S: string);
|
||||||
|
begin
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
FLog[FLogHead] := S;
|
||||||
|
FLogHead := (FLogHead + 1) mod DX_LOG_LINES;
|
||||||
|
if FLogCount < DX_LOG_LINES then Inc(FLogCount);
|
||||||
|
Inc(FLogVer);
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterClient.GetLog(Dst: TStrings);
|
||||||
|
var i, Start: Integer;
|
||||||
|
begin
|
||||||
|
if Dst = nil then Exit;
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
Start := (FLogHead - FLogCount + DX_LOG_LINES) mod DX_LOG_LINES;
|
||||||
|
for i := 0 to FLogCount - 1 do
|
||||||
|
Dst.Add(FLog[(Start + i) mod DX_LOG_LINES]);
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXClusterClient.LogVersion: Int64;
|
||||||
|
begin
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
Result := FLogVer;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ ── TDXClusterThread ─────────────────────────────────────────────────────── }
|
||||||
|
|
||||||
|
constructor TDXClusterThread.Create(AOwner: TDXClusterClient);
|
||||||
|
begin
|
||||||
|
FOwner := AOwner;
|
||||||
|
FSocket := SOCK_INVALID;
|
||||||
|
FreeOnTerminate := False;
|
||||||
|
inherited Create(False);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXClusterThread.Resolve(const Host: string; out Addr: LongWord): Boolean;
|
||||||
|
// Возвращает адрес в СЕТЕВОМ порядке байт (готов для sin_addr).
|
||||||
|
{$IFNDEF MSWINDOWS}
|
||||||
|
var HE: THostEntry; HA: THostAddr;
|
||||||
|
{$ELSE}
|
||||||
|
var PH: PHostEnt; L: LongWord;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
Addr := 0;
|
||||||
|
if Host = '' then Exit;
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
L := inet_addr(PChar(Host));
|
||||||
|
if L <> INADDR_NONE then // литеральный IP (уже в сетевом порядке)
|
||||||
|
begin
|
||||||
|
Addr := L;
|
||||||
|
Exit(True);
|
||||||
|
end;
|
||||||
|
PH := gethostbyname(PChar(Host));
|
||||||
|
if (PH = nil) or (PH^.h_addr_list = nil) or (PH^.h_addr_list^ = nil) then Exit;
|
||||||
|
Move(PH^.h_addr_list^^, Addr, 4); // hostent отдаёт сетевой порядок
|
||||||
|
Result := True;
|
||||||
|
{$ELSE}
|
||||||
|
// Литеральный IP: TryStrToHostAddr отдаёт ХОСТОВЫЙ порядок — разворачиваем.
|
||||||
|
if TryStrToHostAddr(Host, HA) then
|
||||||
|
begin
|
||||||
|
Addr := htonl(HA.s_addr);
|
||||||
|
Exit(True);
|
||||||
|
end;
|
||||||
|
// DNS (netdb читает /etc/resolv.conf и /etc/hosts). Здесь адрес приходит
|
||||||
|
// прямо из DNS-ответа, т.е. УЖЕ в сетевом порядке — второй раз не вертим.
|
||||||
|
if ResolveHostByName(Host, HE) then
|
||||||
|
begin
|
||||||
|
Addr := HE.Addr.s_addr;
|
||||||
|
Exit(True);
|
||||||
|
end;
|
||||||
|
{$ENDIF}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXClusterThread.ConnectSock: Boolean;
|
||||||
|
// Неблокирующий connect + select: мёртвый хост не держит поток минуту на
|
||||||
|
// системном таймауте TCP, и Stop() отрабатывает быстро.
|
||||||
|
var
|
||||||
|
Addr: {$IFDEF MSWINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF};
|
||||||
|
IP: LongWord;
|
||||||
|
R, SoErr: Integer;
|
||||||
|
FDS: TFDSet;
|
||||||
|
TV: TTimeVal;
|
||||||
|
One, Waited: Integer;
|
||||||
|
{$IFDEF MSWINDOWS}ErrLen: Integer;{$ELSE}ErrLen: TSockLen;{$ENDIF}
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if not Resolve(FHost, IP) then
|
||||||
|
begin
|
||||||
|
FOwner.SetState(dxsRetry, 'cannot resolve ' + FHost);
|
||||||
|
FOwner.AddLog('*** DNS: cannot resolve ' + FHost);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
FSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
|
||||||
|
{$ELSE}
|
||||||
|
FSocket := fpSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
|
||||||
|
{$ENDIF}
|
||||||
|
if FSocket = SOCK_INVALID then
|
||||||
|
begin
|
||||||
|
FOwner.SetState(dxsRetry, 'cannot create socket');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FillChar(Addr, SizeOf(Addr), 0);
|
||||||
|
Addr.sin_family := AF_INET;
|
||||||
|
Addr.sin_port := htons(FPort);
|
||||||
|
Addr.sin_addr.s_addr := IP;
|
||||||
|
|
||||||
|
SockSetNonBlock(FSocket, True);
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
R := WinSock2.connect(FSocket, @Addr, SizeOf(Addr));
|
||||||
|
{$ELSE}
|
||||||
|
R := fpConnect(FSocket, @Addr, SizeOf(Addr));
|
||||||
|
{$ENDIF}
|
||||||
|
if R <> 0 then
|
||||||
|
begin
|
||||||
|
// ожидаемо: EINPROGRESS / WSAEWOULDBLOCK — ждём готовности на запись.
|
||||||
|
// Ждём НЕ одним select на 8 с, а квантами по DX_CONNECT_SLICE_MS: иначе
|
||||||
|
// Stop() (закрытие программы) висел бы до конца таймаута соединения.
|
||||||
|
Waited := 0;
|
||||||
|
R := 0;
|
||||||
|
while (Waited < DX_CONNECT_MS) and (not Terminated) do
|
||||||
|
begin
|
||||||
|
TV.tv_sec := DX_CONNECT_SLICE_MS div 1000;
|
||||||
|
TV.tv_usec := (DX_CONNECT_SLICE_MS mod 1000) * 1000;
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
FD_ZERO(FDS);
|
||||||
|
FD_SET(FSocket, FDS);
|
||||||
|
R := select(0, nil, @FDS, nil, @TV);
|
||||||
|
{$ELSE}
|
||||||
|
fpFD_ZERO(FDS);
|
||||||
|
fpFD_SET(FSocket, FDS);
|
||||||
|
R := fpSelect(FSocket + 1, nil, @FDS, nil, @TV);
|
||||||
|
{$ENDIF}
|
||||||
|
if R <> 0 then Break; // готов или ошибка select
|
||||||
|
Inc(Waited, DX_CONNECT_SLICE_MS);
|
||||||
|
end;
|
||||||
|
if Terminated then
|
||||||
|
begin
|
||||||
|
CloseSock;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if R <= 0 then
|
||||||
|
begin
|
||||||
|
CloseSock;
|
||||||
|
FOwner.SetState(dxsRetry, 'connect timeout: ' + FHost);
|
||||||
|
FOwner.AddLog('*** no answer from ' + FHost + ':' + IntToStr(FPort));
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
SoErr := 0; ErrLen := SizeOf(SoErr);
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
getsockopt(FSocket, SOL_SOCKET, SO_ERROR, PChar(@SoErr), ErrLen);
|
||||||
|
{$ELSE}
|
||||||
|
fpGetSockOpt(FSocket, SOL_SOCKET, SO_ERROR, @SoErr, @ErrLen);
|
||||||
|
{$ENDIF}
|
||||||
|
if SoErr <> 0 then
|
||||||
|
begin
|
||||||
|
CloseSock;
|
||||||
|
FOwner.SetState(dxsRetry, 'connection refused');
|
||||||
|
FOwner.AddLog('*** refused: ' + FHost + ':' + IntToStr(FPort));
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
SockSetNonBlock(FSocket, False);
|
||||||
|
SockSetRcvTimeout(FSocket, DX_RECV_MS);
|
||||||
|
SockSetSndTimeout(FSocket, 5000);
|
||||||
|
One := 1;
|
||||||
|
{$IFDEF MSWINDOWS}
|
||||||
|
setsockopt(FSocket, SOL_SOCKET, SO_KEEPALIVE, PChar(@One), SizeOf(One));
|
||||||
|
{$ELSE}
|
||||||
|
fpSetSockOpt(FSocket, SOL_SOCKET, SO_KEEPALIVE, @One, SizeOf(One));
|
||||||
|
{$ENDIF}
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterThread.CloseSock;
|
||||||
|
begin
|
||||||
|
if FSocket <> SOCK_INVALID then
|
||||||
|
begin
|
||||||
|
SockShutdown(FSocket);
|
||||||
|
SockClose(FSocket);
|
||||||
|
FSocket := SOCK_INVALID;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXClusterThread.SendAll(const Data: string): Boolean;
|
||||||
|
// TCP вправе отправить меньше запрошенного — дописываем остаток. Таймаут
|
||||||
|
// (SO_SNDTIMEO) и EINTR — не ошибка соединения, пробуем ещё, но не бесконечно.
|
||||||
|
var
|
||||||
|
Sent, N, Tries: Integer;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if (FSocket = SOCK_INVALID) or (Data = '') then Exit;
|
||||||
|
Sent := 0;
|
||||||
|
Tries := 0;
|
||||||
|
while Sent < Length(Data) do
|
||||||
|
begin
|
||||||
|
if Terminated then Exit;
|
||||||
|
N := SockSend(FSocket, @Data[Sent + 1], Length(Data) - Sent, 0);
|
||||||
|
if N > 0 then
|
||||||
|
begin
|
||||||
|
Inc(Sent, N);
|
||||||
|
Tries := 0;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if not SockWouldBlock then Exit; // настоящая ошибка сокета
|
||||||
|
Inc(Tries);
|
||||||
|
if Tries > DX_SEND_RETRIES then Exit; // не отдаёт буфер — считаем разрывом
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXClusterThread.SendLine(const S: string): Boolean;
|
||||||
|
begin
|
||||||
|
Result := SendAll(S + #13#10);
|
||||||
|
if not Result then
|
||||||
|
FOwner.AddLog('*** send failed, dropping connection');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterThread.FlushOutQueue;
|
||||||
|
var
|
||||||
|
Pending: TStringList;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
Pending := nil;
|
||||||
|
FOwner.FLock.Enter;
|
||||||
|
try
|
||||||
|
if FOwner.FOutQueue.Count > 0 then
|
||||||
|
begin
|
||||||
|
Pending := TStringList.Create;
|
||||||
|
Pending.Assign(FOwner.FOutQueue);
|
||||||
|
FOwner.FOutQueue.Clear;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FOwner.FLock.Leave;
|
||||||
|
end;
|
||||||
|
if Pending = nil then Exit;
|
||||||
|
try
|
||||||
|
for i := 0 to Pending.Count - 1 do
|
||||||
|
begin
|
||||||
|
if not SendLine(Pending[i]) then Break; // сокет умер — остальное на реконнект
|
||||||
|
FOwner.AddLog('> ' + Pending[i]);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
Pending.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterThread.CheckPrompts(const Tail: string);
|
||||||
|
// Приглашения логина И пароля обычно приходят БЕЗ перевода строки, поэтому
|
||||||
|
// ищем их и в незавершённом хвосте буфера, а не только в целых строках.
|
||||||
|
// Флаги FLoginSent/FPassSent держат отправку однократной: хвост проверяется
|
||||||
|
// заново с каждым пришедшим куском.
|
||||||
|
var U: string;
|
||||||
|
begin
|
||||||
|
if Tail = '' then Exit;
|
||||||
|
U := LowerCase(Tail);
|
||||||
|
|
||||||
|
if not FLoginSent then
|
||||||
|
begin
|
||||||
|
if (Pos('login:', U) > 0) or (Pos('call:', U) > 0) or
|
||||||
|
(Pos('callsign', U) > 0) or (Pos('your call', U) > 0) or
|
||||||
|
(Pos('enter your', U) > 0) then
|
||||||
|
begin
|
||||||
|
if not SendLine(FLogin) then Exit;
|
||||||
|
FOwner.AddLog('> ' + FLogin);
|
||||||
|
FLoginSent := True;
|
||||||
|
FLoginAt := Now;
|
||||||
|
FOwner.SetState(dxsLogin, '');
|
||||||
|
end;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (FPassword <> '') and (not FPassSent) and (Pos('password', U) > 0) then
|
||||||
|
begin
|
||||||
|
if not SendLine(FPassword) then Exit;
|
||||||
|
FOwner.AddLog('> ********');
|
||||||
|
FPassSent := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterThread.HandleLine(const Line: string);
|
||||||
|
var
|
||||||
|
Spot: TDXSpot;
|
||||||
|
begin
|
||||||
|
if Line = '' then Exit;
|
||||||
|
FOwner.AddLog(Line);
|
||||||
|
|
||||||
|
if ParseDXSpot(Line, Spot) then
|
||||||
|
begin
|
||||||
|
FOwner.FStore.Add(Spot);
|
||||||
|
FOwner.FLock.Enter;
|
||||||
|
try
|
||||||
|
Inc(FOwner.FSpotCount);
|
||||||
|
finally
|
||||||
|
FOwner.FLock.Leave;
|
||||||
|
end;
|
||||||
|
if FOwner.State <> dxsOnline then FOwner.SetState(dxsOnline, '');
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
CheckPrompts(Line);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterThread.HandleChunk(const Data: string);
|
||||||
|
var
|
||||||
|
P: Integer;
|
||||||
|
Line: string;
|
||||||
|
begin
|
||||||
|
FRxBuf := FRxBuf + Data;
|
||||||
|
while True do
|
||||||
|
begin
|
||||||
|
P := 1;
|
||||||
|
while (P <= Length(FRxBuf)) and not (FRxBuf[P] in [#10, #13]) do Inc(P);
|
||||||
|
if P > Length(FRxBuf) then Break; // перевода строки ещё нет
|
||||||
|
Line := Copy(FRxBuf, 1, P - 1);
|
||||||
|
// съедаем весь конец строки (CR, LF или CRLF)
|
||||||
|
while (P <= Length(FRxBuf)) and (FRxBuf[P] in [#10, #13]) do Inc(P);
|
||||||
|
Delete(FRxBuf, 1, P - 1);
|
||||||
|
HandleLine(TrimRight(Line));
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Хвост без перевода строки — возможно, это приглашение логина или пароля.
|
||||||
|
if FRxBuf <> '' then CheckPrompts(FRxBuf);
|
||||||
|
// Защита от мусора без переводов строк.
|
||||||
|
if Length(FRxBuf) > 8192 then FRxBuf := '';
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXClusterThread.Session: Boolean;
|
||||||
|
var
|
||||||
|
Buf: array[0..4095] of Byte;
|
||||||
|
N: Integer;
|
||||||
|
Chunk: string;
|
||||||
|
PL: TStringList;
|
||||||
|
i: Integer;
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
FRxBuf := '';
|
||||||
|
FLoginSent := False;
|
||||||
|
FPassSent := False;
|
||||||
|
FPostSent := False;
|
||||||
|
FConnectAt := Now;
|
||||||
|
|
||||||
|
FOwner.SetState(dxsConnecting, FHost + ':' + IntToStr(FPort));
|
||||||
|
FOwner.AddLog('*** connecting to ' + FHost + ':' + IntToStr(FPort));
|
||||||
|
if not ConnectSock then Exit;
|
||||||
|
|
||||||
|
FOwner.AddLog('*** connected');
|
||||||
|
FOwner.SetState(dxsLogin, '');
|
||||||
|
|
||||||
|
while not Terminated do
|
||||||
|
begin
|
||||||
|
N := SockRecv(FSocket, @Buf[0], SizeOf(Buf), 0);
|
||||||
|
if N > 0 then
|
||||||
|
begin
|
||||||
|
SetLength(Chunk, N);
|
||||||
|
Move(Buf[0], Chunk[1], N);
|
||||||
|
HandleChunk(Chunk);
|
||||||
|
end
|
||||||
|
else if N = 0 then
|
||||||
|
begin
|
||||||
|
FOwner.AddLog('*** connection closed by peer');
|
||||||
|
Break;
|
||||||
|
end
|
||||||
|
else if not SockWouldBlock then
|
||||||
|
begin
|
||||||
|
// Не таймаут кванта recv, а настоящая ошибка сокета — уходим на реконнект.
|
||||||
|
FOwner.AddLog('*** connection lost (socket error)');
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Terminated then Break;
|
||||||
|
|
||||||
|
// Приглашения не дождались — шлём позывной сами (часть кластеров молчит).
|
||||||
|
if (not FLoginSent) and (SecondsBetween(Now, FConnectAt) >= DX_LOGIN_GRACE_S) then
|
||||||
|
begin
|
||||||
|
if not SendLine(FLogin) then Break; // сокет умер — на реконнект
|
||||||
|
FOwner.AddLog('> ' + FLogin + ' (no prompt seen)');
|
||||||
|
FLoginSent := True;
|
||||||
|
FLoginAt := Now;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Post-login команды — один раз, чуть погодя после позывного.
|
||||||
|
if FLoginSent and (not FPostSent) and
|
||||||
|
(SecondsBetween(Now, FLoginAt) >= DX_POSTLOGIN_S) then
|
||||||
|
begin
|
||||||
|
FPostSent := True;
|
||||||
|
if Trim(FPostLogin) <> '' then
|
||||||
|
begin
|
||||||
|
PL := TStringList.Create;
|
||||||
|
try
|
||||||
|
PL.Text := FPostLogin;
|
||||||
|
for i := 0 to PL.Count - 1 do
|
||||||
|
if Trim(PL[i]) <> '' then
|
||||||
|
begin
|
||||||
|
if not SendLine(Trim(PL[i])) then Break;
|
||||||
|
FOwner.AddLog('> ' + Trim(PL[i]));
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
PL.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
if FOwner.State <> dxsOnline then FOwner.SetState(dxsOnline, '');
|
||||||
|
end;
|
||||||
|
|
||||||
|
FlushOutQueue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
CloseSock;
|
||||||
|
Result := not Terminated;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterThread.Execute;
|
||||||
|
var
|
||||||
|
Backoff: Integer;
|
||||||
|
begin
|
||||||
|
Backoff := DX_RECONNECT_MIN;
|
||||||
|
// Снимок конфига на всю жизнь потока: Configure во время работы применяется
|
||||||
|
// следующим Start (так же ведёт себя веб-сервер при смене порта).
|
||||||
|
FOwner.FLock.Enter;
|
||||||
|
try
|
||||||
|
FHost := FOwner.FHost;
|
||||||
|
FPort := FOwner.FPort;
|
||||||
|
FLogin := FOwner.FLogin;
|
||||||
|
FPassword := FOwner.FPassword;
|
||||||
|
FPostLogin := FOwner.FPostLogin;
|
||||||
|
finally
|
||||||
|
FOwner.FLock.Leave;
|
||||||
|
end;
|
||||||
|
|
||||||
|
while not Terminated do
|
||||||
|
begin
|
||||||
|
if not Session then Break;
|
||||||
|
if Terminated then Break;
|
||||||
|
|
||||||
|
FOwner.SetState(dxsRetry, 'reconnecting in ' + IntToStr(Backoff) + ' s');
|
||||||
|
FOwner.AddLog('*** reconnecting in ' + IntToStr(Backoff) + ' s');
|
||||||
|
if FOwner.FStopEvent.WaitFor(Backoff * 1000) = wrSignaled then Break;
|
||||||
|
Backoff := Backoff * 2;
|
||||||
|
if Backoff > DX_RECONNECT_MAX then Backoff := DX_RECONNECT_MAX;
|
||||||
|
end;
|
||||||
|
CloseSock;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,459 @@
|
|||||||
|
unit DXClusterForm;
|
||||||
|
|
||||||
|
{
|
||||||
|
TDXClusterForm — окно DX-кластера: список принятых спотов, лог соединения и
|
||||||
|
строка команды в кластер (sh/dx, set/filter — диалект у каждого кластера свой,
|
||||||
|
поэтому команды не угадываем, а даём отправить руками).
|
||||||
|
|
||||||
|
Данные тянутся ПОЛЛИНГОМ: сетевой поток кладёт споты в TDXSpotStore и строки в
|
||||||
|
лог клиента, а форма раз в секунду сравнивает Version/LogVersion и перечитывает
|
||||||
|
только при изменении. Никакого Synchronize из потока в UI — та же схема, что у
|
||||||
|
оверлея спектра.
|
||||||
|
|
||||||
|
Двойной клик по споту (или Enter) — QSY: наружу через OnTuneSpot.
|
||||||
|
}
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, Math,
|
||||||
|
Forms, Controls, Graphics, StdCtrls, ExtCtrls,
|
||||||
|
FlatButton, FlatEdit, FlatListBox, FlatMemo,
|
||||||
|
AppTheme, DpiUtils, DXSpotStore, DXClusterClient;
|
||||||
|
|
||||||
|
type
|
||||||
|
// QSY по споту: частота в display-Гц + мода (dxmUnknown — не трогать моду).
|
||||||
|
TDXTuneEvent = procedure(FreqHz: Double; Mode: TDXMode) of object;
|
||||||
|
|
||||||
|
TDXClusterForm = class(TForm)
|
||||||
|
private
|
||||||
|
FStore: TDXSpotStore; // не владеет
|
||||||
|
FClient: TDXClusterClient; // не владеет
|
||||||
|
FTheme: TAppTheme;
|
||||||
|
|
||||||
|
FTitle: TLabel;
|
||||||
|
FStatus: TLabel;
|
||||||
|
FBtnConn: TFlatButton;
|
||||||
|
FBtnClear: TFlatButton;
|
||||||
|
FBtnSort: TFlatButton;
|
||||||
|
FBtnClose: TFlatButton;
|
||||||
|
FList: TFlatListBox;
|
||||||
|
FLog: TFlatMemo;
|
||||||
|
FEdCmd: TFlatEdit;
|
||||||
|
FBtnSend: TFlatButton;
|
||||||
|
FTimer: TTimer;
|
||||||
|
|
||||||
|
FSpots: TDXSpotArray; // снимок, параллельный строкам FList
|
||||||
|
FSortFreq: Boolean; // False = по времени (свежие сверху)
|
||||||
|
FLastVer: Int64;
|
||||||
|
FLastLogVer: Int64;
|
||||||
|
FOnTune: TDXTuneEvent;
|
||||||
|
|
||||||
|
procedure BuildUI;
|
||||||
|
procedure StyleBtn(B: TFlatButton);
|
||||||
|
function FormatSpotLine(const S: TDXSpot): string;
|
||||||
|
procedure RefreshSpots;
|
||||||
|
procedure RefreshLog;
|
||||||
|
procedure RefreshStatus;
|
||||||
|
procedure TuneSelected;
|
||||||
|
|
||||||
|
procedure OnTimerTick(Sender: TObject);
|
||||||
|
procedure OnConnClick(Sender: TObject);
|
||||||
|
procedure OnClearClick(Sender: TObject);
|
||||||
|
procedure OnSortClick(Sender: TObject);
|
||||||
|
procedure OnCloseClick(Sender: TObject);
|
||||||
|
procedure OnSendClick(Sender: TObject);
|
||||||
|
procedure OnListDblClick(Sender: TObject);
|
||||||
|
procedure OnListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||||
|
procedure OnCmdKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||||
|
procedure OnFormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
protected
|
||||||
|
procedure DoShow; override;
|
||||||
|
procedure DoHide; override;
|
||||||
|
public
|
||||||
|
constructor CreateWith(AOwner: TComponent; AStore: TDXSpotStore;
|
||||||
|
AClient: TDXClusterClient); reintroduce;
|
||||||
|
procedure ApplyTheme(const T: TAppTheme);
|
||||||
|
property OnTuneSpot: TDXTuneEvent read FOnTune write FOnTune;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
FORM_W = 860;
|
||||||
|
FORM_H = 560;
|
||||||
|
MARGIN = 12;
|
||||||
|
BTN_H = 26;
|
||||||
|
LOG_H = 130;
|
||||||
|
|
||||||
|
constructor TDXClusterForm.CreateWith(AOwner: TComponent; AStore: TDXSpotStore;
|
||||||
|
AClient: TDXClusterClient);
|
||||||
|
var
|
||||||
|
WorkArea: TRect;
|
||||||
|
begin
|
||||||
|
inherited CreateNew(AOwner);
|
||||||
|
FStore := AStore;
|
||||||
|
FClient := AClient;
|
||||||
|
FTheme := DarkTheme;
|
||||||
|
FSortFreq := False;
|
||||||
|
FLastVer := -1;
|
||||||
|
FLastLogVer := -1;
|
||||||
|
|
||||||
|
Scaled := False;
|
||||||
|
Caption := 'DX Cluster';
|
||||||
|
BorderStyle := bsSizeable;
|
||||||
|
if AOwner is TCustomForm then
|
||||||
|
begin
|
||||||
|
WorkArea := Screen.MonitorFromRect(TCustomForm(AOwner).BoundsRect).WorkareaRect;
|
||||||
|
Position := poOwnerFormCenter;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
WorkArea := Screen.PrimaryMonitor.WorkareaRect;
|
||||||
|
Position := poScreenCenter;
|
||||||
|
end;
|
||||||
|
Width := Min(DpiScale(FORM_W), WorkArea.Right - WorkArea.Left - DpiScale(48));
|
||||||
|
Height := Min(DpiScale(FORM_H), WorkArea.Bottom - WorkArea.Top - DpiScale(48));
|
||||||
|
Constraints.MinWidth := Min(DpiScale(620), Width);
|
||||||
|
Constraints.MinHeight := Min(DpiScale(380), Height);
|
||||||
|
OnClose := @OnFormClose;
|
||||||
|
|
||||||
|
BuildUI;
|
||||||
|
ApplyTheme(DarkTheme);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.BuildUI;
|
||||||
|
var
|
||||||
|
BtnW, Y: Integer;
|
||||||
|
begin
|
||||||
|
BtnW := DpiScale(96);
|
||||||
|
|
||||||
|
FTitle := TLabel.Create(Self);
|
||||||
|
FTitle.Parent := Self;
|
||||||
|
FTitle.SetBounds(DpiScale(MARGIN), DpiScale(10), DpiScale(300), DpiScale(22));
|
||||||
|
FTitle.Caption := 'DX CLUSTER';
|
||||||
|
FTitle.Font.Size := 9;
|
||||||
|
FTitle.Font.Style := [fsBold];
|
||||||
|
|
||||||
|
FStatus := TLabel.Create(Self);
|
||||||
|
FStatus.Parent := Self;
|
||||||
|
FStatus.SetBounds(DpiScale(MARGIN), DpiScale(31), DpiScale(520), DpiScale(18));
|
||||||
|
FStatus.Font.Size := 8;
|
||||||
|
FStatus.Anchors := [akLeft, akTop, akRight];
|
||||||
|
|
||||||
|
Y := DpiScale(10);
|
||||||
|
FBtnClose := TFlatButton.Create(Self);
|
||||||
|
FBtnClose.Parent := Self;
|
||||||
|
FBtnClose.SetBounds(ClientWidth - DpiScale(MARGIN) - BtnW, Y, BtnW, DpiScale(BTN_H));
|
||||||
|
FBtnClose.Caption := 'Close';
|
||||||
|
FBtnClose.Anchors := [akTop, akRight];
|
||||||
|
FBtnClose.OnClick := @OnCloseClick;
|
||||||
|
|
||||||
|
FBtnSort := TFlatButton.Create(Self);
|
||||||
|
FBtnSort.Parent := Self;
|
||||||
|
FBtnSort.SetBounds(FBtnClose.Left - BtnW - DpiScale(6), Y, BtnW, DpiScale(BTN_H));
|
||||||
|
FBtnSort.Caption := 'BY TIME';
|
||||||
|
FBtnSort.Anchors := [akTop, akRight];
|
||||||
|
FBtnSort.OnClick := @OnSortClick;
|
||||||
|
|
||||||
|
FBtnClear := TFlatButton.Create(Self);
|
||||||
|
FBtnClear.Parent := Self;
|
||||||
|
FBtnClear.SetBounds(FBtnSort.Left - BtnW - DpiScale(6), Y, BtnW, DpiScale(BTN_H));
|
||||||
|
FBtnClear.Caption := 'CLEAR';
|
||||||
|
FBtnClear.Anchors := [akTop, akRight];
|
||||||
|
FBtnClear.OnClick := @OnClearClick;
|
||||||
|
|
||||||
|
FBtnConn := TFlatButton.Create(Self);
|
||||||
|
FBtnConn.Parent := Self;
|
||||||
|
FBtnConn.SetBounds(FBtnClear.Left - BtnW - DpiScale(6), Y, BtnW, DpiScale(BTN_H));
|
||||||
|
FBtnConn.Caption := 'CONNECT';
|
||||||
|
FBtnConn.Anchors := [akTop, akRight];
|
||||||
|
FBtnConn.OnClick := @OnConnClick;
|
||||||
|
|
||||||
|
// Строка команды — внизу, над логом.
|
||||||
|
FBtnSend := TFlatButton.Create(Self);
|
||||||
|
FBtnSend.Parent := Self;
|
||||||
|
FBtnSend.SetBounds(ClientWidth - DpiScale(MARGIN) - BtnW,
|
||||||
|
ClientHeight - DpiScale(MARGIN + BTN_H), BtnW, DpiScale(BTN_H));
|
||||||
|
FBtnSend.Caption := 'SEND';
|
||||||
|
FBtnSend.Anchors := [akRight, akBottom];
|
||||||
|
FBtnSend.OnClick := @OnSendClick;
|
||||||
|
|
||||||
|
FEdCmd := TFlatEdit.Create(Self);
|
||||||
|
FEdCmd.Parent := Self;
|
||||||
|
FEdCmd.SetBounds(DpiScale(MARGIN), ClientHeight - DpiScale(MARGIN + BTN_H),
|
||||||
|
FBtnSend.Left - DpiScale(MARGIN + 6), DpiScale(BTN_H));
|
||||||
|
FEdCmd.TextHint := 'command to cluster (sh/dx, set/filter …)';
|
||||||
|
FEdCmd.Anchors := [akLeft, akRight, akBottom];
|
||||||
|
FEdCmd.OnKeyDown := @OnCmdKeyDown;
|
||||||
|
|
||||||
|
FLog := TFlatMemo.Create(Self);
|
||||||
|
FLog.Parent := Self;
|
||||||
|
FLog.SetBounds(DpiScale(MARGIN),
|
||||||
|
FEdCmd.Top - DpiScale(LOG_H + 6),
|
||||||
|
ClientWidth - DpiScale(MARGIN * 2), DpiScale(LOG_H));
|
||||||
|
FLog.Anchors := [akLeft, akRight, akBottom];
|
||||||
|
FLog.ReadOnly := True;
|
||||||
|
FLog.WordWrap := False;
|
||||||
|
FLog.Font.Name := 'Courier New';
|
||||||
|
FLog.Font.Size := 8;
|
||||||
|
|
||||||
|
FList := TFlatListBox.Create(Self);
|
||||||
|
FList.Parent := Self;
|
||||||
|
FList.SetBounds(DpiScale(MARGIN), DpiScale(56),
|
||||||
|
ClientWidth - DpiScale(MARGIN * 2),
|
||||||
|
FLog.Top - DpiScale(56 + 6));
|
||||||
|
FList.Anchors := [akLeft, akTop, akRight, akBottom];
|
||||||
|
FList.Font.Name := 'Courier New';
|
||||||
|
FList.Font.Size := 9;
|
||||||
|
FList.TabStop := True;
|
||||||
|
FList.OnDblClick := @OnListDblClick;
|
||||||
|
FList.OnKeyDown := @OnListKeyDown;
|
||||||
|
|
||||||
|
FTimer := TTimer.Create(Self);
|
||||||
|
FTimer.Interval := 1000;
|
||||||
|
FTimer.Enabled := False;
|
||||||
|
FTimer.OnTimer := @OnTimerTick;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.StyleBtn(B: TFlatButton);
|
||||||
|
begin
|
||||||
|
// TFlatButton темы не знает — цвета выставляются вручную, как в ChannelsForm.
|
||||||
|
if B = nil then Exit;
|
||||||
|
B.Font.Assign(Font);
|
||||||
|
B.Font.Size := 8;
|
||||||
|
B.Font.Style := [];
|
||||||
|
B.ClrNorm := FTheme.BtnNorm;
|
||||||
|
B.ClrActive := FTheme.BtnActive;
|
||||||
|
B.ClrHot := FTheme.BtnHot;
|
||||||
|
B.ClrBorder := FTheme.BtnBorderNorm;
|
||||||
|
B.ClrText := FTheme.BtnText;
|
||||||
|
B.ClrTextAct := FTheme.BtnTextActive;
|
||||||
|
B.Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.ApplyTheme(const T: TAppTheme);
|
||||||
|
begin
|
||||||
|
FTheme := T;
|
||||||
|
Color := T.BG;
|
||||||
|
FTitle.Font.Color := T.Text;
|
||||||
|
FStatus.Font.Color := T.TextDim;
|
||||||
|
FList.SetAppTheme(T);
|
||||||
|
FLog.SetAppTheme(T);
|
||||||
|
FEdCmd.SetAppTheme(T);
|
||||||
|
StyleBtn(FBtnConn);
|
||||||
|
StyleBtn(FBtnClear);
|
||||||
|
StyleBtn(FBtnSort);
|
||||||
|
StyleBtn(FBtnClose);
|
||||||
|
StyleBtn(FBtnSend);
|
||||||
|
Invalidate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ ── Наполнение ───────────────────────────────────────────────────────────── }
|
||||||
|
|
||||||
|
function TDXClusterForm.FormatSpotLine(const S: TDXSpot): string;
|
||||||
|
// Моноширинные колонки: частота | позывной | мода | UTC | спотер | комментарий.
|
||||||
|
var
|
||||||
|
FreqStr, Md: string;
|
||||||
|
begin
|
||||||
|
FreqStr := FormatFloat('0.0', S.FreqHz / 1000.0); // кГц, как в кластере
|
||||||
|
while Length(FreqStr) < 10 do FreqStr := ' ' + FreqStr;
|
||||||
|
Md := DXModeName(S.Mode);
|
||||||
|
while Length(Md) < 4 do Md := Md + ' ';
|
||||||
|
Result := Format('%s %-12s %s %-5s %-10s %s',
|
||||||
|
[FreqStr, S.Call, Md, S.TimeUTC, S.Spotter, S.Comment]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.RefreshSpots;
|
||||||
|
var
|
||||||
|
i, j, Keep: Integer;
|
||||||
|
T: TDXSpot;
|
||||||
|
Sel: string;
|
||||||
|
begin
|
||||||
|
if FStore = nil then Exit;
|
||||||
|
Keep := FList.ItemIndex;
|
||||||
|
Sel := '';
|
||||||
|
if (Keep >= 0) and (Keep < Length(FSpots)) then Sel := FSpots[Keep].Call;
|
||||||
|
|
||||||
|
FStore.Snapshot(FSpots); // приходит отсортированным по частоте
|
||||||
|
if not FSortFreq then
|
||||||
|
// по времени, свежие сверху (вставками — список короткий, TTL его держит)
|
||||||
|
for i := 1 to High(FSpots) do
|
||||||
|
begin
|
||||||
|
T := FSpots[i];
|
||||||
|
j := i - 1;
|
||||||
|
while (j >= 0) and (FSpots[j].Stamp < T.Stamp) do
|
||||||
|
begin
|
||||||
|
FSpots[j + 1] := FSpots[j];
|
||||||
|
Dec(j);
|
||||||
|
end;
|
||||||
|
FSpots[j + 1] := T;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FList.Items.BeginUpdate;
|
||||||
|
try
|
||||||
|
FList.Items.Clear;
|
||||||
|
for i := 0 to High(FSpots) do
|
||||||
|
FList.Items.Add(FormatSpotLine(FSpots[i]));
|
||||||
|
finally
|
||||||
|
FList.Items.EndUpdate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Держим выделение на том же позывном, если он ещё в списке.
|
||||||
|
if Sel <> '' then
|
||||||
|
for i := 0 to High(FSpots) do
|
||||||
|
if SameText(FSpots[i].Call, Sel) then
|
||||||
|
begin
|
||||||
|
FList.ItemIndex := i;
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.RefreshLog;
|
||||||
|
var
|
||||||
|
L: TStringList;
|
||||||
|
begin
|
||||||
|
if FClient = nil then Exit;
|
||||||
|
L := TStringList.Create;
|
||||||
|
try
|
||||||
|
FClient.GetLog(L);
|
||||||
|
FLog.Lines.BeginUpdate;
|
||||||
|
try
|
||||||
|
FLog.Lines.Assign(L);
|
||||||
|
finally
|
||||||
|
FLog.Lines.EndUpdate;
|
||||||
|
end;
|
||||||
|
// прокрутка в конец — свежие строки внизу
|
||||||
|
FLog.SelStart := Length(FLog.Text);
|
||||||
|
finally
|
||||||
|
L.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.RefreshStatus;
|
||||||
|
var
|
||||||
|
St: TDXClusterState;
|
||||||
|
S: string;
|
||||||
|
begin
|
||||||
|
if FClient = nil then Exit;
|
||||||
|
St := FClient.State;
|
||||||
|
S := DXStateName(St);
|
||||||
|
if FClient.StatusMessage <> '' then S := S + ' — ' + FClient.StatusMessage;
|
||||||
|
S := S + Format(' | spots stored: %d received this session: %d',
|
||||||
|
[FStore.Count, FClient.SpotsReceived]);
|
||||||
|
FStatus.Caption := S;
|
||||||
|
if FClient.Running then FBtnConn.Caption := 'DISCONNECT'
|
||||||
|
else FBtnConn.Caption := 'CONNECT';
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ ── События ──────────────────────────────────────────────────────────────── }
|
||||||
|
|
||||||
|
procedure TDXClusterForm.OnTimerTick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if (FStore <> nil) and (FStore.Version <> FLastVer) then
|
||||||
|
begin
|
||||||
|
FLastVer := FStore.Version;
|
||||||
|
RefreshSpots;
|
||||||
|
end;
|
||||||
|
if (FClient <> nil) and (FClient.LogVersion <> FLastLogVer) then
|
||||||
|
begin
|
||||||
|
FLastLogVer := FClient.LogVersion;
|
||||||
|
RefreshLog;
|
||||||
|
RefreshStatus;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.OnConnClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if FClient = nil then Exit;
|
||||||
|
if FClient.Running then FClient.Stop else FClient.Start;
|
||||||
|
RefreshStatus;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.OnClearClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if FStore <> nil then FStore.Clear;
|
||||||
|
FLastVer := -1;
|
||||||
|
RefreshSpots;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.OnSortClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FSortFreq := not FSortFreq;
|
||||||
|
if FSortFreq then FBtnSort.Caption := 'BY FREQ'
|
||||||
|
else FBtnSort.Caption := 'BY TIME';
|
||||||
|
RefreshSpots;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.OnCloseClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Close;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.OnSendClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if (FClient = nil) or (Trim(FEdCmd.Text) = '') then Exit;
|
||||||
|
FClient.SendCommand(Trim(FEdCmd.Text));
|
||||||
|
FEdCmd.Text := '';
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.OnCmdKeyDown(Sender: TObject; var Key: Word;
|
||||||
|
Shift: TShiftState);
|
||||||
|
begin
|
||||||
|
if Key = 13 then
|
||||||
|
begin
|
||||||
|
Key := 0;
|
||||||
|
OnSendClick(nil);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.TuneSelected;
|
||||||
|
var i: Integer;
|
||||||
|
begin
|
||||||
|
i := FList.ItemIndex;
|
||||||
|
if (i < 0) or (i > High(FSpots)) then Exit;
|
||||||
|
if Assigned(FOnTune) then FOnTune(FSpots[i].FreqHz, FSpots[i].Mode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.OnListDblClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
TuneSelected;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.OnListKeyDown(Sender: TObject; var Key: Word;
|
||||||
|
Shift: TShiftState);
|
||||||
|
// Enter по выделенной строке = то же, что двойной клик (QSY на спот).
|
||||||
|
begin
|
||||||
|
if (Key = 13) or (Key = 10) then
|
||||||
|
begin
|
||||||
|
Key := 0;
|
||||||
|
TuneSelected;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.OnFormClose(Sender: TObject; var CloseAction: TCloseAction);
|
||||||
|
begin
|
||||||
|
CloseAction := caHide;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.DoShow;
|
||||||
|
begin
|
||||||
|
inherited DoShow;
|
||||||
|
// Поллинг живёт только пока окно видимо (как анализатор лупы маяка).
|
||||||
|
FLastVer := -1;
|
||||||
|
FLastLogVer := -1;
|
||||||
|
RefreshSpots;
|
||||||
|
RefreshLog;
|
||||||
|
RefreshStatus;
|
||||||
|
FTimer.Enabled := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXClusterForm.DoHide;
|
||||||
|
begin
|
||||||
|
FTimer.Enabled := False;
|
||||||
|
inherited DoHide;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -0,0 +1,507 @@
|
|||||||
|
unit DXSpotOverlay;
|
||||||
|
|
||||||
|
{
|
||||||
|
Оверлей DX-спотов на спектре: позывной в «чипе» + вертикальный штрих к своей
|
||||||
|
частоте. Пересекающиеся подписи раскладываются лесенкой по рядам сверху вниз.
|
||||||
|
|
||||||
|
Производительность — ровно модель BandPlanOverlay/VfoOverlay, ничего нового:
|
||||||
|
|
||||||
|
• Кэшируется ТОЛЬКО полоса подписей (W × FBandH, вверху спектра) в key-color
|
||||||
|
битмап; пересборка идёт исключительно по dirty-ключу (версия стора / вид /
|
||||||
|
ширина / тема / фильтры / тик затухания), а каждый кадр — один композит
|
||||||
|
W × FBandH с постоянной альфой (BlendBitmapKey, тот же дворд-блендинг).
|
||||||
|
Полноэкранный кэш W × H на кадр стоил бы в разы дороже — поэтому штрихи
|
||||||
|
ниже полосы в кэш НЕ входят.
|
||||||
|
• Штрихи от полосы до низа спектра рисует вызывающая сторона теми же
|
||||||
|
примитивами, что и все прочие маркеры: CPU — RawVLine внутри RawBegin/
|
||||||
|
RawEnd (никакого Canvas на битмапе кадра), GL — DrawLine. Оверлей отдаёт
|
||||||
|
только готовый список X/цвет (TickCount/Tick), посчитанный при пересборке
|
||||||
|
кэша, — на кадр никакой арифметики по спотам.
|
||||||
|
• GL-путь берёт ТОТ ЖЕ битмап текстурой (DrawOverlayBitmap + UploadBitmap с
|
||||||
|
color-key), заливка — только при dirty. Вид CPU и GL совпадает.
|
||||||
|
|
||||||
|
Домен частот — display-Гц, как их видит спектр (GetViewWindow). Частота спота
|
||||||
|
кладётся как есть: на QO-100 кластеры постят downlink 10489.xxx, что совпадает
|
||||||
|
со шкалой панадаптера само собой.
|
||||||
|
}
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, Graphics, Types, Math, Forms,
|
||||||
|
VfoOverlay, // BlendBitmapKey — общий keyed-композит (одна копия на проект)
|
||||||
|
DXSpotStore;
|
||||||
|
|
||||||
|
const
|
||||||
|
DXSPOT_ALPHA = 225; // альфа композита полосы подписей
|
||||||
|
DXSPOT_ROW_BASE_H = 15; // базовая высота ряда @96dpi
|
||||||
|
DXSPOT_MAX_ROWS = 6; // потолок рядов лесенки (настройка кладётся сюда)
|
||||||
|
|
||||||
|
type
|
||||||
|
// Один разложенный спот: где чип, где штрих, каким цветом.
|
||||||
|
TDXSpotItem = record
|
||||||
|
X: Integer; // X штриха (пиксель частоты)
|
||||||
|
Chip: TRect; // прямоугольник подписи (для хит-теста)
|
||||||
|
Color: TColor; // цвет с учётом возраста/своего позывного
|
||||||
|
Spot: TDXSpot;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDXSpotOverlay = class(TComponent)
|
||||||
|
private
|
||||||
|
FStore: TDXSpotStore; // не владеет
|
||||||
|
FCenterFreq: Double;
|
||||||
|
FSpanHz: Double;
|
||||||
|
FEnabled: Boolean;
|
||||||
|
FLightTheme: Boolean;
|
||||||
|
FOwnCall: string;
|
||||||
|
|
||||||
|
// фильтры
|
||||||
|
FModes: TDXModeSet;
|
||||||
|
FMaxAgeMin: Integer;
|
||||||
|
FMaxRows: Integer;
|
||||||
|
|
||||||
|
FCache: TBitmap;
|
||||||
|
FCacheW: Integer;
|
||||||
|
FCacheDirty: Boolean;
|
||||||
|
FBandH: Integer; // высота полосы подписей (px, масштаб по DPI)
|
||||||
|
FRowH: Integer;
|
||||||
|
|
||||||
|
// ключ кэша
|
||||||
|
FKeyCenter: Double;
|
||||||
|
FKeySpan: Double;
|
||||||
|
FKeyW: Integer;
|
||||||
|
FKeyEnabled: Boolean;
|
||||||
|
FKeyVersion: Int64;
|
||||||
|
FKeyLight: Boolean;
|
||||||
|
FKeyRows: Integer;
|
||||||
|
FKeyAgeTick: Int64;
|
||||||
|
FAgeTick: Int64; // бампается таймером UI — обновить затухание
|
||||||
|
|
||||||
|
FRenderVer: Int64; // ++ на каждую пересборку кэша — ключ GL-текстуры
|
||||||
|
FLayoutTTL: Integer; // горизонт затухания, снят один раз на раскладку
|
||||||
|
FItems: array of TDXSpotItem;
|
||||||
|
FItemCount: Integer;
|
||||||
|
FHidden: Integer; // сколько спотов не влезло в лесенку
|
||||||
|
|
||||||
|
function FreqToX(FreqHz: Double; W: Integer): Integer;
|
||||||
|
function AgeColor(const S: TDXSpot): TColor;
|
||||||
|
procedure Layout(C: TCanvas; W: Integer);
|
||||||
|
procedure DrawSelf(C: TCanvas; W: Integer);
|
||||||
|
procedure RebuildCache(W: Integer);
|
||||||
|
function NeedsRebuild(W: Integer): Boolean;
|
||||||
|
procedure SetMaxRows(V: Integer);
|
||||||
|
public
|
||||||
|
constructor Create(AOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
procedure Attach(AStore: TDXSpotStore);
|
||||||
|
procedure SetView(ACenterHz, ASpanHz: Double);
|
||||||
|
procedure SetEnabled(En: Boolean);
|
||||||
|
procedure SetLightTheme(Light: Boolean);
|
||||||
|
procedure SetOwnCall(const ACall: string);
|
||||||
|
procedure SetFilters(AModes: TDXModeSet; AMaxAgeMin: Integer);
|
||||||
|
// Тик затухания: дёргается редко (раз в десятки секунд) — только чтобы
|
||||||
|
// старые споты потускнели и ушедшие по TTL исчезли.
|
||||||
|
procedure TickAge;
|
||||||
|
procedure Invalidate;
|
||||||
|
|
||||||
|
function Active: Boolean;
|
||||||
|
|
||||||
|
// Пересобрать кэш+раскладку, если протух ключ. Вызывается В НАЧАЛЕ кадра:
|
||||||
|
// штрихи рисуются РАНЬШЕ композита полосы, а список штрихов рождается
|
||||||
|
// именно при пересборке — иначе первый кадр после нового спота рисовал бы
|
||||||
|
// старую раскладку.
|
||||||
|
procedure EnsureRendered(W: Integer);
|
||||||
|
|
||||||
|
// CPU-путь: композит полосы подписей вверху Target.
|
||||||
|
procedure DrawOverlay(Target: TBitmap; W, H: Integer);
|
||||||
|
// GL-путь: полоса подписей в Target-битмап (W × BandHeight) под текстуру.
|
||||||
|
procedure DrawOverlayBitmap(Target: TBitmap; W: Integer);
|
||||||
|
|
||||||
|
// Штрихи ниже полосы — рисует вызывающая сторона (RawVLine / GL DrawLine).
|
||||||
|
function TickCount: Integer;
|
||||||
|
procedure Tick(Idx: Integer; out X: Integer; out Color: TColor);
|
||||||
|
|
||||||
|
// Хит-тест по подписи (клик = настроиться на спот).
|
||||||
|
function SpotAtPixel(X, Y: Integer; out Spot: TDXSpot): Boolean;
|
||||||
|
|
||||||
|
property BandHeight: Integer read FBandH;
|
||||||
|
property CenterFreq: Double read FCenterFreq; // для GL-инвалидизации
|
||||||
|
property SpanHz: Double read FSpanHz;
|
||||||
|
property MaxRows: Integer read FMaxRows write SetMaxRows;
|
||||||
|
property Hidden: Integer read FHidden;
|
||||||
|
property CacheDirty: Boolean read FCacheDirty;
|
||||||
|
// Меняется ровно тогда, когда картинка полосы стала другой. GL-путь по нему
|
||||||
|
// решает, перезаливать ли текстуру: он не зависит от того, кто первым
|
||||||
|
// дёрнул пересборку в этом кадре (штрихи или композит).
|
||||||
|
property RenderVersion: Int64 read FRenderVer;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
KEY_COLOR = TColor($00FF00FF); // тот же ключ прозрачности, что у VfoOverlay
|
||||||
|
|
||||||
|
// Палитра (TColor = $00BBGGRR). Своя пара на тему: на тёмном спектре чип
|
||||||
|
// тёмный со светлой подписью, на светлом — наоборот, иначе подписи спотов
|
||||||
|
// на светлой теме сливались бы в грязное пятно.
|
||||||
|
// тёмная тема светлая тема
|
||||||
|
CLR_CHIP_BG: array[Boolean] of TColor = ($00202018, $00F2F2EC);
|
||||||
|
CLR_CHIP_TEXT: array[Boolean] of TColor = ($00F0F0F0, $00181818);
|
||||||
|
CLR_FRESH: array[Boolean] of TColor = ($00E0C040, $00A05800); // свежий
|
||||||
|
CLR_STALE: array[Boolean] of TColor = ($00706850, $00B0A898); // на исходе TTL
|
||||||
|
CLR_OWN: array[Boolean] of TColor = ($0040D0FF, $000060C8); // свой позывной
|
||||||
|
|
||||||
|
CHIP_PAD_X = 3;
|
||||||
|
CHIP_GAP = 3; // минимальный зазор между чипами в одном ряду
|
||||||
|
|
||||||
|
function Mix(A, B: TColor; Num, Den: Integer): TColor;
|
||||||
|
// A→B на Num/Den (0 = A, Den = B).
|
||||||
|
var ra, ga, ba, rb, gb, bb: Integer;
|
||||||
|
begin
|
||||||
|
if Den <= 0 then Exit(A);
|
||||||
|
ra := A and $FF; ga := (A shr 8) and $FF; ba := (A shr 16) and $FF;
|
||||||
|
rb := B and $FF; gb := (B shr 8) and $FF; bb := (B shr 16) and $FF;
|
||||||
|
ra := ra + (rb - ra) * Num div Den;
|
||||||
|
ga := ga + (gb - ga) * Num div Den;
|
||||||
|
ba := ba + (bb - ba) * Num div Den;
|
||||||
|
Result := TColor((ba shl 16) or (ga shl 8) or ra);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ ── Создание / параметры ─────────────────────────────────────────────────── }
|
||||||
|
|
||||||
|
constructor TDXSpotOverlay.Create(AOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(AOwner);
|
||||||
|
FRowH := Round(DXSPOT_ROW_BASE_H * Screen.PixelsPerInch / 96);
|
||||||
|
if FRowH < DXSPOT_ROW_BASE_H then FRowH := DXSPOT_ROW_BASE_H;
|
||||||
|
FMaxRows := 4;
|
||||||
|
FBandH := FRowH * FMaxRows + 4;
|
||||||
|
FCenterFreq := 0;
|
||||||
|
FSpanHz := 0;
|
||||||
|
FEnabled := False;
|
||||||
|
FModes := [];
|
||||||
|
FMaxAgeMin := 0;
|
||||||
|
FCache := TBitmap.Create;
|
||||||
|
FCache.PixelFormat := pf32bit;
|
||||||
|
FCacheW := 0;
|
||||||
|
FCacheDirty := True;
|
||||||
|
FKeyCenter := -1; FKeySpan := -1; FKeyW := -1; FKeyVersion := -1;
|
||||||
|
FKeyEnabled := False; FKeyLight := False; FKeyRows := -1; FKeyAgeTick := -1;
|
||||||
|
FAgeTick := 0;
|
||||||
|
FRenderVer := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TDXSpotOverlay.Destroy;
|
||||||
|
begin
|
||||||
|
FCache.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.Attach(AStore: TDXSpotStore);
|
||||||
|
begin
|
||||||
|
FStore := AStore;
|
||||||
|
FCacheDirty := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.SetView(ACenterHz, ASpanHz: Double);
|
||||||
|
begin
|
||||||
|
if (Abs(ACenterHz - FCenterFreq) < 1.0) and (Abs(ASpanHz - FSpanHz) < 1.0) then Exit;
|
||||||
|
FCenterFreq := ACenterHz;
|
||||||
|
FSpanHz := ASpanHz;
|
||||||
|
FCacheDirty := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.SetEnabled(En: Boolean);
|
||||||
|
begin
|
||||||
|
if FEnabled = En then Exit;
|
||||||
|
FEnabled := En;
|
||||||
|
FCacheDirty := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.SetLightTheme(Light: Boolean);
|
||||||
|
begin
|
||||||
|
if FLightTheme = Light then Exit;
|
||||||
|
FLightTheme := Light;
|
||||||
|
FCacheDirty := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.SetOwnCall(const ACall: string);
|
||||||
|
begin
|
||||||
|
if SameText(FOwnCall, ACall) then Exit;
|
||||||
|
FOwnCall := UpperCase(Trim(ACall));
|
||||||
|
FCacheDirty := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.SetFilters(AModes: TDXModeSet; AMaxAgeMin: Integer);
|
||||||
|
begin
|
||||||
|
if (FModes = AModes) and (FMaxAgeMin = AMaxAgeMin) then Exit;
|
||||||
|
FModes := AModes;
|
||||||
|
FMaxAgeMin := AMaxAgeMin;
|
||||||
|
FCacheDirty := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.SetMaxRows(V: Integer);
|
||||||
|
begin
|
||||||
|
V := EnsureRange(V, 1, DXSPOT_MAX_ROWS);
|
||||||
|
if V = FMaxRows then Exit;
|
||||||
|
FMaxRows := V;
|
||||||
|
FBandH := FRowH * FMaxRows + 4;
|
||||||
|
FCacheDirty := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.TickAge;
|
||||||
|
begin
|
||||||
|
Inc(FAgeTick);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.Invalidate;
|
||||||
|
begin
|
||||||
|
FCacheDirty := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXSpotOverlay.Active: Boolean;
|
||||||
|
begin
|
||||||
|
Result := FEnabled and (FStore <> nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXSpotOverlay.FreqToX(FreqHz: Double; W: Integer): Integer;
|
||||||
|
begin
|
||||||
|
if FSpanHz <= 0 then Result := -1
|
||||||
|
else Result := Round((FreqHz - (FCenterFreq - FSpanHz / 2)) / FSpanHz * W);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXSpotOverlay.AgeColor(const S: TDXSpot): TColor;
|
||||||
|
// Свежий → CLR_FRESH, к концу окна TTL плавно уходит в CLR_STALE. Свой
|
||||||
|
// позывной выделен цветом (и тоже гаснет — иначе старый спот кричал бы
|
||||||
|
// громче свежих). TTL берётся из FLayoutTTL: он посчитан один раз на
|
||||||
|
// раскладку, чтобы не дёргать лок стора на каждый спот.
|
||||||
|
var
|
||||||
|
AgeMin, K: Integer;
|
||||||
|
Base: TColor;
|
||||||
|
begin
|
||||||
|
Base := CLR_FRESH[FLightTheme];
|
||||||
|
if (FOwnCall <> '') and SameText(S.Call, FOwnCall) then
|
||||||
|
Base := CLR_OWN[FLightTheme];
|
||||||
|
if FLayoutTTL <= 0 then Exit(Base);
|
||||||
|
AgeMin := Round((Now - S.Stamp) * 24 * 60);
|
||||||
|
K := EnsureRange(AgeMin * 100 div Max(FLayoutTTL, 1), 0, 100);
|
||||||
|
Result := Mix(Base, CLR_STALE[FLightTheme], K, 100);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ ── Раскладка лесенки ────────────────────────────────────────────────────── }
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.Layout(C: TCanvas; W: Integer);
|
||||||
|
// Споты приходят из стора отсортированными по частоте; каждому даём ПЕРВЫЙ
|
||||||
|
// ряд сверху, где подпись не наезжает на предыдущую. Не нашлось ряда —
|
||||||
|
// спот скрыт (считаем в FHidden), в лесенке дырок не оставляем.
|
||||||
|
var
|
||||||
|
Arr: TDXSpotArray;
|
||||||
|
N, i, r, TW, ChipW, ChipX, Row: Integer;
|
||||||
|
RowRight: array[0..DXSPOT_MAX_ROWS-1] of Integer;
|
||||||
|
LoHz, HiHz: Double;
|
||||||
|
begin
|
||||||
|
FItemCount := 0;
|
||||||
|
FHidden := 0;
|
||||||
|
if (FStore = nil) or (FSpanHz <= 0) or (W <= 0) then Exit;
|
||||||
|
|
||||||
|
// Горизонт затухания: явный фильтр по возрасту, иначе TTL стора (чтение
|
||||||
|
// под локом — поэтому один раз на раскладку, а не на каждый спот).
|
||||||
|
FLayoutTTL := FMaxAgeMin;
|
||||||
|
if FLayoutTTL <= 0 then FLayoutTTL := FStore.TTLMinutes;
|
||||||
|
|
||||||
|
LoHz := FCenterFreq - FSpanHz / 2;
|
||||||
|
HiHz := FCenterFreq + FSpanHz / 2;
|
||||||
|
N := FStore.SnapshotRange(LoHz, HiHz, FModes, FMaxAgeMin, Arr);
|
||||||
|
if N = 0 then Exit;
|
||||||
|
|
||||||
|
for r := 0 to FMaxRows - 1 do RowRight[r] := -CHIP_GAP - 1;
|
||||||
|
SetLength(FItems, N);
|
||||||
|
|
||||||
|
for i := 0 to N - 1 do
|
||||||
|
begin
|
||||||
|
TW := C.TextWidth(Arr[i].Call);
|
||||||
|
ChipW := TW + CHIP_PAD_X * 2;
|
||||||
|
ChipX := FreqToX(Arr[i].FreqHz, W) - ChipW div 2;
|
||||||
|
if ChipX < 0 then ChipX := 0;
|
||||||
|
if ChipX + ChipW > W then ChipX := W - ChipW;
|
||||||
|
if ChipX < 0 then Continue; // подпись шире окна — не рисуем
|
||||||
|
|
||||||
|
Row := -1;
|
||||||
|
for r := 0 to FMaxRows - 1 do
|
||||||
|
if ChipX > RowRight[r] + CHIP_GAP then
|
||||||
|
begin
|
||||||
|
Row := r;
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
if Row < 0 then
|
||||||
|
begin
|
||||||
|
Inc(FHidden);
|
||||||
|
Continue;
|
||||||
|
end;
|
||||||
|
RowRight[Row] := ChipX + ChipW;
|
||||||
|
|
||||||
|
FItems[FItemCount].X := FreqToX(Arr[i].FreqHz, W);
|
||||||
|
FItems[FItemCount].Chip := Rect(ChipX, Row * FRowH + 2,
|
||||||
|
ChipX + ChipW, Row * FRowH + FRowH);
|
||||||
|
FItems[FItemCount].Color := AgeColor(Arr[i]);
|
||||||
|
FItems[FItemCount].Spot := Arr[i];
|
||||||
|
Inc(FItemCount);
|
||||||
|
end;
|
||||||
|
SetLength(FItems, FItemCount);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.DrawSelf(C: TCanvas; W: Integer);
|
||||||
|
// Рендер полосы подписей в канвас W × FBandH. Фон — KEY_COLOR (прозрачный
|
||||||
|
// при композите и в GL-текстуре).
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
R: TRect;
|
||||||
|
Col: TColor;
|
||||||
|
begin
|
||||||
|
C.Brush.Color := KEY_COLOR;
|
||||||
|
C.Brush.Style := bsSolid;
|
||||||
|
C.Pen.Style := psClear;
|
||||||
|
C.FillRect(Rect(0, 0, W, FBandH));
|
||||||
|
|
||||||
|
// Шрифт привязан к высоте ряда (а не к point-size) — подпись влезает при
|
||||||
|
// любом DPI-масштабе, как в бэндплане.
|
||||||
|
C.Font.Name := 'Courier New';
|
||||||
|
C.Font.Style := [fsBold];
|
||||||
|
C.Font.Height := -Max(8, Round(FRowH * 0.62));
|
||||||
|
|
||||||
|
Layout(C, W);
|
||||||
|
|
||||||
|
for i := 0 to FItemCount - 1 do
|
||||||
|
begin
|
||||||
|
R := FItems[i].Chip;
|
||||||
|
Col := FItems[i].Color;
|
||||||
|
|
||||||
|
// Штрих от низа чипа до низа полосы (дальше его продолжает вызывающая
|
||||||
|
// сторона по TickCount/Tick — уже прямо в кадре).
|
||||||
|
if (FItems[i].X >= 0) and (FItems[i].X < W) then
|
||||||
|
begin
|
||||||
|
C.Pen.Style := psSolid; C.Pen.Color := Col; C.Pen.Width := 1;
|
||||||
|
C.MoveTo(FItems[i].X, R.Bottom);
|
||||||
|
C.LineTo(FItems[i].X, FBandH);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Чип: тёмная подложка + кромка цветом спота + позывной.
|
||||||
|
C.Brush.Color := CLR_CHIP_BG[FLightTheme]; C.Brush.Style := bsSolid;
|
||||||
|
C.Pen.Style := psSolid; C.Pen.Color := Col; C.Pen.Width := 1;
|
||||||
|
C.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
|
||||||
|
|
||||||
|
C.Brush.Style := bsClear;
|
||||||
|
C.Font.Color := CLR_CHIP_TEXT[FLightTheme];
|
||||||
|
C.TextOut(R.Left + CHIP_PAD_X,
|
||||||
|
R.Top + (R.Bottom - R.Top - C.TextHeight('W')) div 2,
|
||||||
|
FItems[i].Spot.Call);
|
||||||
|
end;
|
||||||
|
C.Pen.Style := psSolid;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ ── Кэш ──────────────────────────────────────────────────────────────────── }
|
||||||
|
|
||||||
|
function TDXSpotOverlay.NeedsRebuild(W: Integer): Boolean;
|
||||||
|
var HalfPxHz: Double;
|
||||||
|
begin
|
||||||
|
if FStore = nil then Exit(False);
|
||||||
|
// Порог по центру/спану — полпикселя (как в бэндплане): суб-пиксельный
|
||||||
|
// дрейф центра при QO-100 decoder-lock не должен гонять полную пересборку.
|
||||||
|
HalfPxHz := 0.5 * FSpanHz / Max(W, 1);
|
||||||
|
if HalfPxHz < 1.0 then HalfPxHz := 1.0;
|
||||||
|
Result := FCacheDirty or (FCacheW <> W) or (FKeyW <> W)
|
||||||
|
or (FKeyEnabled <> FEnabled)
|
||||||
|
or (FKeyVersion <> FStore.Version)
|
||||||
|
or (FKeyLight <> FLightTheme)
|
||||||
|
or (FKeyRows <> FMaxRows)
|
||||||
|
or (FKeyAgeTick <> FAgeTick)
|
||||||
|
or (Abs(FKeyCenter - FCenterFreq) >= HalfPxHz)
|
||||||
|
or (Abs(FKeySpan - FSpanHz) >= HalfPxHz);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.RebuildCache(W: Integer);
|
||||||
|
begin
|
||||||
|
if (W <= 0) or (FStore = nil) then
|
||||||
|
begin
|
||||||
|
FCacheW := 0; FCacheDirty := False; FItemCount := 0;
|
||||||
|
Inc(FRenderVer);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if (FCache.Width <> W) or (FCache.Height <> FBandH) then
|
||||||
|
FCache.SetSize(W, FBandH);
|
||||||
|
DrawSelf(FCache.Canvas, W);
|
||||||
|
Inc(FRenderVer);
|
||||||
|
FCacheW := W;
|
||||||
|
FKeyCenter := FCenterFreq;
|
||||||
|
FKeySpan := FSpanHz;
|
||||||
|
FKeyW := W;
|
||||||
|
FKeyEnabled := FEnabled;
|
||||||
|
FKeyVersion := FStore.Version;
|
||||||
|
FKeyLight := FLightTheme;
|
||||||
|
FKeyRows := FMaxRows;
|
||||||
|
FKeyAgeTick := FAgeTick;
|
||||||
|
FCacheDirty := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ ── Рисование ────────────────────────────────────────────────────────────── }
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.EnsureRendered(W: Integer);
|
||||||
|
begin
|
||||||
|
if (not Active) or (W <= 0) then Exit;
|
||||||
|
if NeedsRebuild(W) then RebuildCache(W);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.DrawOverlay(Target: TBitmap; W, H: Integer);
|
||||||
|
begin
|
||||||
|
if (not Active) or (Target = nil) or (W <= 0) or (H <= FBandH) then Exit;
|
||||||
|
EnsureRendered(W);
|
||||||
|
if FCacheW <= 0 then Exit;
|
||||||
|
BlendBitmapKey(Target, FCache, 0, 0, DXSPOT_ALPHA);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.DrawOverlayBitmap(Target: TBitmap; W: Integer);
|
||||||
|
begin
|
||||||
|
if (Target = nil) or (W <= 0) then Exit;
|
||||||
|
// Раскладка/список штрихов должны быть свежими и в GL-пути.
|
||||||
|
EnsureRendered(W);
|
||||||
|
Target.PixelFormat := pf32bit;
|
||||||
|
Target.SetSize(W, FBandH);
|
||||||
|
Target.Canvas.Draw(0, 0, FCache);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXSpotOverlay.TickCount: Integer;
|
||||||
|
begin
|
||||||
|
if not Active then Result := 0 else Result := FItemCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotOverlay.Tick(Idx: Integer; out X: Integer; out Color: TColor);
|
||||||
|
begin
|
||||||
|
if (Idx < 0) or (Idx >= FItemCount) then
|
||||||
|
begin
|
||||||
|
X := -1; Color := clNone;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
X := FItems[Idx].X;
|
||||||
|
Color := FItems[Idx].Color;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXSpotOverlay.SpotAtPixel(X, Y: Integer; out Spot: TDXSpot): Boolean;
|
||||||
|
// Хит только по полосе подписей: ниже неё живут тюнинг/маркеры/слайсы, и
|
||||||
|
// перехватывать там клик было бы поперёк привычного поведения спектра.
|
||||||
|
var i: Integer;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if (not Active) or (Y < 0) or (Y > FBandH) then Exit;
|
||||||
|
for i := 0 to FItemCount - 1 do
|
||||||
|
if (X >= FItems[i].Chip.Left - 2) and (X <= FItems[i].Chip.Right + 2) and
|
||||||
|
(Y >= FItems[i].Chip.Top - 2) and (Y <= FItems[i].Chip.Bottom + 2) then
|
||||||
|
begin
|
||||||
|
Spot := FItems[i].Spot;
|
||||||
|
Exit(True);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
+382
@@ -0,0 +1,382 @@
|
|||||||
|
unit DXSpotStore;
|
||||||
|
|
||||||
|
{
|
||||||
|
DXSpotStore.pas — потокобезопасное хранилище DX-спотов.
|
||||||
|
|
||||||
|
Единственная точка обмена между сетевым потоком кластера (TDXClusterClient,
|
||||||
|
пишет) и UI (оверлей спектра + окно списка, читают). Поэтому здесь НЕТ ни
|
||||||
|
Synchronize, ни очередей в главный поток: поток кластера кладёт спот прямо
|
||||||
|
сюда под критической секцией, а UI замечает изменение по монотонному
|
||||||
|
счётчику Version — ровно так же, как оверлеи замечают смену вида по своим
|
||||||
|
ключам кэша. Никаких LCL-зависимостей (юнит компилируется и в headless).
|
||||||
|
|
||||||
|
Дедуп: спот с тем же позывным в пределах DEDUP_HZ считается тем же самым —
|
||||||
|
обновляем частоту/время/комментарий, а не плодим строки. Тот же позывной на
|
||||||
|
другом диапазоне — отдельная запись.
|
||||||
|
|
||||||
|
TTL: споты старше FTTLMinutes выбрасываются при каждой правке/снимке.
|
||||||
|
}
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$MODE Delphi}
|
||||||
|
{$LONGSTRINGS ON}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils, Classes, SyncObjs, DateUtils, StrUtils; // StrUtils — PosEx
|
||||||
|
|
||||||
|
const
|
||||||
|
DX_DEDUP_HZ = 5000.0; // тот же позывной в этом окне = тот же спот
|
||||||
|
DX_DEFAULT_TTL = 30; // мин
|
||||||
|
DX_DEFAULT_MAX = 500; // потолок записей
|
||||||
|
|
||||||
|
type
|
||||||
|
// Мода спота. Определяется по комментарию кластера (FT8/CW/…), при неудаче —
|
||||||
|
// остаётся dxmUnknown: гадать по частоте не пытаемся, бэндпланы разные.
|
||||||
|
TDXMode = (dxmUnknown, dxmCW, dxmSSB, dxmDigi, dxmFT8, dxmFT4, dxmRTTY,
|
||||||
|
dxmPSK, dxmFM, dxmSSTV);
|
||||||
|
|
||||||
|
TDXModeSet = set of TDXMode;
|
||||||
|
|
||||||
|
TDXSpot = record
|
||||||
|
FreqHz: Double; // частота DX-станции, Гц (кластер отдаёт кГц)
|
||||||
|
Call: string; // позывной DX
|
||||||
|
Spotter: string; // кто заспотил
|
||||||
|
Comment: string; // комментарий кластера (уже без времени)
|
||||||
|
TimeUTC: string; // 'HHMM' как пришло от кластера
|
||||||
|
Stamp: TDateTime; // локальное время приёма — для TTL и затухания
|
||||||
|
Mode: TDXMode;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDXSpotArray = array of TDXSpot;
|
||||||
|
|
||||||
|
TDXSpotStore = class
|
||||||
|
private
|
||||||
|
FLock: TCriticalSection;
|
||||||
|
FSpots: TDXSpotArray;
|
||||||
|
FCount: Integer;
|
||||||
|
FVersion: Int64;
|
||||||
|
FTTLMinutes: Integer;
|
||||||
|
FMaxSpots: Integer;
|
||||||
|
procedure PurgeLocked;
|
||||||
|
procedure DropOldestLocked;
|
||||||
|
function GetTTLMinutes: Integer;
|
||||||
|
procedure SetTTLMinutes(V: Integer);
|
||||||
|
function GetMaxSpots: Integer;
|
||||||
|
procedure SetMaxSpots(V: Integer);
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
// Добавить/обновить спот (вызывается из потока кластера).
|
||||||
|
procedure Add(const S: TDXSpot);
|
||||||
|
procedure Clear;
|
||||||
|
|
||||||
|
// Снимок всех спотов, отсортированный по частоте.
|
||||||
|
function Snapshot(out Arr: TDXSpotArray): Integer;
|
||||||
|
// Снимок окна [LoHz..HiHz] с фильтром по моде (Modes = [] — без фильтра)
|
||||||
|
// и по возрасту (MaxAgeMin <= 0 — только общий TTL). Для оверлея.
|
||||||
|
function SnapshotRange(LoHz, HiHz: Double; Modes: TDXModeSet;
|
||||||
|
MaxAgeMin: Integer; out Arr: TDXSpotArray): Integer;
|
||||||
|
|
||||||
|
// Монотонный счётчик правок — ключ инвалидации кэша оверлея/списка.
|
||||||
|
function Version: Int64;
|
||||||
|
function Count: Integer;
|
||||||
|
|
||||||
|
// Читаются сетевым потоком (PurgeLocked/Add), пишутся из UI — только через
|
||||||
|
// критическую секцию, как и всё остальное состояние стора.
|
||||||
|
property TTLMinutes: Integer read GetTTLMinutes write SetTTLMinutes;
|
||||||
|
property MaxSpots: Integer read GetMaxSpots write SetMaxSpots;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Мода по комментарию кластера ('FT8 -12 dB' → dxmFT8). Пусто/непонятно —
|
||||||
|
// dxmUnknown.
|
||||||
|
function DXModeFromComment(const Comment: string): TDXMode;
|
||||||
|
function DXModeName(M: TDXMode): string;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
MODE_NAMES: array[TDXMode] of string =
|
||||||
|
('', 'CW', 'SSB', 'DIGI', 'FT8', 'FT4', 'RTTY', 'PSK', 'FM', 'SSTV');
|
||||||
|
|
||||||
|
function DXModeName(M: TDXMode): string;
|
||||||
|
begin
|
||||||
|
Result := MODE_NAMES[M];
|
||||||
|
end;
|
||||||
|
|
||||||
|
function DXModeFromComment(const Comment: string): TDXMode;
|
||||||
|
// Ищем маркер моды как ОТДЕЛЬНОЕ слово: 'CW' внутри 'CWOPS' или позывного
|
||||||
|
// модой не является. Порядок проверки — от длинных/специфичных к общим.
|
||||||
|
var
|
||||||
|
U: string;
|
||||||
|
|
||||||
|
function HasWord(const W: string): Boolean;
|
||||||
|
var P, L, N: Integer; OkL, OkR: Boolean;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
L := Length(W); N := Length(U);
|
||||||
|
P := Pos(W, U);
|
||||||
|
while P > 0 do
|
||||||
|
begin
|
||||||
|
OkL := (P = 1) or not (U[P-1] in ['A'..'Z', '0'..'9', '/', '-']);
|
||||||
|
OkR := (P + L > N) or not (U[P+L] in ['A'..'Z', '0'..'9', '/', '-']);
|
||||||
|
if OkL and OkR then Exit(True);
|
||||||
|
P := PosEx(W, U, P + 1);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := dxmUnknown;
|
||||||
|
if Comment = '' then Exit;
|
||||||
|
U := UpperCase(Comment);
|
||||||
|
if HasWord('FT8') then Result := dxmFT8
|
||||||
|
else if HasWord('FT4') then Result := dxmFT4
|
||||||
|
else if HasWord('RTTY') then Result := dxmRTTY
|
||||||
|
else if HasWord('PSK') or HasWord('PSK31') or HasWord('BPSK') then Result := dxmPSK
|
||||||
|
else if HasWord('SSTV') then Result := dxmSSTV
|
||||||
|
else if HasWord('CW') then Result := dxmCW
|
||||||
|
else if HasWord('SSB') or HasWord('USB') or HasWord('LSB') then Result := dxmSSB
|
||||||
|
else if HasWord('FM') then Result := dxmFM
|
||||||
|
else if HasWord('JT65') or HasWord('JT9') or HasWord('JS8') or
|
||||||
|
HasWord('MSK144') or HasWord('OLIVIA') or HasWord('DIGI') then
|
||||||
|
Result := dxmDigi;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ ── TDXSpotStore ─────────────────────────────────────────────────────────── }
|
||||||
|
|
||||||
|
constructor TDXSpotStore.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
FLock := TCriticalSection.Create;
|
||||||
|
FCount := 0;
|
||||||
|
FVersion := 0;
|
||||||
|
FTTLMinutes := DX_DEFAULT_TTL;
|
||||||
|
FMaxSpots := DX_DEFAULT_MAX;
|
||||||
|
SetLength(FSpots, DX_DEFAULT_MAX);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TDXSpotStore.Destroy;
|
||||||
|
begin
|
||||||
|
FLock.Free;
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotStore.PurgeLocked;
|
||||||
|
// Выбрасывает споты старше TTL, уплотняя массив на месте.
|
||||||
|
var
|
||||||
|
i, Dst: Integer;
|
||||||
|
Cutoff: TDateTime;
|
||||||
|
begin
|
||||||
|
if FTTLMinutes <= 0 then Exit;
|
||||||
|
Cutoff := IncMinute(Now, -FTTLMinutes);
|
||||||
|
Dst := 0;
|
||||||
|
for i := 0 to FCount - 1 do
|
||||||
|
if FSpots[i].Stamp >= Cutoff then
|
||||||
|
begin
|
||||||
|
if Dst <> i then FSpots[Dst] := FSpots[i];
|
||||||
|
Inc(Dst);
|
||||||
|
end;
|
||||||
|
if Dst <> FCount then
|
||||||
|
begin
|
||||||
|
FCount := Dst;
|
||||||
|
Inc(FVersion);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotStore.DropOldestLocked;
|
||||||
|
var i, Oldest: Integer;
|
||||||
|
begin
|
||||||
|
if FCount <= 0 then Exit;
|
||||||
|
Oldest := 0;
|
||||||
|
for i := 1 to FCount - 1 do
|
||||||
|
if FSpots[i].Stamp < FSpots[Oldest].Stamp then Oldest := i;
|
||||||
|
for i := Oldest to FCount - 2 do FSpots[i] := FSpots[i + 1];
|
||||||
|
Dec(FCount);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotStore.Add(const S: TDXSpot);
|
||||||
|
var
|
||||||
|
i: Integer;
|
||||||
|
UCall: string;
|
||||||
|
begin
|
||||||
|
if S.Call = '' then Exit;
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
PurgeLocked;
|
||||||
|
UCall := UpperCase(S.Call);
|
||||||
|
for i := 0 to FCount - 1 do
|
||||||
|
if (UpperCase(FSpots[i].Call) = UCall) and
|
||||||
|
(Abs(FSpots[i].FreqHz - S.FreqHz) <= DX_DEDUP_HZ) then
|
||||||
|
begin
|
||||||
|
FSpots[i] := S; // тот же спот — обновляем целиком
|
||||||
|
Inc(FVersion);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if Length(FSpots) < FMaxSpots then SetLength(FSpots, FMaxSpots);
|
||||||
|
while FCount >= FMaxSpots do DropOldestLocked;
|
||||||
|
FSpots[FCount] := S;
|
||||||
|
Inc(FCount);
|
||||||
|
Inc(FVersion);
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotStore.Clear;
|
||||||
|
begin
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
if FCount = 0 then Exit;
|
||||||
|
FCount := 0;
|
||||||
|
Inc(FVersion);
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function CompareSpotFreq(const A, B: TDXSpot): Integer;
|
||||||
|
begin
|
||||||
|
if A.FreqHz < B.FreqHz then Result := -1
|
||||||
|
else if A.FreqHz > B.FreqHz then Result := 1
|
||||||
|
else Result := 0;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure SortByFreq(var Arr: TDXSpotArray; N: Integer);
|
||||||
|
// Вставками: N здесь десятки-сотни и массив почти всегда уже почти
|
||||||
|
// отсортирован (споты приходят вперемешку, но окно узкое).
|
||||||
|
var i, j: Integer; T: TDXSpot;
|
||||||
|
begin
|
||||||
|
for i := 1 to N - 1 do
|
||||||
|
begin
|
||||||
|
T := Arr[i];
|
||||||
|
j := i - 1;
|
||||||
|
while (j >= 0) and (CompareSpotFreq(Arr[j], T) > 0) do
|
||||||
|
begin
|
||||||
|
Arr[j + 1] := Arr[j];
|
||||||
|
Dec(j);
|
||||||
|
end;
|
||||||
|
Arr[j + 1] := T;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXSpotStore.Snapshot(out Arr: TDXSpotArray): Integer;
|
||||||
|
var i: Integer;
|
||||||
|
begin
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
PurgeLocked;
|
||||||
|
SetLength(Arr, FCount);
|
||||||
|
for i := 0 to FCount - 1 do Arr[i] := FSpots[i];
|
||||||
|
Result := FCount;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
SortByFreq(Arr, Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXSpotStore.SnapshotRange(LoHz, HiHz: Double; Modes: TDXModeSet;
|
||||||
|
MaxAgeMin: Integer; out Arr: TDXSpotArray): Integer;
|
||||||
|
var
|
||||||
|
i, N: Integer;
|
||||||
|
Cutoff: TDateTime;
|
||||||
|
UseAge: Boolean;
|
||||||
|
begin
|
||||||
|
N := 0;
|
||||||
|
UseAge := MaxAgeMin > 0;
|
||||||
|
Cutoff := 0;
|
||||||
|
if UseAge then Cutoff := IncMinute(Now, -MaxAgeMin);
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
PurgeLocked;
|
||||||
|
SetLength(Arr, FCount);
|
||||||
|
for i := 0 to FCount - 1 do
|
||||||
|
begin
|
||||||
|
if (FSpots[i].FreqHz < LoHz) or (FSpots[i].FreqHz > HiHz) then Continue;
|
||||||
|
if (Modes <> []) and not (FSpots[i].Mode in Modes) then Continue;
|
||||||
|
if UseAge and (FSpots[i].Stamp < Cutoff) then Continue;
|
||||||
|
Arr[N] := FSpots[i];
|
||||||
|
Inc(N);
|
||||||
|
end;
|
||||||
|
SetLength(Arr, N);
|
||||||
|
Result := N;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
SortByFreq(Arr, Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXSpotStore.GetTTLMinutes: Integer;
|
||||||
|
begin
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
Result := FTTLMinutes;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotStore.SetTTLMinutes(V: Integer);
|
||||||
|
begin
|
||||||
|
if V < 1 then V := 1;
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
if FTTLMinutes = V then Exit;
|
||||||
|
FTTLMinutes := V;
|
||||||
|
PurgeLocked; // укоротили TTL — лишнее выбрасываем сразу
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXSpotStore.GetMaxSpots: Integer;
|
||||||
|
begin
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
Result := FMaxSpots;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TDXSpotStore.SetMaxSpots(V: Integer);
|
||||||
|
begin
|
||||||
|
if V < 16 then V := 16;
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
if FMaxSpots = V then Exit;
|
||||||
|
FMaxSpots := V;
|
||||||
|
if Length(FSpots) < FMaxSpots then SetLength(FSpots, FMaxSpots);
|
||||||
|
while FCount > FMaxSpots do
|
||||||
|
begin
|
||||||
|
DropOldestLocked;
|
||||||
|
Inc(FVersion);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXSpotStore.Version: Int64;
|
||||||
|
begin
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
Result := FVersion;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TDXSpotStore.Count: Integer;
|
||||||
|
begin
|
||||||
|
FLock.Enter;
|
||||||
|
try
|
||||||
|
Result := FCount;
|
||||||
|
finally
|
||||||
|
FLock.Leave;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
@@ -69,6 +69,10 @@ type
|
|||||||
property Visible;
|
property Visible;
|
||||||
property OnClick;
|
property OnClick;
|
||||||
property OnDblClick;
|
property OnDblClick;
|
||||||
|
// Клавиатура: собственный KeyDown обрабатывает стрелки/PgUp/Home, а
|
||||||
|
// необработанные клавиши (Enter и прочее) достаются владельцу через
|
||||||
|
// inherited — поэтому событие имеет смысл публиковать.
|
||||||
|
property OnKeyDown;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|||||||
@@ -23,6 +23,7 @@ type
|
|||||||
FScrollBar: TOverlayScrollBar;
|
FScrollBar: TOverlayScrollBar;
|
||||||
FTheme: TAppTheme;
|
FTheme: TAppTheme;
|
||||||
FSyncing: Boolean;
|
FSyncing: Boolean;
|
||||||
|
FOnChange: TNotifyEvent;
|
||||||
function GetLines: TStrings;
|
function GetLines: TStrings;
|
||||||
function GetReadOnly: Boolean;
|
function GetReadOnly: Boolean;
|
||||||
procedure SetReadOnly(AValue: Boolean);
|
procedure SetReadOnly(AValue: Boolean);
|
||||||
@@ -65,6 +66,8 @@ type
|
|||||||
property TabOrder;
|
property TabOrder;
|
||||||
property TabStop;
|
property TabStop;
|
||||||
property Visible;
|
property Visible;
|
||||||
|
// Правка текста пользователем (проброс OnChange внутреннего TMemo).
|
||||||
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@@ -192,6 +195,7 @@ end;
|
|||||||
procedure TFlatMemo.MemoChange(Sender: TObject);
|
procedure TFlatMemo.MemoChange(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
UpdateScrollBar;
|
UpdateScrollBar;
|
||||||
|
if Assigned(FOnChange) then FOnChange(Self);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TFlatMemo.MemoKeyUp(Sender: TObject; var Key: Word;
|
procedure TFlatMemo.MemoKeyUp(Sender: TObject; var Key: Word;
|
||||||
|
|||||||
+254
-3
@@ -22,8 +22,9 @@ unit MainForm;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, StrUtils, FreqDisplay, DeviceForm, FilterPopup,
|
Classes, SysUtils, StrUtils, DateUtils, FreqDisplay, DeviceForm, FilterPopup,
|
||||||
VfoOverlay, SampleRateOverlay, BandPlanOverlay,
|
VfoOverlay, SampleRateOverlay, BandPlanOverlay,
|
||||||
|
DXSpotStore, DXClusterClient, DXSpotOverlay, DXClusterForm,
|
||||||
FlatButton, FlatSlider, FlatDropDown, OverlayScrollBar, AppTheme,
|
FlatButton, FlatSlider, FlatDropDown, OverlayScrollBar, AppTheme,
|
||||||
Forms, Controls, Graphics, Dialogs,
|
Forms, Controls, Graphics, Dialogs,
|
||||||
StdCtrls, ExtCtrls, Buttons, Menus, Math, Types, SyncObjs,
|
StdCtrls, ExtCtrls, Buttons, Menus, Math, Types, SyncObjs,
|
||||||
@@ -139,7 +140,18 @@ type
|
|||||||
FSliceDrag: Boolean; // тащим маркер несущей слайса по спектру
|
FSliceDrag: Boolean; // тащим маркер несущей слайса по спектру
|
||||||
FSliceDragId: Integer; // какой слайс тащим
|
FSliceDragId: Integer; // какой слайс тащим
|
||||||
FSampleRateOverlay: TSampleRateOverlay; // оверлей span/hide слева вверху спектра
|
FSampleRateOverlay: TSampleRateOverlay; // оверлей span/hide слева вверху спектра
|
||||||
FBandPlanOverlay: TBandPlanOverlay; // полоска бэндплана QO-100 внизу спектра
|
FBandPlanOverlay: TBandPlanOverlay; // полоска бэндплана QO-100
|
||||||
|
// ── DX-кластер ────────────────────────────────────────────────────────
|
||||||
|
FDXStore: TDXSpotStore; // общая база спотов (поток кластера пишет)
|
||||||
|
FDXClient: TDXClusterClient; // telnet-соединение (свой поток)
|
||||||
|
FDXSpotOverlay: TDXSpotOverlay; // подписи спотов на спектре
|
||||||
|
FDXClusterForm: TDXClusterForm; // окно списка (ПКМ по кнопке DX)
|
||||||
|
FDXCfg: TDXClusterSettings;
|
||||||
|
FDXConnCfg: TDXClusterSettings; // параметры, с которыми поднят клиент
|
||||||
|
FDXPendingCfg: TDXClusterSettings; // правки SETUP, ждущие тишины
|
||||||
|
FDXPending: Boolean;
|
||||||
|
FDXPendingAt: TDateTime;
|
||||||
|
FDXAgeTickAt: TDateTime; // когда последний раз гасили старые споты внизу спектра
|
||||||
FPanelHidden: Boolean; // True = левая панель скрыта
|
FPanelHidden: Boolean; // True = левая панель скрыта
|
||||||
FLeftPanelW: Integer; // ширина панели до скрытия (DPI-safe restore)
|
FLeftPanelW: Integer; // ширина панели до скрытия (DPI-safe restore)
|
||||||
FPendingBoardType: Integer; // BoardType устройства для подключения
|
FPendingBoardType: Integer; // BoardType устройства для подключения
|
||||||
@@ -263,6 +275,7 @@ type
|
|||||||
BtnDiscover: TFlatButton;
|
BtnDiscover: TFlatButton;
|
||||||
BtnStartStop: TFlatButton;
|
BtnStartStop: TFlatButton;
|
||||||
BtnSettings: TFlatButton;
|
BtnSettings: TFlatButton;
|
||||||
|
BtnDXCluster: TFlatButton; // ЛКМ — споты на спектре, ПКМ — окно кластера
|
||||||
|
|
||||||
// ---- Left panel ----
|
// ---- Left panel ----
|
||||||
PanelLeft: TPanel;
|
PanelLeft: TPanel;
|
||||||
@@ -497,6 +510,19 @@ type
|
|||||||
procedure BtnRxMuteClick(Sender: TObject);
|
procedure BtnRxMuteClick(Sender: TObject);
|
||||||
procedure UpdateRxMuteButton; // видимость (Pluto+full-duplex) + стиль кнопки RX MUTE
|
procedure UpdateRxMuteButton; // видимость (Pluto+full-duplex) + стиль кнопки RX MUTE
|
||||||
procedure UpdateBandPlanOverlay; // вкл/выкл полоски бэндплана QO-100 по InQO100
|
procedure UpdateBandPlanOverlay; // вкл/выкл полоски бэндплана QO-100 по InQO100
|
||||||
|
// ── DX-кластер ────────────────────────────────────────────────────────
|
||||||
|
procedure InitDXCluster; // стор+клиент+оверлей, чтение настроек
|
||||||
|
procedure ServiceDXCluster; // тик затухания спотов (редкий)
|
||||||
|
procedure ApplyDXClusterSettings(const D: TDXClusterSettings);
|
||||||
|
procedure UpdateDXClusterButton;
|
||||||
|
procedure BtnDXClusterClick(Sender: TObject);
|
||||||
|
procedure BtnDXClusterMouseDown(Sender: TObject; Button: TMouseButton;
|
||||||
|
Shift: TShiftState; X, Y: Integer);
|
||||||
|
procedure ShowDXClusterForm;
|
||||||
|
procedure ApplyDXConnection(const D: TDXClusterSettings);
|
||||||
|
procedure OnDXClusterSettingsChange(const D: TDXClusterSettings);
|
||||||
|
procedure CommitDXClusterSettings;
|
||||||
|
procedure OnDXTuneSpot(FreqHz: Double; Mode: TDXMode);
|
||||||
procedure BtnTUNClick(Sender: TObject);
|
procedure BtnTUNClick(Sender: TObject);
|
||||||
procedure ApplyTUN(Active: Boolean);
|
procedure ApplyTUN(Active: Boolean);
|
||||||
// PureSignal: ЛКМ по PS = вкл/выкл, ПКМ = поповер настроек.
|
// PureSignal: ЛКМ по PS = вкл/выкл, ПКМ = поповер настроек.
|
||||||
@@ -1373,6 +1399,17 @@ begin
|
|||||||
PanelSplitter := nil;
|
PanelSplitter := nil;
|
||||||
PbWaterfall := nil;
|
PbWaterfall := nil;
|
||||||
PbPanZoom := nil;
|
PbPanZoom := nil;
|
||||||
|
// DX-кластер: незакоммиченную правку SETUP дописываем в конфиг (соединение
|
||||||
|
// при этом не трогаем — программа закрывается), гасим сетевой поток (его
|
||||||
|
// Stop делает shutdown сокета и ждёт поток), потом базу спотов — оверлей
|
||||||
|
// к этому моменту уже мёртв вместе с view пана.
|
||||||
|
if FDXPending then
|
||||||
|
begin
|
||||||
|
FDXPending := False;
|
||||||
|
FController.FSettings.SaveDXClusterSettings(FDXPendingCfg);
|
||||||
|
end;
|
||||||
|
FreeAndNil(FDXClient);
|
||||||
|
FreeAndNil(FDXStore);
|
||||||
DestroyAllExtraPans; // доп. паны (DDC/движок/панели) — до пана 0
|
DestroyAllExtraPans; // доп. паны (DDC/движок/панели) — до пана 0
|
||||||
FreeAndNil(FPan);
|
FreeAndNil(FPan);
|
||||||
FPans[0] := nil;
|
FPans[0] := nil;
|
||||||
@@ -1976,6 +2013,10 @@ begin
|
|||||||
BtnDiscover := MakeBtn(PanelToolbar, 'DISCOVER', X, 3, 80, BTN_H, BtnDiscoverClick);
|
BtnDiscover := MakeBtn(PanelToolbar, 'DISCOVER', X, 3, 80, BTN_H, BtnDiscoverClick);
|
||||||
BtnStartStop := MakeBtn(PanelToolbar, 'START', X+84, 3, 76, BTN_H, BtnStartStopClick);
|
BtnStartStop := MakeBtn(PanelToolbar, 'START', X+84, 3, 76, BTN_H, BtnStartStopClick);
|
||||||
BtnSettings := MakeBtn(PanelToolbar, 'SETUP', X+164, 3, 66, BTN_H, BtnSettingsClick);
|
BtnSettings := MakeBtn(PanelToolbar, 'SETUP', X+164, 3, 66, BTN_H, BtnSettingsClick);
|
||||||
|
// DX — споты кластера: ЛКМ включает/выключает подписи на спектре, ПКМ
|
||||||
|
// открывает окно списка (та же семантика, что у BEACON → окно констелляции).
|
||||||
|
BtnDXCluster := MakeBtn(PanelToolbar, 'DX', X+234, 3, 46, BTN_H, BtnDXClusterClick);
|
||||||
|
BtnDXCluster.OnMouseDown := BtnDXClusterMouseDown;
|
||||||
|
|
||||||
// DISCOVER — синеватый акцент
|
// DISCOVER — синеватый акцент
|
||||||
BtnDiscover.ClrNorm := TColor($00101828);
|
BtnDiscover.ClrNorm := TColor($00101828);
|
||||||
@@ -2641,6 +2682,9 @@ begin
|
|||||||
FBandPlanOverlay.SetView(FController.FCenterFreq, FController.FSpanHz);
|
FBandPlanOverlay.SetView(FController.FCenterFreq, FController.FSpanHz);
|
||||||
FSpecView.BandPlanOverlay := FBandPlanOverlay;
|
FSpecView.BandPlanOverlay := FBandPlanOverlay;
|
||||||
|
|
||||||
|
// DX-кластер: база спотов + сетевой поток + оверлей подписей.
|
||||||
|
InitDXCluster;
|
||||||
|
|
||||||
// S-метр — внутри PanelToolbar, справа
|
// S-метр — внутри PanelToolbar, справа
|
||||||
PanelSMeterRight := TPanel.Create(Self);
|
PanelSMeterRight := TPanel.Create(Self);
|
||||||
PanelSMeterRight.Parent := PanelToolbar;
|
PanelSMeterRight.Parent := PanelToolbar;
|
||||||
@@ -2763,6 +2807,9 @@ begin
|
|||||||
SafeLeft := MARGIN;
|
SafeLeft := MARGIN;
|
||||||
if BtnSettings <> nil then
|
if BtnSettings <> nil then
|
||||||
SafeLeft := BtnSettings.Left + BtnSettings.Width + SETTINGS_GAP;
|
SafeLeft := BtnSettings.Left + BtnSettings.Width + SETTINGS_GAP;
|
||||||
|
// Кнопка DX стоит правее SETUP — группа VFO начинается уже за ней.
|
||||||
|
if (BtnDXCluster <> nil) and BtnDXCluster.Visible then
|
||||||
|
SafeLeft := Max(SafeLeft, BtnDXCluster.Left + BtnDXCluster.Width + SETTINGS_GAP);
|
||||||
SafeRight := ClientWidth - MARGIN;
|
SafeRight := ClientWidth - MARGIN;
|
||||||
if PanelLeft <> nil then
|
if PanelLeft <> nil then
|
||||||
begin
|
begin
|
||||||
@@ -3301,6 +3348,9 @@ begin
|
|||||||
BtnStartStop.ClrTextAct:= T.TbStartText;
|
BtnStartStop.ClrTextAct:= T.TbStartText;
|
||||||
BtnStartStop.Invalidate;
|
BtnStartStop.Invalidate;
|
||||||
StyleButton(BtnSettings, False);
|
StyleButton(BtnSettings, False);
|
||||||
|
// DX — тумблер подписей спотов: состояние берём из самой кнопки, как у
|
||||||
|
// прочих тумблеров ниже (BtnCTun/BtnBeacon).
|
||||||
|
if BtnDXCluster <> nil then StyleButton(BtnDXCluster, BtnDXCluster.Active);
|
||||||
|
|
||||||
// Обычные кнопки — все массивы
|
// Обычные кнопки — все массивы
|
||||||
for i := 0 to BAND_COUNT-1 do StyleButton(BtnBand[i], BtnBand[i].Active);
|
for i := 0 to BAND_COUNT-1 do StyleButton(BtnBand[i], BtnBand[i].Active);
|
||||||
@@ -3451,6 +3501,8 @@ begin
|
|||||||
if FCWMsgForm <> nil then TCWMessagesForm(FCWMsgForm).ApplyTheme(T);
|
if FCWMsgForm <> nil then TCWMessagesForm(FCWMsgForm).ApplyTheme(T);
|
||||||
if FCWTermForm <> nil then TCWTerminalForm(FCWTermForm).ApplyTheme(T);
|
if FCWTermForm <> nil then TCWTerminalForm(FCWTermForm).ApplyTheme(T);
|
||||||
if FBeaconScopeForm <> nil then FBeaconScopeForm.ApplyTheme(T);
|
if FBeaconScopeForm <> nil then FBeaconScopeForm.ApplyTheme(T);
|
||||||
|
if FDXClusterForm <> nil then FDXClusterForm.ApplyTheme(T);
|
||||||
|
if FDXSpotOverlay <> nil then FDXSpotOverlay.SetLightTheme(FLightTheme);
|
||||||
FController.FSettings.SaveTheme(V);
|
FController.FSettings.SaveTheme(V);
|
||||||
FController.FSettings.Save;
|
FController.FSettings.Save;
|
||||||
if (FSettingsForm <> nil) and TSettingsForm(FSettingsForm).Visible then
|
if (FSettingsForm <> nil) and TSettingsForm(FSettingsForm).Visible then
|
||||||
@@ -3690,6 +3742,9 @@ begin
|
|||||||
// отсекает неизменное → пересборки кэша на каждый вызов нет.
|
// отсекает неизменное → пересборки кэша на каждый вызов нет.
|
||||||
if Assigned(FBandPlanOverlay) then
|
if Assigned(FBandPlanOverlay) then
|
||||||
FBandPlanOverlay.SetView(ViewCenter, ViewSpan);
|
FBandPlanOverlay.SetView(ViewCenter, ViewSpan);
|
||||||
|
// Подписи спотов — тот же видимый домен, что у бэндплана.
|
||||||
|
if Assigned(FDXSpotOverlay) then
|
||||||
|
FDXSpotOverlay.SetView(ViewCenter, ViewSpan);
|
||||||
if UpdateWidebandFrequencyView and FController.FShowWideband and (PbWideband <> nil) then
|
if UpdateWidebandFrequencyView and FController.FShowWideband and (PbWideband <> nil) then
|
||||||
PbWideband.Invalidate;
|
PbWideband.Invalidate;
|
||||||
UpdatePanZoomBar; // линейка пана следует за частотой/зумом (no-op если без изменений)
|
UpdatePanZoomBar; // линейка пана следует за частотой/зумом (no-op если без изменений)
|
||||||
@@ -3714,6 +3769,9 @@ var
|
|||||||
PeakDiff, MinDiff: Double;
|
PeakDiff, MinDiff: Double;
|
||||||
PeakAlpha, MinAlpha: Double;
|
PeakAlpha, MinAlpha: Double;
|
||||||
begin
|
begin
|
||||||
|
// Затухание спотов не зависит от того, крутится ли приём.
|
||||||
|
ServiceDXCluster;
|
||||||
|
|
||||||
if not FController.FRunning then
|
if not FController.FRunning then
|
||||||
begin
|
begin
|
||||||
if PbSMeterRight <> nil then PbSMeterRight.Invalidate;
|
if PbSMeterRight <> nil then PbSMeterRight.Invalidate;
|
||||||
@@ -4947,6 +5005,186 @@ begin
|
|||||||
StyleButton(BtnRxMute, FController.FRxMuteOnTx);
|
StyleButton(BtnRxMute, FController.FRxMuteOnTx);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
// ═══════════════════════════════════════════════════════════════════════════
|
||||||
|
// DX-кластер: база спотов + telnet-клиент + оверлей подписей на спектре
|
||||||
|
// ═══════════════════════════════════════════════════════════════════════════
|
||||||
|
|
||||||
|
function DXModeSetFromMask(Mask: LongWord): TDXModeSet;
|
||||||
|
// Маска настроек → множество мод. 0 = без фильтра (показываем всё).
|
||||||
|
var M: TDXMode;
|
||||||
|
begin
|
||||||
|
Result := [];
|
||||||
|
if Mask = 0 then Exit;
|
||||||
|
for M := Low(TDXMode) to High(TDXMode) do
|
||||||
|
if (Mask and (LongWord(1) shl Ord(M))) <> 0 then Include(Result, M);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.InitDXCluster;
|
||||||
|
begin
|
||||||
|
FDXStore := TDXSpotStore.Create;
|
||||||
|
FDXClient := TDXClusterClient.Create(FDXStore);
|
||||||
|
|
||||||
|
FDXSpotOverlay := TDXSpotOverlay.Create(Self);
|
||||||
|
FDXSpotOverlay.Attach(FDXStore);
|
||||||
|
FDXSpotOverlay.SetLightTheme(FLightTheme);
|
||||||
|
FDXSpotOverlay.SetView(FController.FCenterFreq, FController.FSpanHz);
|
||||||
|
FSpecView.DXSpotOverlay := FDXSpotOverlay;
|
||||||
|
|
||||||
|
FDXAgeTickAt := Now;
|
||||||
|
FController.FSettings.LoadDXClusterSettings(FDXCfg);
|
||||||
|
FDXStore.TTLMinutes := FDXCfg.TTLMinutes;
|
||||||
|
ApplyDXClusterSettings(FDXCfg);
|
||||||
|
// FDXConnCfg пуст → ApplyDXConnection увидит смену параметров и поднимет
|
||||||
|
// соединение, если оно включено и позывной задан.
|
||||||
|
ApplyDXConnection(FDXCfg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.ApplyDXClusterSettings(const D: TDXClusterSettings);
|
||||||
|
// Вид: оверлей + кнопка. Применяется сразу на каждую правку в SETUP — это
|
||||||
|
// дёшево, обратимо и даёт живой отклик. Всё, что МЕНЯЕТ ДАННЫЕ (TTL стора) или
|
||||||
|
// трогает соединение, откладывается до CommitDXClusterSettings: набирая «30» в
|
||||||
|
// поле TTL, пользователь на миг проходит через «3», а это выбросило бы из базы
|
||||||
|
// все споты старше трёх минут — необратимо.
|
||||||
|
begin
|
||||||
|
FDXCfg := D;
|
||||||
|
if FDXSpotOverlay <> nil then
|
||||||
|
begin
|
||||||
|
FDXSpotOverlay.MaxRows := D.MaxRows;
|
||||||
|
FDXSpotOverlay.SetOwnCall(D.Login);
|
||||||
|
FDXSpotOverlay.SetFilters(DXModeSetFromMask(D.ModeMask), D.TTLMinutes);
|
||||||
|
FDXSpotOverlay.SetEnabled(D.ShowSpots);
|
||||||
|
FDXSpotOverlay.Invalidate;
|
||||||
|
end;
|
||||||
|
UpdateDXClusterButton;
|
||||||
|
FSpectrumDirty := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.ApplyDXConnection(const D: TDXClusterSettings);
|
||||||
|
// Соединение: конфиг в клиент + поднять/положить/переподнять. Поток снимает
|
||||||
|
// конфиг один раз на сессию, поэтому смена адреса/учётки требует рестарта —
|
||||||
|
// как у веб-сервера при смене порта.
|
||||||
|
var Reconnect: Boolean;
|
||||||
|
begin
|
||||||
|
if FDXClient = nil then Exit;
|
||||||
|
Reconnect := (D.Host <> FDXConnCfg.Host) or (D.Port <> FDXConnCfg.Port) or
|
||||||
|
(D.Login <> FDXConnCfg.Login) or
|
||||||
|
(D.Password <> FDXConnCfg.Password) or
|
||||||
|
(D.PostLogin <> FDXConnCfg.PostLogin);
|
||||||
|
FDXConnCfg := D;
|
||||||
|
FDXClient.Configure(D.Host, D.Port, D.Login, D.Password, D.PostLogin);
|
||||||
|
|
||||||
|
// Без позывного логиниться нечем — не поднимаем соединение вообще.
|
||||||
|
if (not D.Enabled) or (Trim(D.Login) = '') then
|
||||||
|
begin
|
||||||
|
if FDXClient.Running then FDXClient.Stop;
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
if FDXClient.Running then
|
||||||
|
begin
|
||||||
|
if not Reconnect then Exit;
|
||||||
|
FDXClient.Stop;
|
||||||
|
end;
|
||||||
|
FDXClient.Start;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.OnDXClusterSettingsChange(const D: TDXClusterSettings);
|
||||||
|
// Каждая правка в SETUP прилетает сюда ПОСИМВОЛЬНО (OnChange поля). Вид
|
||||||
|
// применяем сразу, а запись в конфиг и переподключение откладываем: иначе
|
||||||
|
// набор позывного «UA3XYZ» дёргал бы шесть реконнектов и шесть записей JSON.
|
||||||
|
begin
|
||||||
|
ApplyDXClusterSettings(D);
|
||||||
|
FDXPendingCfg := D;
|
||||||
|
FDXPendingAt := Now;
|
||||||
|
FDXPending := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.CommitDXClusterSettings;
|
||||||
|
// Отложенный коммит правок SETUP: пользователь перестал печатать.
|
||||||
|
begin
|
||||||
|
FDXPending := False;
|
||||||
|
FController.FSettings.SaveDXClusterSettings(FDXPendingCfg);
|
||||||
|
if FDXStore <> nil then FDXStore.TTLMinutes := FDXPendingCfg.TTLMinutes;
|
||||||
|
ApplyDXConnection(FDXPendingCfg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.ServiceDXCluster;
|
||||||
|
// Раз в DX_AGE_TICK_SEC подталкиваем оверлей пересобраться: споты тускнеют с
|
||||||
|
// возрастом и уходят по TTL, а без нового спота версия стора не меняется и
|
||||||
|
// повода для пересборки бы не было. Реже — незаметно, чаще — впустую.
|
||||||
|
const
|
||||||
|
DX_AGE_TICK_SEC = 30;
|
||||||
|
DX_SETTINGS_QUIET_MS = 1200; // тишина в SETUP, после которой коммитим
|
||||||
|
begin
|
||||||
|
// Отложенный коммит настроек: пользователь перестал печатать в SETUP.
|
||||||
|
if FDXPending and (MilliSecondsBetween(Now, FDXPendingAt) >= DX_SETTINGS_QUIET_MS) then
|
||||||
|
CommitDXClusterSettings;
|
||||||
|
|
||||||
|
if FDXSpotOverlay = nil then Exit;
|
||||||
|
if SecondsBetween(Now, FDXAgeTickAt) < DX_AGE_TICK_SEC then Exit;
|
||||||
|
FDXAgeTickAt := Now;
|
||||||
|
if not FDXSpotOverlay.Active then Exit;
|
||||||
|
FDXSpotOverlay.TickAge;
|
||||||
|
FSpectrumDirty := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.UpdateDXClusterButton;
|
||||||
|
begin
|
||||||
|
if BtnDXCluster = nil then Exit;
|
||||||
|
StyleButton(BtnDXCluster,
|
||||||
|
(FDXSpotOverlay <> nil) and FDXSpotOverlay.Active);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.BtnDXClusterClick(Sender: TObject);
|
||||||
|
// ЛКМ — показывать/не показывать подписи спотов на спектре (настройка живёт
|
||||||
|
// в конфиге, чтобы состояние пережило перезапуск).
|
||||||
|
begin
|
||||||
|
if FDXSpotOverlay = nil then Exit;
|
||||||
|
FDXCfg.ShowSpots := not FDXCfg.ShowSpots;
|
||||||
|
FDXSpotOverlay.SetEnabled(FDXCfg.ShowSpots);
|
||||||
|
FController.FSettings.SaveDXClusterSettings(FDXCfg);
|
||||||
|
UpdateDXClusterButton;
|
||||||
|
FSpectrumDirty := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.BtnDXClusterMouseDown(Sender: TObject; Button: TMouseButton;
|
||||||
|
Shift: TShiftState; X, Y: Integer);
|
||||||
|
begin
|
||||||
|
if Button = mbRight then ShowDXClusterForm;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.ShowDXClusterForm;
|
||||||
|
begin
|
||||||
|
if FDXClusterForm = nil then
|
||||||
|
begin
|
||||||
|
FDXClusterForm := TDXClusterForm.CreateWith(Self, FDXStore, FDXClient);
|
||||||
|
FDXClusterForm.OnTuneSpot := OnDXTuneSpot;
|
||||||
|
end;
|
||||||
|
FDXClusterForm.ApplyTheme(CurrentAppTheme);
|
||||||
|
if FDXClusterForm.Visible then FDXClusterForm.Hide
|
||||||
|
else FDXClusterForm.Show;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.OnDXTuneSpot(FreqHz: Double; Mode: TDXMode);
|
||||||
|
// QSY по споту: клик по подписи на спектре или двойной клик в окне списка.
|
||||||
|
// Мода ставится только когда она однозначна из комментария кластера; при
|
||||||
|
// dxmUnknown текущую не трогаем — гадать хуже, чем не менять.
|
||||||
|
var NewMode: Integer;
|
||||||
|
begin
|
||||||
|
if FreqHz <= 0 then Exit;
|
||||||
|
ApplyVfoA(Round(FreqHz));
|
||||||
|
NewMode := -1;
|
||||||
|
case Mode of
|
||||||
|
dxmCW: NewMode := MODE_CWU;
|
||||||
|
// Боковая по общепринятому правилу: ниже 10 МГц — LSB, выше — USB.
|
||||||
|
dxmSSB: if FreqHz < 10000000.0 then NewMode := MODE_LSB else NewMode := MODE_USB;
|
||||||
|
dxmFT8, dxmFT4, dxmDigi, dxmRTTY, dxmPSK: NewMode := MODE_DIGU;
|
||||||
|
dxmSSTV: NewMode := MODE_USB;
|
||||||
|
dxmFM: NewMode := MODE_FM;
|
||||||
|
end;
|
||||||
|
if (NewMode >= 0) and (NewMode <> FController.FMode) then
|
||||||
|
FController.SetMode(NewMode);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TMainForm.UpdateBandPlanOverlay;
|
procedure TMainForm.UpdateBandPlanOverlay;
|
||||||
// Полоска бэндплана видна только в QO-100 (Pluto + full-duplex транспондер).
|
// Полоска бэндплана видна только в QO-100 (Pluto + full-duplex транспондер).
|
||||||
begin
|
begin
|
||||||
@@ -5251,7 +5489,9 @@ end;
|
|||||||
// Спектр
|
// Спектр
|
||||||
procedure TMainForm.PbSpectrumMouseDown(Sender: TObject; Button: TMouseButton;
|
procedure TMainForm.PbSpectrumMouseDown(Sender: TObject; Button: TMouseButton;
|
||||||
Shift: TShiftState; X, Y: Integer);
|
Shift: TShiftState; X, Y: Integer);
|
||||||
var VC, VS: Double;
|
var
|
||||||
|
VC, VS: Double;
|
||||||
|
DXSpot: TDXSpot;
|
||||||
begin
|
begin
|
||||||
if FPan.DispatchFlagsMouseDown(Button, X, Y) then
|
if FPan.DispatchFlagsMouseDown(Button, X, Y) then
|
||||||
begin
|
begin
|
||||||
@@ -5261,6 +5501,15 @@ begin
|
|||||||
if Assigned(FSampleRateOverlay) and
|
if Assigned(FSampleRateOverlay) and
|
||||||
FSampleRateOverlay.HandleMouseDown(Button, X, Y) then Exit;
|
FSampleRateOverlay.HandleMouseDown(Button, X, Y) then Exit;
|
||||||
|
|
||||||
|
// ЛКМ по подписи DX-спота — QSY на него. Проверяется до тюнинга/драга, но
|
||||||
|
// только в полосе подписей вверху: ниже неё поведение спектра прежнее.
|
||||||
|
if (Button = mbLeft) and Assigned(FDXSpotOverlay) and
|
||||||
|
FDXSpotOverlay.SpotAtPixel(X, Y, DXSpot) then
|
||||||
|
begin
|
||||||
|
OnDXTuneSpot(DXSpot.FreqHz, DXSpot.Mode);
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
// Ctrl+ЛКМ по спектру — добавить софт-слайс на этой частоте (в пределах захвата).
|
// Ctrl+ЛКМ по спектру — добавить софт-слайс на этой частоте (в пределах захвата).
|
||||||
if (Button = mbLeft) and (ssCtrl in Shift) and (PbSpectrum.Width > 0) then
|
if (Button = mbLeft) and (ssCtrl in Shift) and (PbSpectrum.Width > 0) then
|
||||||
begin
|
begin
|
||||||
@@ -9286,6 +9535,7 @@ begin
|
|||||||
SF.OnWfAGCNFChange := ApplyWfAGCNF;
|
SF.OnWfAGCNFChange := ApplyWfAGCNF;
|
||||||
SF.OnADCChange := ApplyADCSettings;
|
SF.OnADCChange := ApplyADCSettings;
|
||||||
SF.OnWebSettingsChange := ApplyWebSettings;
|
SF.OnWebSettingsChange := ApplyWebSettings;
|
||||||
|
SF.OnDXClusterChange := OnDXClusterSettingsChange;
|
||||||
end;
|
end;
|
||||||
SF := TSettingsForm(FSettingsForm);
|
SF := TSettingsForm(FSettingsForm);
|
||||||
PushTXProfilesToSettings;
|
PushTXProfilesToSettings;
|
||||||
@@ -9340,6 +9590,7 @@ begin
|
|||||||
SF.LoadADCSettings(FController.FDitherEnabled, FController.FRandomEnabled);
|
SF.LoadADCSettings(FController.FDitherEnabled, FController.FRandomEnabled);
|
||||||
SF.LoadWebSettings(FWebEnabled, FWebPort, FWebBindAddr, FWebUser, FWebPass,
|
SF.LoadWebSettings(FWebEnabled, FWebPort, FWebBindAddr, FWebUser, FWebPass,
|
||||||
FWebSpecPixels);
|
FWebSpecPixels);
|
||||||
|
SF.LoadDXClusterSettings(FDXCfg);
|
||||||
SF.LoadFPS(FDisplayFPS);
|
SF.LoadFPS(FDisplayFPS);
|
||||||
SF.LoadLightTheme(FLightTheme);
|
SF.LoadLightTheme(FLightTheme);
|
||||||
SF.LoadFreqMhzDigits(FFreqMhzDigits);
|
SF.LoadFreqMhzDigits(FFreqMhzDigits);
|
||||||
|
|||||||
@@ -427,6 +427,25 @@ type
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
// Web-сервер — глобальные настройки (не привязаны к устройству, секция "web").
|
// Web-сервер — глобальные настройки (не привязаны к устройству, секция "web").
|
||||||
|
// DX-кластер: телнет-соединение + вид спотов на панадаптере.
|
||||||
|
// Хранится глобально (секция "dxcluster"), не per-device: кластер и позывной
|
||||||
|
// от железа не зависят.
|
||||||
|
TDXClusterSettings = record
|
||||||
|
Enabled: Boolean; // подключаться при старте
|
||||||
|
ShowSpots: Boolean; // рисовать оверлей на спектре
|
||||||
|
Host: string;
|
||||||
|
Port: Integer; // 1..65535
|
||||||
|
Login: string; // позывной для логина в кластер (он же «свой» в оверлее)
|
||||||
|
Password: string; // редкий кластер спрашивает — обычно пусто
|
||||||
|
PostLogin: string; // команды после логина (по строке; сюда же set/filter)
|
||||||
|
TTLMinutes: Integer; // сколько держать спот (он же горизонт затухания)
|
||||||
|
MaxRows: Integer; // рядов лесенки подписей (1..DXSPOT_MAX_ROWS)
|
||||||
|
// Фильтр по модам. Пустая маска = показывать все (в т.ч. неопознанные).
|
||||||
|
// Биты соответствуют TDXMode: 1=CW,2=SSB,3=DIGI,4=FT8,5=FT4,6=RTTY,7=PSK,
|
||||||
|
// 8=FM,9=SSTV; бит 0 = споты без распознанной моды.
|
||||||
|
ModeMask: LongWord;
|
||||||
|
end;
|
||||||
|
|
||||||
TWebSettings = record
|
TWebSettings = record
|
||||||
Enabled: Boolean;
|
Enabled: Boolean;
|
||||||
Port: Integer; // 1..65535
|
Port: Integer; // 1..65535
|
||||||
@@ -754,6 +773,9 @@ type
|
|||||||
function LoadPans(const MAC: array of Byte; const Ctx: string; out P: TPansConfig): Boolean;
|
function LoadPans(const MAC: array of Byte; const Ctx: string; out P: TPansConfig): Boolean;
|
||||||
procedure SavePans(const MAC: array of Byte; const Ctx: string; const P: TPansConfig);
|
procedure SavePans(const MAC: array of Byte; const Ctx: string; const P: TPansConfig);
|
||||||
// Web-сервер — глобальные настройки (секция "web" в корне JSON).
|
// Web-сервер — глобальные настройки (секция "web" в корне JSON).
|
||||||
|
class procedure DefaultDXCluster(out D: TDXClusterSettings);
|
||||||
|
procedure LoadDXClusterSettings(out D: TDXClusterSettings);
|
||||||
|
procedure SaveDXClusterSettings(const D: TDXClusterSettings);
|
||||||
class procedure DefaultWeb(out W: TWebSettings);
|
class procedure DefaultWeb(out W: TWebSettings);
|
||||||
procedure LoadWebSettings(out W: TWebSettings);
|
procedure LoadWebSettings(out W: TWebSettings);
|
||||||
procedure SaveWebSettings(const W: TWebSettings);
|
procedure SaveWebSettings(const W: TWebSettings);
|
||||||
@@ -2873,6 +2895,55 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
class procedure TSettingsManager.DefaultDXCluster(out D: TDXClusterSettings);
|
||||||
|
begin
|
||||||
|
D.Enabled := False; // без позывного подключаться всё равно нечем
|
||||||
|
D.ShowSpots := True;
|
||||||
|
D.Host := 'cluster.dxfun.com';
|
||||||
|
D.Port := 8000;
|
||||||
|
D.Login := '';
|
||||||
|
D.Password := '';
|
||||||
|
D.PostLogin := '';
|
||||||
|
D.TTLMinutes := 30;
|
||||||
|
D.MaxRows := 4;
|
||||||
|
D.ModeMask := 0; // 0 = без фильтра по модам
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSettingsManager.LoadDXClusterSettings(out D: TDXClusterSettings);
|
||||||
|
var O: TJSONObject;
|
||||||
|
begin
|
||||||
|
DefaultDXCluster(D);
|
||||||
|
if FRoot.Find('dxcluster') = nil then Exit;
|
||||||
|
O := EnsureObj(FRoot, 'dxcluster');
|
||||||
|
D.Enabled := JB(O, 'enabled', False);
|
||||||
|
D.ShowSpots := JB(O, 'show_spots', True);
|
||||||
|
D.Host := JS(O, 'host', 'cluster.dxfun.com');
|
||||||
|
D.Port := EnsureRange(JI(O, 'port', 8000), 1, 65535);
|
||||||
|
D.Login := JS(O, 'login', '');
|
||||||
|
D.Password := JS(O, 'password', '');
|
||||||
|
D.PostLogin := JS(O, 'post_login', '');
|
||||||
|
D.TTLMinutes := EnsureRange(JI(O, 'ttl_minutes', 30), 1, 1440);
|
||||||
|
D.MaxRows := EnsureRange(JI(O, 'max_rows', 4), 1, 6);
|
||||||
|
D.ModeMask := LongWord(JI(O, 'mode_mask', 0));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSettingsManager.SaveDXClusterSettings(const D: TDXClusterSettings);
|
||||||
|
var O: TJSONObject;
|
||||||
|
begin
|
||||||
|
O := EnsureObj(FRoot, 'dxcluster');
|
||||||
|
JW(O, 'enabled', D.Enabled);
|
||||||
|
JW(O, 'show_spots', D.ShowSpots);
|
||||||
|
JWS(O, 'host', D.Host);
|
||||||
|
JW(O, 'port', D.Port);
|
||||||
|
JWS(O, 'login', D.Login);
|
||||||
|
JWS(O, 'password', D.Password);
|
||||||
|
JWS(O, 'post_login', D.PostLogin);
|
||||||
|
JW(O, 'ttl_minutes', D.TTLMinutes);
|
||||||
|
JW(O, 'max_rows', D.MaxRows);
|
||||||
|
JW(O, 'mode_mask', Integer(D.ModeMask));
|
||||||
|
Save;
|
||||||
|
end;
|
||||||
|
|
||||||
class procedure TSettingsManager.DefaultWeb(out W: TWebSettings);
|
class procedure TSettingsManager.DefaultWeb(out W: TWebSettings);
|
||||||
begin
|
begin
|
||||||
W.Enabled := True;
|
W.Enabled := True;
|
||||||
|
|||||||
+258
-1
@@ -28,7 +28,7 @@ uses
|
|||||||
Forms, Controls, Graphics, Dialogs,
|
Forms, Controls, Graphics, Dialogs,
|
||||||
StdCtrls, ExtCtrls, LCLType,
|
StdCtrls, ExtCtrls, LCLType,
|
||||||
FlatButton, FlatCheckBox, FlatComboBox, FlatEdit, FlatSpinEdit, FlatFloatSpinEdit,
|
FlatButton, FlatCheckBox, FlatComboBox, FlatEdit, FlatSpinEdit, FlatFloatSpinEdit,
|
||||||
FlatRadioButton,
|
FlatRadioButton, FlatMemo,
|
||||||
EqualizerControl, OverlayScrollBar, AudioOutput, AudioInput, AppTheme, Settings,
|
EqualizerControl, OverlayScrollBar, AudioOutput, AudioInput, AppTheme, Settings,
|
||||||
BoardUtils, DpiUtils;
|
BoardUtils, DpiUtils;
|
||||||
|
|
||||||
@@ -86,6 +86,10 @@ type
|
|||||||
TOnThemeChange = procedure(LightTheme: Boolean) of object;
|
TOnThemeChange = procedure(LightTheme: Boolean) of object;
|
||||||
TOnWfAGCNFChange = procedure(WfAGC, WfNF: Boolean) of object;
|
TOnWfAGCNFChange = procedure(WfAGC, WfNF: Boolean) of object;
|
||||||
TOnADCChange = procedure(Dither, Random: Boolean) of object;
|
TOnADCChange = procedure(Dither, Random: Boolean) of object;
|
||||||
|
// Настройки DX-кластера уезжают наружу целиком записью: полей много и
|
||||||
|
// добавлять их по одному в сигнатуру (как у веб-сервера) уже неудобно.
|
||||||
|
TOnDXClusterChange = procedure(const D: TDXClusterSettings) of object;
|
||||||
|
|
||||||
TOnWebSettingsChange = procedure(Enabled: Boolean; Port: Integer;
|
TOnWebSettingsChange = procedure(Enabled: Boolean; Port: Integer;
|
||||||
const BindAddr, User, Pass: string; SpecPixels: Integer) of object;
|
const BindAddr, User, Pass: string; SpecPixels: Integer) of object;
|
||||||
TOnCATChange = procedure(
|
TOnCATChange = procedure(
|
||||||
@@ -124,6 +128,19 @@ type
|
|||||||
FPageWaterfall: TScrollBox;
|
FPageWaterfall: TScrollBox;
|
||||||
FPagePA: TScrollBox;
|
FPagePA: TScrollBox;
|
||||||
FPageAdvanced: TScrollBox;
|
FPageAdvanced: TScrollBox;
|
||||||
|
FPageDXCluster: TScrollBox;
|
||||||
|
// DX-кластер
|
||||||
|
FChkDXEnabled: TFlatCheckBox;
|
||||||
|
FChkDXShow: TFlatCheckBox;
|
||||||
|
FEdDXHost: TFlatEdit;
|
||||||
|
FEdDXPort: TFlatSpinEdit;
|
||||||
|
FEdDXLogin: TFlatEdit;
|
||||||
|
FEdDXPass: TFlatEdit;
|
||||||
|
FEdDXPostLogin: TFlatMemo;
|
||||||
|
FEdDXTTL: TFlatSpinEdit;
|
||||||
|
FEdDXRows: TFlatSpinEdit;
|
||||||
|
FChkDXMode: array[0..9] of TFlatCheckBox; // индекс = Ord(TDXMode)
|
||||||
|
FDXCfg: TDXClusterSettings;
|
||||||
FPageCAT: TScrollBox;
|
FPageCAT: TScrollBox;
|
||||||
FPageSlices: TScrollBox;
|
FPageSlices: TScrollBox;
|
||||||
FPageTransmit: TScrollBox;
|
FPageTransmit: TScrollBox;
|
||||||
@@ -133,6 +150,7 @@ type
|
|||||||
FNavWaterfall: TFlatButton;
|
FNavWaterfall: TFlatButton;
|
||||||
FNavPA: TFlatButton;
|
FNavPA: TFlatButton;
|
||||||
FNavAdvanced: TFlatButton;
|
FNavAdvanced: TFlatButton;
|
||||||
|
FNavDXCluster: TFlatButton;
|
||||||
FNavCAT: TFlatButton;
|
FNavCAT: TFlatButton;
|
||||||
FNavSlices: TFlatButton;
|
FNavSlices: TFlatButton;
|
||||||
FNavTransmit: TFlatButton;
|
FNavTransmit: TFlatButton;
|
||||||
@@ -465,6 +483,7 @@ type
|
|||||||
FOnVHFCalChange: TOnVHFCalChange;
|
FOnVHFCalChange: TOnVHFCalChange;
|
||||||
FOnADCChange: TOnADCChange;
|
FOnADCChange: TOnADCChange;
|
||||||
FOnWebSettingsChange: TOnWebSettingsChange;
|
FOnWebSettingsChange: TOnWebSettingsChange;
|
||||||
|
FOnDXClusterChange: TOnDXClusterChange;
|
||||||
FOnDisplayChange: TOnDisplayParamChange;
|
FOnDisplayChange: TOnDisplayParamChange;
|
||||||
FOnWaterfallChange: TOnWaterfallParamChange;
|
FOnWaterfallChange: TOnWaterfallParamChange;
|
||||||
FOnWfRenderChange: TOnWfRenderChange;
|
FOnWfRenderChange: TOnWfRenderChange;
|
||||||
@@ -572,6 +591,8 @@ type
|
|||||||
OnChange: TNotifyEvent): TFlatComboBox;
|
OnChange: TNotifyEvent): TFlatComboBox;
|
||||||
function MakeGroupPanel(AParent: TWinControl; const Cap: string;
|
function MakeGroupPanel(AParent: TWinControl; const Cap: string;
|
||||||
ALeft, ATop, AW, AH: Integer): TPanel;
|
ALeft, ATop, AW, AH: Integer): TPanel;
|
||||||
|
procedure BuildDXClusterTab;
|
||||||
|
procedure OnDXAnyChange(Sender: TObject);
|
||||||
function MakeScrollPage: TScrollBox;
|
function MakeScrollPage: TScrollBox;
|
||||||
procedure AddPageBottomSpace(APage: TScrollBox);
|
procedure AddPageBottomSpace(APage: TScrollBox);
|
||||||
procedure UpdatePageBottomSpace(APage: TScrollBox);
|
procedure UpdatePageBottomSpace(APage: TScrollBox);
|
||||||
@@ -696,6 +717,7 @@ type
|
|||||||
ResLimit, SpeedDiv: Integer);
|
ResLimit, SpeedDiv: Integer);
|
||||||
procedure LoadSpecMSAA(Samples: Integer);
|
procedure LoadSpecMSAA(Samples: Integer);
|
||||||
procedure LoadADCSettings(Dither, Random: Boolean);
|
procedure LoadADCSettings(Dither, Random: Boolean);
|
||||||
|
procedure LoadDXClusterSettings(const D: TDXClusterSettings);
|
||||||
procedure LoadWebSettings(Enabled: Boolean; Port: Integer;
|
procedure LoadWebSettings(Enabled: Boolean; Port: Integer;
|
||||||
const BindAddr, User, Pass: string; SpecPixels: Integer);
|
const BindAddr, User, Pass: string; SpecPixels: Integer);
|
||||||
|
|
||||||
@@ -734,6 +756,7 @@ type
|
|||||||
property OnWfAGCNFChange: TOnWfAGCNFChange read FOnWfAGCNFChange write FOnWfAGCNFChange;
|
property OnWfAGCNFChange: TOnWfAGCNFChange read FOnWfAGCNFChange write FOnWfAGCNFChange;
|
||||||
property OnADCChange: TOnADCChange read FOnADCChange write FOnADCChange;
|
property OnADCChange: TOnADCChange read FOnADCChange write FOnADCChange;
|
||||||
property OnWebSettingsChange: TOnWebSettingsChange read FOnWebSettingsChange write FOnWebSettingsChange;
|
property OnWebSettingsChange: TOnWebSettingsChange read FOnWebSettingsChange write FOnWebSettingsChange;
|
||||||
|
property OnDXClusterChange: TOnDXClusterChange read FOnDXClusterChange write FOnDXClusterChange;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
@@ -1113,6 +1136,7 @@ begin
|
|||||||
FNavCAT := MakeNavButton('CAT', 496);
|
FNavCAT := MakeNavButton('CAT', 496);
|
||||||
FNavSlices := MakeNavButton('Slices', 528);
|
FNavSlices := MakeNavButton('Slices', 528);
|
||||||
FNavAdvanced := MakeNavButton('Advanced', 560);
|
FNavAdvanced := MakeNavButton('Advanced', 560);
|
||||||
|
FNavDXCluster := MakeNavButton('DX Cluster', 592);
|
||||||
|
|
||||||
FContentPanel := TPanel.Create(Self);
|
FContentPanel := TPanel.Create(Self);
|
||||||
FContentPanel.Parent := Self;
|
FContentPanel.Parent := Self;
|
||||||
@@ -1135,6 +1159,7 @@ begin
|
|||||||
FPagePA := MakeScrollPage;
|
FPagePA := MakeScrollPage;
|
||||||
FPageCalib := MakeScrollPage;
|
FPageCalib := MakeScrollPage;
|
||||||
FPageAdvanced := MakeScrollPage;
|
FPageAdvanced := MakeScrollPage;
|
||||||
|
FPageDXCluster := MakeScrollPage;
|
||||||
FPageCAT := MakeScrollPage;
|
FPageCAT := MakeScrollPage;
|
||||||
FPageSlices := MakeScrollPage;
|
FPageSlices := MakeScrollPage;
|
||||||
FPageAlex := MakeScrollPage;
|
FPageAlex := MakeScrollPage;
|
||||||
@@ -1154,6 +1179,7 @@ begin
|
|||||||
BuildPATab;
|
BuildPATab;
|
||||||
BuildCalibrationTab;
|
BuildCalibrationTab;
|
||||||
BuildAdvancedTab;
|
BuildAdvancedTab;
|
||||||
|
BuildDXClusterTab;
|
||||||
BuildCATTab;
|
BuildCATTab;
|
||||||
BuildSlicesTab;
|
BuildSlicesTab;
|
||||||
BuildAlexTab;
|
BuildAlexTab;
|
||||||
@@ -1168,6 +1194,7 @@ begin
|
|||||||
AddPageBottomSpace(FPageWaterfall);
|
AddPageBottomSpace(FPageWaterfall);
|
||||||
AddPageBottomSpace(FPageCalib);
|
AddPageBottomSpace(FPageCalib);
|
||||||
AddPageBottomSpace(FPageCAT);
|
AddPageBottomSpace(FPageCAT);
|
||||||
|
AddPageBottomSpace(FPageDXCluster);
|
||||||
AddPageBottomSpace(FPageOC);
|
AddPageBottomSpace(FPageOC);
|
||||||
|
|
||||||
FBtnClose := TFlatButton.Create(Self);
|
FBtnClose := TFlatButton.Create(Self);
|
||||||
@@ -1390,6 +1417,7 @@ begin
|
|||||||
ResizePage(FPagePA, CardWidth);
|
ResizePage(FPagePA, CardWidth);
|
||||||
ResizePage(FPageCalib, CardWidth);
|
ResizePage(FPageCalib, CardWidth);
|
||||||
ResizePage(FPageAdvanced, CardWidth);
|
ResizePage(FPageAdvanced, CardWidth);
|
||||||
|
ResizePage(FPageDXCluster, CardWidth);
|
||||||
ResizePage(FPageCAT, CardWidth);
|
ResizePage(FPageCAT, CardWidth);
|
||||||
ResizePage(FPageSlices, CardWidth);
|
ResizePage(FPageSlices, CardWidth);
|
||||||
ResizePage(FPageAlex, CardWidth);
|
ResizePage(FPageAlex, CardWidth);
|
||||||
@@ -1408,6 +1436,7 @@ begin
|
|||||||
else if Sender = FNavPA then SelectPage(FPagePA, FNavPA)
|
else if Sender = FNavPA then SelectPage(FPagePA, FNavPA)
|
||||||
else if Sender = FNavCalib then SelectPage(FPageCalib, FNavCalib)
|
else if Sender = FNavCalib then SelectPage(FPageCalib, FNavCalib)
|
||||||
else if Sender = FNavAdvanced then SelectPage(FPageAdvanced, FNavAdvanced)
|
else if Sender = FNavAdvanced then SelectPage(FPageAdvanced, FNavAdvanced)
|
||||||
|
else if Sender = FNavDXCluster then SelectPage(FPageDXCluster, FNavDXCluster)
|
||||||
else if Sender = FNavCAT then SelectPage(FPageCAT, FNavCAT)
|
else if Sender = FNavCAT then SelectPage(FPageCAT, FNavCAT)
|
||||||
else if Sender = FNavSlices then SelectPage(FPageSlices, FNavSlices)
|
else if Sender = FNavSlices then SelectPage(FPageSlices, FNavSlices)
|
||||||
else if Sender = FNavAlex then SelectPage(FPageAlex, FNavAlex)
|
else if Sender = FNavAlex then SelectPage(FPageAlex, FNavAlex)
|
||||||
@@ -1429,6 +1458,7 @@ begin
|
|||||||
FPagePA.Visible := APage = FPagePA;
|
FPagePA.Visible := APage = FPagePA;
|
||||||
FPageCalib.Visible := APage = FPageCalib;
|
FPageCalib.Visible := APage = FPageCalib;
|
||||||
FPageAdvanced.Visible := APage = FPageAdvanced;
|
FPageAdvanced.Visible := APage = FPageAdvanced;
|
||||||
|
FPageDXCluster.Visible := APage = FPageDXCluster;
|
||||||
FPageCAT.Visible := APage = FPageCAT;
|
FPageCAT.Visible := APage = FPageCAT;
|
||||||
FPageSlices.Visible := APage = FPageSlices;
|
FPageSlices.Visible := APage = FPageSlices;
|
||||||
FPageAlex.Visible := APage = FPageAlex;
|
FPageAlex.Visible := APage = FPageAlex;
|
||||||
@@ -1444,6 +1474,7 @@ begin
|
|||||||
FNavPA.Active := ANav = FNavPA;
|
FNavPA.Active := ANav = FNavPA;
|
||||||
FNavCalib.Active := ANav = FNavCalib;
|
FNavCalib.Active := ANav = FNavCalib;
|
||||||
FNavAdvanced.Active := ANav = FNavAdvanced;
|
FNavAdvanced.Active := ANav = FNavAdvanced;
|
||||||
|
FNavDXCluster.Active := ANav = FNavDXCluster;
|
||||||
FNavCAT.Active := ANav = FNavCAT;
|
FNavCAT.Active := ANav = FNavCAT;
|
||||||
FNavSlices.Active := ANav = FNavSlices;
|
FNavSlices.Active := ANav = FNavSlices;
|
||||||
FNavAlex.Active := ANav = FNavAlex;
|
FNavAlex.Active := ANav = FNavAlex;
|
||||||
@@ -3412,6 +3443,227 @@ begin
|
|||||||
Lbl.Font.Size := 8;
|
Lbl.Font.Size := 8;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TSettingsForm.BuildDXClusterTab;
|
||||||
|
const
|
||||||
|
MARGIN = 22;
|
||||||
|
GRP_PAD = 18;
|
||||||
|
LBL_W = 110;
|
||||||
|
ED_W = 220;
|
||||||
|
ROW_H = 42;
|
||||||
|
R1 = 42;
|
||||||
|
// Подписи для чекбоксов фильтра мод. Порядок = Ord(TDXMode), включая
|
||||||
|
// dxmUnknown («без моды») — иначе фильтр молча съедал бы такие споты.
|
||||||
|
MODE_CAPS: array[0..9] of string =
|
||||||
|
('no mode', 'CW', 'SSB', 'DIGI', 'FT8', 'FT4', 'RTTY', 'PSK', 'FM', 'SSTV');
|
||||||
|
var
|
||||||
|
Grp: TPanel;
|
||||||
|
Chk: TFlatCheckBox;
|
||||||
|
Ed: TFlatEdit;
|
||||||
|
Spin: TFlatSpinEdit;
|
||||||
|
Lbl: TLabel;
|
||||||
|
Y, i, CX, CY: Integer;
|
||||||
|
begin
|
||||||
|
TSettingsManager.DefaultDXCluster(FDXCfg);
|
||||||
|
|
||||||
|
MakePageHeader(FPageDXCluster, 'DX Cluster',
|
||||||
|
'Telnet connection to a DX cluster and how spots look on the panadapter.');
|
||||||
|
|
||||||
|
// ── Соединение ────────────────────────────────────────────────────────────
|
||||||
|
Grp := MakeGroupPanel(FPageDXCluster, 'Connection', MARGIN, 86, SETTINGS_CARD_W, 366);
|
||||||
|
|
||||||
|
Y := R1;
|
||||||
|
Chk := TFlatCheckBox.Create(Self);
|
||||||
|
Chk.Parent := Grp;
|
||||||
|
Chk.Caption := 'Connect at startup';
|
||||||
|
Chk.SetBounds(DpiScale(GRP_PAD), DpiScale(Y), DpiScale(300), DpiScale(22));
|
||||||
|
Chk.Font.Size := 9;
|
||||||
|
Chk.Font.Color := CLR_TEXT;
|
||||||
|
Chk.OnChange := OnDXAnyChange;
|
||||||
|
FChkDXEnabled := Chk;
|
||||||
|
|
||||||
|
Y := Y + ROW_H;
|
||||||
|
MakeLbl(Grp, 'Host:', GRP_PAD, Y + 4, LBL_W);
|
||||||
|
Ed := TFlatEdit.Create(Self);
|
||||||
|
Ed.Parent := Grp;
|
||||||
|
Ed.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(ED_W), DpiScale(BTN_H));
|
||||||
|
Ed.Color := CLR_INPUT;
|
||||||
|
Ed.Font.Color := CLR_INPUT_TEXT;
|
||||||
|
Ed.Font.Size := 9;
|
||||||
|
Ed.Text := FDXCfg.Host;
|
||||||
|
Ed.OnChange := OnDXAnyChange;
|
||||||
|
FEdDXHost := Ed;
|
||||||
|
|
||||||
|
Y := Y + ROW_H;
|
||||||
|
MakeLbl(Grp, 'Port:', GRP_PAD, Y + 4, LBL_W);
|
||||||
|
Spin := TFlatSpinEdit.Create(Self);
|
||||||
|
Spin.Parent := Grp;
|
||||||
|
Spin.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(90), DpiScale(BTN_H));
|
||||||
|
Spin.Color := CLR_INPUT;
|
||||||
|
Spin.Font.Color := CLR_INPUT_TEXT;
|
||||||
|
Spin.Font.Size := 9;
|
||||||
|
Spin.MinValue := 1;
|
||||||
|
Spin.MaxValue := 65535;
|
||||||
|
Spin.Value := FDXCfg.Port;
|
||||||
|
Spin.OnChange := OnDXAnyChange;
|
||||||
|
FEdDXPort := Spin;
|
||||||
|
|
||||||
|
Y := Y + ROW_H;
|
||||||
|
MakeLbl(Grp, 'Callsign:', GRP_PAD, Y + 4, LBL_W);
|
||||||
|
Ed := TFlatEdit.Create(Self);
|
||||||
|
Ed.Parent := Grp;
|
||||||
|
Ed.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(140), DpiScale(BTN_H));
|
||||||
|
Ed.Color := CLR_INPUT;
|
||||||
|
Ed.Font.Color := CLR_INPUT_TEXT;
|
||||||
|
Ed.Font.Size := 9;
|
||||||
|
Ed.OnChange := OnDXAnyChange;
|
||||||
|
FEdDXLogin := Ed;
|
||||||
|
Lbl := MakeLbl(Grp, 'used to log in; spots for this call are highlighted',
|
||||||
|
GRP_PAD + LBL_W + 12 + 150, Y + 4, 340);
|
||||||
|
Lbl.Font.Size := 8;
|
||||||
|
|
||||||
|
Y := Y + ROW_H;
|
||||||
|
MakeLbl(Grp, 'Password:', GRP_PAD, Y + 4, LBL_W);
|
||||||
|
Ed := TFlatEdit.Create(Self);
|
||||||
|
Ed.Parent := Grp;
|
||||||
|
Ed.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(140), DpiScale(BTN_H));
|
||||||
|
Ed.Color := CLR_INPUT;
|
||||||
|
Ed.Font.Color := CLR_INPUT_TEXT;
|
||||||
|
Ed.Font.Size := 9;
|
||||||
|
Ed.PasswordChar := '*';
|
||||||
|
Ed.OnChange := OnDXAnyChange;
|
||||||
|
FEdDXPass := Ed;
|
||||||
|
Lbl := MakeLbl(Grp, 'usually not needed', GRP_PAD + LBL_W + 12 + 150, Y + 4, 200);
|
||||||
|
Lbl.Font.Size := 8;
|
||||||
|
|
||||||
|
Y := Y + ROW_H;
|
||||||
|
MakeLbl(Grp, 'After login:', GRP_PAD, Y + 4, LBL_W);
|
||||||
|
FEdDXPostLogin := TFlatMemo.Create(Self);
|
||||||
|
FEdDXPostLogin.Parent := Grp;
|
||||||
|
FEdDXPostLogin.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y),
|
||||||
|
DpiScale(ED_W + 120), DpiScale(70));
|
||||||
|
FEdDXPostLogin.Color := CLR_INPUT;
|
||||||
|
FEdDXPostLogin.Font.Color := CLR_INPUT_TEXT;
|
||||||
|
FEdDXPostLogin.Font.Size := 9;
|
||||||
|
FEdDXPostLogin.WordWrap := False;
|
||||||
|
FEdDXPostLogin.OnChange := OnDXAnyChange;
|
||||||
|
Lbl := MakeLbl(Grp, 'one command per line (set/filter, sh/dx …) — dialects differ between clusters',
|
||||||
|
GRP_PAD, Y + 76, 520);
|
||||||
|
Lbl.Font.Size := 8;
|
||||||
|
|
||||||
|
// ── Отображение ───────────────────────────────────────────────────────────
|
||||||
|
Grp := MakeGroupPanel(FPageDXCluster, 'Spots on panadapter', MARGIN, 468,
|
||||||
|
SETTINGS_CARD_W, 292);
|
||||||
|
|
||||||
|
Y := R1;
|
||||||
|
Chk := TFlatCheckBox.Create(Self);
|
||||||
|
Chk.Parent := Grp;
|
||||||
|
Chk.Caption := 'Show spots on the spectrum';
|
||||||
|
Chk.SetBounds(DpiScale(GRP_PAD), DpiScale(Y), DpiScale(300), DpiScale(22));
|
||||||
|
Chk.Font.Size := 9;
|
||||||
|
Chk.Font.Color := CLR_TEXT;
|
||||||
|
Chk.OnChange := OnDXAnyChange;
|
||||||
|
FChkDXShow := Chk;
|
||||||
|
|
||||||
|
Y := Y + ROW_H;
|
||||||
|
MakeLbl(Grp, 'Keep for, min:', GRP_PAD, Y + 4, LBL_W);
|
||||||
|
Spin := TFlatSpinEdit.Create(Self);
|
||||||
|
Spin.Parent := Grp;
|
||||||
|
Spin.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(90), DpiScale(BTN_H));
|
||||||
|
Spin.Color := CLR_INPUT;
|
||||||
|
Spin.Font.Color := CLR_INPUT_TEXT;
|
||||||
|
Spin.Font.Size := 9;
|
||||||
|
Spin.MinValue := 1;
|
||||||
|
Spin.MaxValue := 1440;
|
||||||
|
Spin.Value := FDXCfg.TTLMinutes;
|
||||||
|
Spin.OnChange := OnDXAnyChange;
|
||||||
|
FEdDXTTL := Spin;
|
||||||
|
Lbl := MakeLbl(Grp, 'also the fade horizon: a spot dims and then disappears',
|
||||||
|
GRP_PAD + LBL_W + 114, Y + 4, 360);
|
||||||
|
Lbl.Font.Size := 8;
|
||||||
|
|
||||||
|
Y := Y + ROW_H;
|
||||||
|
MakeLbl(Grp, 'Label rows:', GRP_PAD, Y + 4, LBL_W);
|
||||||
|
Spin := TFlatSpinEdit.Create(Self);
|
||||||
|
Spin.Parent := Grp;
|
||||||
|
Spin.SetBounds(DpiScale(GRP_PAD + LBL_W + 12), DpiScale(Y), DpiScale(90), DpiScale(BTN_H));
|
||||||
|
Spin.Color := CLR_INPUT;
|
||||||
|
Spin.Font.Color := CLR_INPUT_TEXT;
|
||||||
|
Spin.Font.Size := 9;
|
||||||
|
Spin.MinValue := 1;
|
||||||
|
Spin.MaxValue := 6;
|
||||||
|
Spin.Value := FDXCfg.MaxRows;
|
||||||
|
Spin.OnChange := OnDXAnyChange;
|
||||||
|
FEdDXRows := Spin;
|
||||||
|
Lbl := MakeLbl(Grp, 'ladder height: more rows means fewer hidden spots',
|
||||||
|
GRP_PAD + LBL_W + 114, Y + 4, 360);
|
||||||
|
Lbl.Font.Size := 8;
|
||||||
|
|
||||||
|
Y := Y + ROW_H;
|
||||||
|
MakeLbl(Grp, 'Modes:', GRP_PAD, Y + 4, LBL_W);
|
||||||
|
CX := GRP_PAD + LBL_W + 12;
|
||||||
|
CY := Y;
|
||||||
|
for i := 0 to High(FChkDXMode) do
|
||||||
|
begin
|
||||||
|
Chk := TFlatCheckBox.Create(Self);
|
||||||
|
Chk.Parent := Grp;
|
||||||
|
Chk.Caption := MODE_CAPS[i];
|
||||||
|
Chk.SetBounds(DpiScale(CX), DpiScale(CY), DpiScale(90), DpiScale(22));
|
||||||
|
Chk.Font.Size := 9;
|
||||||
|
Chk.Font.Color := CLR_TEXT;
|
||||||
|
Chk.OnChange := OnDXAnyChange;
|
||||||
|
FChkDXMode[i] := Chk;
|
||||||
|
CX := CX + 96;
|
||||||
|
if CX > 480 then begin CX := GRP_PAD + LBL_W + 12; CY := CY + 26; end;
|
||||||
|
end;
|
||||||
|
Lbl := MakeLbl(Grp, 'none checked — every spot is shown',
|
||||||
|
GRP_PAD + LBL_W + 12, CY + 28, 360);
|
||||||
|
Lbl.Font.Size := 8;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSettingsForm.OnDXAnyChange(Sender: TObject);
|
||||||
|
var i: Integer;
|
||||||
|
begin
|
||||||
|
if FLoading then Exit;
|
||||||
|
if not Assigned(FOnDXClusterChange) then Exit;
|
||||||
|
FDXCfg.Enabled := FChkDXEnabled.Checked;
|
||||||
|
FDXCfg.ShowSpots := FChkDXShow.Checked;
|
||||||
|
FDXCfg.Host := Trim(FEdDXHost.Text);
|
||||||
|
FDXCfg.Port := FEdDXPort.Value;
|
||||||
|
FDXCfg.Login := Trim(FEdDXLogin.Text);
|
||||||
|
FDXCfg.Password := FEdDXPass.Text;
|
||||||
|
FDXCfg.PostLogin := FEdDXPostLogin.Text;
|
||||||
|
FDXCfg.TTLMinutes := FEdDXTTL.Value;
|
||||||
|
FDXCfg.MaxRows := FEdDXRows.Value;
|
||||||
|
FDXCfg.ModeMask := 0;
|
||||||
|
for i := 0 to High(FChkDXMode) do
|
||||||
|
if (FChkDXMode[i] <> nil) and FChkDXMode[i].Checked then
|
||||||
|
FDXCfg.ModeMask := FDXCfg.ModeMask or (LongWord(1) shl i);
|
||||||
|
FOnDXClusterChange(FDXCfg);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TSettingsForm.LoadDXClusterSettings(const D: TDXClusterSettings);
|
||||||
|
var i: Integer;
|
||||||
|
begin
|
||||||
|
FLoading := True;
|
||||||
|
try
|
||||||
|
FDXCfg := D;
|
||||||
|
FChkDXEnabled.Checked := D.Enabled;
|
||||||
|
FChkDXShow.Checked := D.ShowSpots;
|
||||||
|
FEdDXHost.Text := D.Host;
|
||||||
|
FEdDXPort.Value := EnsureRange(D.Port, 1, 65535);
|
||||||
|
FEdDXLogin.Text := D.Login;
|
||||||
|
FEdDXPass.Text := D.Password;
|
||||||
|
FEdDXPostLogin.Text := D.PostLogin;
|
||||||
|
FEdDXTTL.Value := EnsureRange(D.TTLMinutes, 1, 1440);
|
||||||
|
FEdDXRows.Value := EnsureRange(D.MaxRows, 1, 6);
|
||||||
|
for i := 0 to High(FChkDXMode) do
|
||||||
|
if FChkDXMode[i] <> nil then
|
||||||
|
FChkDXMode[i].Checked := (D.ModeMask and (LongWord(1) shl i)) <> 0;
|
||||||
|
finally
|
||||||
|
FLoading := False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TSettingsForm.OnADCChkChange(Sender: TObject);
|
procedure TSettingsForm.OnADCChkChange(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
if FLoading then Exit;
|
if FLoading then Exit;
|
||||||
@@ -3540,6 +3792,11 @@ procedure TSettingsForm.ApplyTheme(const T: TAppTheme);
|
|||||||
TFlatFloatSpinEdit(Ctrl).SetAppTheme(T)
|
TFlatFloatSpinEdit(Ctrl).SetAppTheme(T)
|
||||||
else if Ctrl is TFlatRadioButton then
|
else if Ctrl is TFlatRadioButton then
|
||||||
TFlatRadioButton(Ctrl).SetAppTheme(T)
|
TFlatRadioButton(Ctrl).SetAppTheme(T)
|
||||||
|
// TFlatMemo — обёртка над TMemo со своим scrollbar: тему знает сама,
|
||||||
|
// рекурсивный обход внутрь ей только навредил бы (внутренний TMemo не
|
||||||
|
// подходит ни под одну ветку и остался бы серым).
|
||||||
|
else if Ctrl is TFlatMemo then
|
||||||
|
TFlatMemo(Ctrl).SetAppTheme(T)
|
||||||
else if Ctrl is TListBox then
|
else if Ctrl is TListBox then
|
||||||
begin
|
begin
|
||||||
TListBox(Ctrl).Color := T.BG;
|
TListBox(Ctrl).Color := T.BG;
|
||||||
|
|||||||
+32
-1
@@ -20,7 +20,7 @@ interface
|
|||||||
uses
|
uses
|
||||||
Classes, SysUtils, Graphics, GraphType, ExtCtrls, Controls, Math,
|
Classes, SysUtils, Graphics, GraphType, ExtCtrls, Controls, Math,
|
||||||
AppTheme,
|
AppTheme,
|
||||||
AlertOverlay, SampleRateOverlay, VfoOverlay, BandPlanOverlay,
|
AlertOverlay, SampleRateOverlay, VfoOverlay, BandPlanOverlay, DXSpotOverlay,
|
||||||
WaterfallView, SMeterView, RulerView, RadioModes,
|
WaterfallView, SMeterView, RulerView, RadioModes,
|
||||||
Settings; // FilterEdgesFromBW — единственная таблица знака боковой
|
Settings; // FilterEdgesFromBW — единственная таблица знака боковой
|
||||||
|
|
||||||
@@ -106,6 +106,7 @@ type
|
|||||||
FVfoOverlay: TVfoOverlay;
|
FVfoOverlay: TVfoOverlay;
|
||||||
FSliceOverlays: TFPList; // доп. слайс-флаги (B+); не владеет (владелец MainForm)
|
FSliceOverlays: TFPList; // доп. слайс-флаги (B+); не владеет (владелец MainForm)
|
||||||
FBandPlanOverlay: TBandPlanOverlay;
|
FBandPlanOverlay: TBandPlanOverlay;
|
||||||
|
FDXSpotOverlay: TDXSpotOverlay; // споты DX-кластера (полоса подписей + штрихи)
|
||||||
// ── Marker ────────────────────────────────────────────────────────────────
|
// ── Marker ────────────────────────────────────────────────────────────────
|
||||||
FMarkerActive: Boolean;
|
FMarkerActive: Boolean;
|
||||||
FMarkerX: Integer;
|
FMarkerX: Integer;
|
||||||
@@ -172,6 +173,9 @@ type
|
|||||||
procedure DrawSliceFilterLinesRaw(W, H: Integer);
|
procedure DrawSliceFilterLinesRaw(W, H: Integer);
|
||||||
procedure DrawBandLetterRaw(X1, X2: Integer; L: Char; Clr: TColor);
|
procedure DrawBandLetterRaw(X1, X2: Integer; L: Char; Clr: TColor);
|
||||||
procedure DrawBeaconMarkersRaw(W, H: Integer);
|
procedure DrawBeaconMarkersRaw(W, H: Integer);
|
||||||
|
// Штрихи DX-спотов ниже полосы подписей. Раскладка уже посчитана оверлеем
|
||||||
|
// при пересборке кэша — здесь только N вертикальных линий.
|
||||||
|
procedure DrawDXSpotTicksRaw(W, H: Integer);
|
||||||
// 2TON/IMD: замер пиков по TX-буферу (общий для CPU/GL рендеров).
|
// 2TON/IMD: замер пиков по TX-буферу (общий для CPU/GL рендеров).
|
||||||
// Возвращает число валидных маркеров в M (0 если измерять нечего):
|
// Возвращает число валидных маркеров в M (0 если измерять нечего):
|
||||||
// [0..1] тона, [2..3] IMD3 (2f1−f2, 2f2−f1). Обновляет FIMDSummary.
|
// [0..1] тона, [2..3] IMD3 (2f1−f2, 2f2−f1). Обновляет FIMDSummary.
|
||||||
@@ -318,6 +322,7 @@ type
|
|||||||
function SliceOverlayCount: Integer;
|
function SliceOverlayCount: Integer;
|
||||||
function SliceOverlayAt(Index: Integer): TVfoOverlay;
|
function SliceOverlayAt(Index: Integer): TVfoOverlay;
|
||||||
property BandPlanOverlay: TBandPlanOverlay read FBandPlanOverlay write FBandPlanOverlay;
|
property BandPlanOverlay: TBandPlanOverlay read FBandPlanOverlay write FBandPlanOverlay;
|
||||||
|
property DXSpotOverlay: TDXSpotOverlay read FDXSpotOverlay write FDXSpotOverlay;
|
||||||
|
|
||||||
// ── Данные от DSP ─────────────────────────────────────────────────────────
|
// ── Данные от DSP ─────────────────────────────────────────────────────────
|
||||||
procedure SetSpectrumData(const Pixels: array of Single; Count: Integer); virtual;
|
procedure SetSpectrumData(const Pixels: array of Single; Count: Integer); virtual;
|
||||||
@@ -669,6 +674,23 @@ begin
|
|||||||
FBeaconDecHalf := HalfHz;
|
FBeaconDecHalf := HalfHz;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TSpectrumView.DrawDXSpotTicksRaw(W, H: Integer);
|
||||||
|
// Штрих от низа полосы подписей до низа спектра — по одному на видимый спот.
|
||||||
|
// Пунктиром, чтобы не спорить с кривой сигнала и краями фильтра. Раскладка
|
||||||
|
// готова (EnsureRendered в начале кадра), здесь только N линий.
|
||||||
|
var
|
||||||
|
i, X: Integer;
|
||||||
|
Col: TColor;
|
||||||
|
begin
|
||||||
|
if (FDXSpotOverlay = nil) or (not FDXSpotOverlay.Active) then Exit;
|
||||||
|
for i := 0 to FDXSpotOverlay.TickCount - 1 do
|
||||||
|
begin
|
||||||
|
FDXSpotOverlay.Tick(i, X, Col);
|
||||||
|
if (X < 0) or (X >= W) then Continue;
|
||||||
|
RawVLine(X, FDXSpotOverlay.BandHeight, H - 1, Col, 1, 2, 3);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TSpectrumView.DrawBeaconMarkersRaw(W, H: Integer);
|
procedure TSpectrumView.DrawBeaconMarkersRaw(W, H: Integer);
|
||||||
// Две вертикали: опорная частота маяка (зелёная пунктир) и отслеживаемый
|
// Две вертикали: опорная частота маяка (зелёная пунктир) и отслеживаемый
|
||||||
// центроид (оранжевая сплошная). Расхождение видно глазом → понятно, сел ли
|
// центроид (оранжевая сплошная). Расхождение видно глазом → понятно, сел ли
|
||||||
@@ -1705,6 +1727,10 @@ begin
|
|||||||
FSpPts[W] := Point(W-1, H); FSpPts[W+1] := Point(0, H);
|
FSpPts[W] := Point(W-1, H); FSpPts[W+1] := Point(0, H);
|
||||||
|
|
||||||
|
|
||||||
|
// Раскладка спотов — ДО RawBegin: штрихи в фазе raw берут из неё готовые X,
|
||||||
|
// а сама пересборка идёт на своём кэш-битмапе и только по dirty-ключу.
|
||||||
|
if Assigned(FDXSpotOverlay) then FDXSpotOverlay.EnsureRendered(W);
|
||||||
|
|
||||||
// ═══ Фаза 1: raw — весь кадр одним локом ═════════════════════════════════
|
// ═══ Фаза 1: raw — весь кадр одним локом ═════════════════════════════════
|
||||||
{$IFDEF DARWIN}
|
{$IFDEF DARWIN}
|
||||||
// Cocoa-вариант CopyGridToSpectrum идёт через Canvas.Draw — до RawBegin.
|
// Cocoa-вариант CopyGridToSpectrum идёт через Canvas.Draw — до RawBegin.
|
||||||
@@ -1794,6 +1820,8 @@ begin
|
|||||||
|
|
||||||
if FMarkerActive then DrawMarkerLineRaw(W, H);
|
if FMarkerActive then DrawMarkerLineRaw(W, H);
|
||||||
if FBeaconMarkActive or FBeaconDecActive then DrawBeaconMarkersRaw(W, H);
|
if FBeaconMarkActive or FBeaconDecActive then DrawBeaconMarkersRaw(W, H);
|
||||||
|
// Штрихи DX-спотов — под маркерами наведения, но над кривой.
|
||||||
|
DrawDXSpotTicksRaw(W, H);
|
||||||
// 2TON: кружки с уровнями на пиках тонов/IMD3 (активирует MainForm при
|
// 2TON: кружки с уровнями на пиках тонов/IMD3 (активирует MainForm при
|
||||||
// 2TON+TX+DUP — реальный сигнал после PA виден на RX-спектре)
|
// 2TON+TX+DUP — реальный сигнал после PA виден на RX-спектре)
|
||||||
if FIMDActive then DrawIMDMarkersRaw(W, H, DBmax, InvRange);
|
if FIMDActive then DrawIMDMarkersRaw(W, H, DBmax, InvRange);
|
||||||
@@ -1809,6 +1837,9 @@ begin
|
|||||||
// Бэндплан QO-100 — полоска внизу спектра, под панелями оверлеев.
|
// Бэндплан QO-100 — полоска внизу спектра, под панелями оверлеев.
|
||||||
if Assigned(FBandPlanOverlay) then
|
if Assigned(FBandPlanOverlay) then
|
||||||
FBandPlanOverlay.DrawOverlay(FSpectrumBitmap, W, H);
|
FBandPlanOverlay.DrawOverlay(FSpectrumBitmap, W, H);
|
||||||
|
// Полоса подписей DX-спотов — вверху спектра, под флагами VFO.
|
||||||
|
if Assigned(FDXSpotOverlay) then
|
||||||
|
FDXSpotOverlay.DrawOverlay(FSpectrumBitmap, W, H);
|
||||||
if Assigned(FSampleRateOverlay) then
|
if Assigned(FSampleRateOverlay) then
|
||||||
FSampleRateOverlay.DrawOverlay(FSpectrumBitmap, C, W, H);
|
FSampleRateOverlay.DrawOverlay(FSpectrumBitmap, C, W, H);
|
||||||
if Assigned(FVfoOverlay) then
|
if Assigned(FVfoOverlay) then
|
||||||
|
|||||||
@@ -18,6 +18,7 @@ uses
|
|||||||
Classes, SysUtils, Graphics, Controls, Math, Types,
|
Classes, SysUtils, Graphics, Controls, Math, Types,
|
||||||
OpenGLContextEx, GL,
|
OpenGLContextEx, GL,
|
||||||
AppTheme, AlertOverlay, SpectrumView, VfoOverlay, BandPlanOverlay,
|
AppTheme, AlertOverlay, SpectrumView, VfoOverlay, BandPlanOverlay,
|
||||||
|
DXSpotOverlay,
|
||||||
WaterfallView, WaterfallViewOpengl;
|
WaterfallView, WaterfallViewOpengl;
|
||||||
|
|
||||||
type
|
type
|
||||||
@@ -36,6 +37,7 @@ type
|
|||||||
FSampleOverlayDirty: Boolean;
|
FSampleOverlayDirty: Boolean;
|
||||||
FVfoOverlayDirty: Boolean;
|
FVfoOverlayDirty: Boolean;
|
||||||
FBandOverlayDirty: Boolean;
|
FBandOverlayDirty: Boolean;
|
||||||
|
FDXOverlayDirty: Boolean;
|
||||||
FGridLabelTex: TGLTextureCache;
|
FGridLabelTex: TGLTextureCache;
|
||||||
FAGCLabelTex: TGLTextureCache;
|
FAGCLabelTex: TGLTextureCache;
|
||||||
FAGCHangLabelTex: TGLTextureCache;
|
FAGCHangLabelTex: TGLTextureCache;
|
||||||
@@ -44,6 +46,7 @@ type
|
|||||||
FSampleOverlayTex: TGLTextureCache;
|
FSampleOverlayTex: TGLTextureCache;
|
||||||
FVfoOverlayTex: TGLTextureCache;
|
FVfoOverlayTex: TGLTextureCache;
|
||||||
FBandOverlayTex: TGLTextureCache;
|
FBandOverlayTex: TGLTextureCache;
|
||||||
|
FDXOverlayTex: TGLTextureCache;
|
||||||
// Текстуры флагов слайсов (B+), привязка по указателю оверлея.
|
// Текстуры флагов слайсов (B+), привязка по указателю оверлея.
|
||||||
FSliceTex: array of record
|
FSliceTex: array of record
|
||||||
Overlay: TVfoOverlay;
|
Overlay: TVfoOverlay;
|
||||||
@@ -72,6 +75,8 @@ type
|
|||||||
FLastBandW: Integer;
|
FLastBandW: Integer;
|
||||||
FLastBandCenter: Double;
|
FLastBandCenter: Double;
|
||||||
FLastBandSpan: Double;
|
FLastBandSpan: Double;
|
||||||
|
FLastDXW: Integer;
|
||||||
|
FLastDXRender: Int64;
|
||||||
FGLSpectrumW: Integer;
|
FGLSpectrumW: Integer;
|
||||||
FGLSpectrumH: Integer;
|
FGLSpectrumH: Integer;
|
||||||
FSpY: array of Integer;
|
FSpY: array of Integer;
|
||||||
@@ -93,6 +98,7 @@ type
|
|||||||
procedure DrawSpectrumCurve(W, H: Integer; DBmax, InvRange: Double);
|
procedure DrawSpectrumCurve(W, H: Integer; DBmax, InvRange: Double);
|
||||||
procedure DrawMarker(W, H: Integer);
|
procedure DrawMarker(W, H: Integer);
|
||||||
procedure DrawBeaconMarkersGL(W, H: Integer);
|
procedure DrawBeaconMarkersGL(W, H: Integer);
|
||||||
|
procedure DrawDXSpotTicksGL(W, H: Integer);
|
||||||
procedure DrawCircleGL(CX, CY: Integer; R: Single; C: TColor);
|
procedure DrawCircleGL(CX, CY: Integer; R: Single; C: TColor);
|
||||||
procedure DrawIMDMarkersGL(W, H: Integer; DBmax, InvRange: Double);
|
procedure DrawIMDMarkersGL(W, H: Integer; DBmax, InvRange: Double);
|
||||||
procedure DrawADCOverlay(W, H: Integer);
|
procedure DrawADCOverlay(W, H: Integer);
|
||||||
@@ -152,8 +158,10 @@ begin
|
|||||||
FSampleOverlayDirty := True;
|
FSampleOverlayDirty := True;
|
||||||
FVfoOverlayDirty := True;
|
FVfoOverlayDirty := True;
|
||||||
FBandOverlayDirty := True;
|
FBandOverlayDirty := True;
|
||||||
|
FDXOverlayDirty := True;
|
||||||
FLastBandW := -MaxInt;
|
FLastBandW := -MaxInt;
|
||||||
FLastBandCenter := -1; FLastBandSpan := -1;
|
FLastBandCenter := -1; FLastBandSpan := -1;
|
||||||
|
FLastDXW := -MaxInt; FLastDXRender := -1;
|
||||||
FLastAGCY := -MaxInt;
|
FLastAGCY := -MaxInt;
|
||||||
FLastAGCHangY := -MaxInt;
|
FLastAGCHangY := -MaxInt;
|
||||||
FLastMarkerX := -MaxInt;
|
FLastMarkerX := -MaxInt;
|
||||||
@@ -173,6 +181,7 @@ begin
|
|||||||
DeleteTexture(FSampleOverlayTex);
|
DeleteTexture(FSampleOverlayTex);
|
||||||
DeleteTexture(FVfoOverlayTex);
|
DeleteTexture(FVfoOverlayTex);
|
||||||
DeleteTexture(FBandOverlayTex);
|
DeleteTexture(FBandOverlayTex);
|
||||||
|
DeleteTexture(FDXOverlayTex);
|
||||||
for i := 0 to High(FSliceTex) do DeleteTexture(FSliceTex[i].Tex);
|
for i := 0 to High(FSliceTex) do DeleteTexture(FSliceTex[i].Tex);
|
||||||
for i := 0 to High(FLetterTex) do DeleteTexture(FLetterTex[i]);
|
for i := 0 to High(FLetterTex) do DeleteTexture(FLetterTex[i]);
|
||||||
for i := 0 to High(FIMDLabelTex) do DeleteTexture(FIMDLabelTex[i]);
|
for i := 0 to High(FIMDLabelTex) do DeleteTexture(FIMDLabelTex[i]);
|
||||||
@@ -454,6 +463,7 @@ begin
|
|||||||
Zap(FADCOverlayTex);
|
Zap(FADCOverlayTex);
|
||||||
Zap(FSampleOverlayTex);
|
Zap(FSampleOverlayTex);
|
||||||
Zap(FVfoOverlayTex);
|
Zap(FVfoOverlayTex);
|
||||||
|
Zap(FDXOverlayTex);
|
||||||
Zap(FBandOverlayTex);
|
Zap(FBandOverlayTex);
|
||||||
for i := 0 to High(FSliceTex) do Zap(FSliceTex[i].Tex);
|
for i := 0 to High(FSliceTex) do Zap(FSliceTex[i].Tex);
|
||||||
for i := 0 to High(FLetterTex) do Zap(FLetterTex[i]);
|
for i := 0 to High(FLetterTex) do Zap(FLetterTex[i]);
|
||||||
@@ -469,6 +479,7 @@ begin
|
|||||||
FSampleOverlayDirty := True;
|
FSampleOverlayDirty := True;
|
||||||
FVfoOverlayDirty := True;
|
FVfoOverlayDirty := True;
|
||||||
FBandOverlayDirty := True;
|
FBandOverlayDirty := True;
|
||||||
|
FDXOverlayDirty := True;
|
||||||
FGLSpectrumW := 0;
|
FGLSpectrumW := 0;
|
||||||
FGLSpectrumH := 0;
|
FGLSpectrumH := 0;
|
||||||
// Водопад — свой контекст/текстуры (история + маркер). При reparent (pop-out)
|
// Водопад — свой контекст/текстуры (история + маркер). При reparent (pop-out)
|
||||||
@@ -820,6 +831,25 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TSpectrumViewOpenGL.DrawDXSpotTicksGL(W, H: Integer);
|
||||||
|
// GL-двойник DrawDXSpotTicksRaw: те же X и цвета из раскладки оверлея, только
|
||||||
|
// линиями GL. EnsureRendered здесь и держит раскладку свежей — текстуру полосы
|
||||||
|
// DrawCachedOverlays перезальёт по RenderVersion, кто бы ни пересобрал кэш.
|
||||||
|
var
|
||||||
|
i, X, Y0: Integer;
|
||||||
|
Col: TColor;
|
||||||
|
begin
|
||||||
|
if (FDXSpotOverlay = nil) or (not FDXSpotOverlay.Active) then Exit;
|
||||||
|
FDXSpotOverlay.EnsureRendered(W);
|
||||||
|
Y0 := FDXSpotOverlay.BandHeight;
|
||||||
|
for i := 0 to FDXSpotOverlay.TickCount - 1 do
|
||||||
|
begin
|
||||||
|
FDXSpotOverlay.Tick(i, X, Col);
|
||||||
|
if (X < 0) or (X >= W) then Continue;
|
||||||
|
DrawLine(X, Y0, X, H, Col, 1, True); // пунктир — как в CPU-пути
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TSpectrumViewOpenGL.DrawCircleGL(CX, CY: Integer; R: Single; C: TColor);
|
procedure TSpectrumViewOpenGL.DrawCircleGL(CX, CY: Integer; R: Single; C: TColor);
|
||||||
// Залитый кружок (triangle fan, 20 сегментов) — маркер пика 2TON/IMD.
|
// Залитый кружок (triangle fan, 20 сегментов) — маркер пика 2TON/IMD.
|
||||||
var
|
var
|
||||||
@@ -947,6 +977,28 @@ begin
|
|||||||
DrawTexture(FBandOverlayTex, 0, H - FBandOverlayTex.H);
|
DrawTexture(FBandOverlayTex, 0, H - FBandOverlayTex.H);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
// Полоса подписей DX-спотов — вверху спектра. Тот же битмап, что в CPU-пути,
|
||||||
|
// заливается текстурой ТОЛЬКО при dirty (новый спот меняет CacheDirty
|
||||||
|
// оверлея, вид — центр/спан/ширину).
|
||||||
|
if Assigned(FDXSpotOverlay) and FDXSpotOverlay.Active then
|
||||||
|
begin
|
||||||
|
if FOverlayDirty or FDXOverlayDirty or FDXOverlayTex.Dirty or
|
||||||
|
(FLastDXW <> W) or (FLastDXRender <> FDXSpotOverlay.RenderVersion) then
|
||||||
|
begin
|
||||||
|
B := TBitmap.Create;
|
||||||
|
try
|
||||||
|
FDXSpotOverlay.DrawOverlayBitmap(B, W);
|
||||||
|
UploadBitmap(FDXOverlayTex, B, True, DXSPOT_ALPHA);
|
||||||
|
finally
|
||||||
|
B.Free;
|
||||||
|
end;
|
||||||
|
FLastDXW := W;
|
||||||
|
FLastDXRender := FDXSpotOverlay.RenderVersion;
|
||||||
|
FDXOverlayDirty := False;
|
||||||
|
end;
|
||||||
|
DrawTexture(FDXOverlayTex, 0, 0);
|
||||||
|
end;
|
||||||
|
|
||||||
if Assigned(FSampleRateOverlay) then
|
if Assigned(FSampleRateOverlay) then
|
||||||
begin
|
begin
|
||||||
OW := Min(FSampleRateOverlay.Width, W - FSampleRateOverlay.Left);
|
OW := Min(FSampleRateOverlay.Width, W - FSampleRateOverlay.Left);
|
||||||
@@ -1098,6 +1150,7 @@ begin
|
|||||||
DrawSpectrumCurve(W, H, DBmax, InvRange);
|
DrawSpectrumCurve(W, H, DBmax, InvRange);
|
||||||
DrawMarker(W, H);
|
DrawMarker(W, H);
|
||||||
if FBeaconMarkActive or FBeaconDecActive then DrawBeaconMarkersGL(W, H);
|
if FBeaconMarkActive or FBeaconDecActive then DrawBeaconMarkersGL(W, H);
|
||||||
|
DrawDXSpotTicksGL(W, H);
|
||||||
// 2TON: кружки с уровнями на пиках тонов/IMD3 (активирует MainForm при
|
// 2TON: кружки с уровнями на пиках тонов/IMD3 (активирует MainForm при
|
||||||
// 2TON+TX+DUP — реальный сигнал после PA виден на RX-спектре)
|
// 2TON+TX+DUP — реальный сигнал после PA виден на RX-спектре)
|
||||||
if FIMDActive then DrawIMDMarkersGL(W, H, DBmax, InvRange);
|
if FIMDActive then DrawIMDMarkersGL(W, H, DBmax, InvRange);
|
||||||
|
|||||||
@@ -283,6 +283,12 @@ type
|
|||||||
property OnInvalidate: TNotifyEvent read FOnInvalidate write FOnInvalidate;
|
property OnInvalidate: TNotifyEvent read FOnInvalidate write FOnInvalidate;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ BlendBitmapKey — общий keyed-композит кэш-битмапа оверлея в кадр (дворд-
|
||||||
|
блендинг, магента = прозрачность). Живёт здесь исторически; вынесен в
|
||||||
|
interface, чтобы другие оверлеи той же модели (DXSpotOverlay) не заводили
|
||||||
|
вторую копию этого же цикла. }
|
||||||
|
procedure BlendBitmapKey(Target, Source: TBitmap; DstX, DstY: Integer; Alpha: Byte);
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
function SliceColor(L: Char): TColor;
|
function SliceColor(L: Char): TColor;
|
||||||
|
|||||||
@@ -59,6 +59,11 @@ procedure SockSetNonBlock(S: TSocket; NB: Boolean);
|
|||||||
если буфер клиента переполнен, держа при этом FClientLock и блокируя Stop(). }
|
если буфер клиента переполнен, держа при этом FClientLock и блокируя Stop(). }
|
||||||
procedure SockSetSndTimeout(S: TSocket; Ms: Integer);
|
procedure SockSetSndTimeout(S: TSocket; Ms: Integer);
|
||||||
|
|
||||||
|
{ SockSetRcvTimeout — ограничивает время блокирующего SockRecv. Нужен клиентам,
|
||||||
|
которым между пакетами надо просыпаться самим (проверить Terminated, отдать
|
||||||
|
накопившиеся команды): recv возвращает -1 по таймауту, соединение живо. }
|
||||||
|
procedure SockSetRcvTimeout(S: TSocket; Ms: Integer);
|
||||||
|
|
||||||
{ ── SHA-1 ─────────────────────────────────────────────────────────────────── }
|
{ ── SHA-1 ─────────────────────────────────────────────────────────────────── }
|
||||||
|
|
||||||
type
|
type
|
||||||
@@ -123,6 +128,13 @@ begin
|
|||||||
setsockopt(S, SOL_SOCKET, SO_SNDTIMEO, @T, SizeOf(T));
|
setsockopt(S, SOL_SOCKET, SO_SNDTIMEO, @T, SizeOf(T));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure SockSetRcvTimeout(S: TSocket; Ms: Integer);
|
||||||
|
var T: DWORD;
|
||||||
|
begin
|
||||||
|
T := Ms;
|
||||||
|
setsockopt(S, SOL_SOCKET, SO_RCVTIMEO, @T, SizeOf(T));
|
||||||
|
end;
|
||||||
|
|
||||||
{$ELSE}
|
{$ELSE}
|
||||||
|
|
||||||
function SockClose(S: TSocket): Integer;
|
function SockClose(S: TSocket): Integer;
|
||||||
@@ -165,6 +177,14 @@ begin
|
|||||||
fpSetSockOpt(S, SOL_SOCKET, SO_SNDTIMEO, @TV, SizeOf(TV));
|
fpSetSockOpt(S, SOL_SOCKET, SO_SNDTIMEO, @TV, SizeOf(TV));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure SockSetRcvTimeout(S: TSocket; Ms: Integer);
|
||||||
|
var TV: TTimeVal;
|
||||||
|
begin
|
||||||
|
TV.tv_sec := Ms div 1000;
|
||||||
|
TV.tv_usec := (Ms mod 1000) * 1000;
|
||||||
|
fpSetSockOpt(S, SOL_SOCKET, SO_RCVTIMEO, @TV, SizeOf(TV));
|
||||||
|
end;
|
||||||
|
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
|
||||||
{ ═══════════════════════════════════════════════════════════════════════════
|
{ ═══════════════════════════════════════════════════════════════════════════
|
||||||
|
|||||||
Reference in New Issue
Block a user