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; // Моноширинный — ТОЛЬКО там, где колонки выровнены пробелами (список спотов и // лог соединения); всё остальное в окне идёт системным шрифтом, как везде по // проекту. Имя платформенное, как в CWTerminalForm: 'Courier New' есть не // всюду (на Linux fontconfig всё равно подставляет свой моноширинный). {$IFDEF WINDOWS} MONO_FONT = 'Consolas'; {$ELSE} MONO_FONT = 'Monospace'; {$ENDIF} 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 := MONO_FONT; 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 := MONO_FONT; 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); if (Md <> '') and S.ModeGuessed then Md := Md + '?'; while Length(Md) < 5 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; SelCall: string; SelFreq: Double; begin if FStore = nil then Exit; // Что выделено — запоминаем позывным И частотой: стор намеренно держит один // позывной на разных диапазонах, и по одному позывному выделение после // обновления перескочило бы на первый совпавший, а Enter/двойной клик увёл бы // радио не на тот диапазон. Keep := FList.ItemIndex; SelCall := ''; SelFreq := 0; if (Keep >= 0) and (Keep < Length(FSpots)) then begin SelCall := FSpots[Keep].Call; SelFreq := FSpots[Keep].FreqHz; end; 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 SelCall <> '' then for i := 0 to High(FSpots) do if SameText(FSpots[i].Call, SelCall) and (Abs(FSpots[i].FreqHz - SelFreq) <= DX_DEDUP_HZ) 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.