unit CWTerminalForm; { TCWTerminalForm — телеграфный терминал: лента связи + набор с клавиатуры. Почему одно окно, а не два. В работе читаешь и отвечаешь одновременно, поэтому принятое декодером и своя передача идут ОДНОЙ лентой (своё — другим цветом), а строка набора висит под ней. Так устроены fldigi и CW-окна контест-логгеров, и по делу это единственная удобная раскладка. Набор идёт В ЭФИР ПО МЕРЕ ПЕЧАТИ, а не по Enter: строка набора показывает ровно то, что ещё НЕ передано (очередь генератора), и знаки уходят из неё по мере отправки. Backspace стирает с хвоста очереди — то, что уже звучит, вернуть нельзя. Ленту рисуем сами (TPaintBox), а не TMemo: нужен цвет по фрагментам (приём / своя передача) и постоянная дописка снизу без мигания. } {$mode objfpc}{$H+} interface uses Classes, SysUtils, Math, Forms, Controls, Graphics, StdCtrls, ExtCtrls, LCLType, FlatButton, FlatEdit, FlatSpinEdit, AppTheme, Settings, DpiUtils; type TCWTermSend = procedure(const Text: string) of object; TCWTermFlag = procedure(Value: Boolean) of object; TCWTermKey = procedure(Dot, Dash: Boolean) of object; TCWTermSpeed = procedure(WPM: Integer) of object; // Фрагмент ленты: текст одного происхождения подряд. TCWRun = record Text: string; IsTX: Boolean; end; TCWTerminalForm = class(TForm) private FTheme: TAppTheme; FRuns: array of TCWRun; FLines: TStringList; // разложенная по ширине лента (текст) FLineTX: TStringList; // '1'/'0' на каждый знак строки — цвет FLog: TPaintBox; FInput: TFlatEdit; FBtnStop: TFlatButton; FBtnClear: TFlatButton; FBtnDec: TFlatButton; FBtnKbd: TFlatButton; FBtnClose: TFlatButton; FEdWPM: TFlatSpinEdit; FLblStatus: TLabel; FMacroBtns: array[0..CW_MSG_COUNT-1] of TFlatButton; FCW: TCWSettings; FUpdating: Boolean; FDecOn: Boolean; FKbdOn: Boolean; FKbdDot: Boolean; FKbdDash: Boolean; FCharW: Integer; FLineH: Integer; FOnSend: TCWTermSend; FOnAbort: TNotifyEvent; FOnBackspace:TNotifyEvent; FOnDecoder: TCWTermFlag; FOnKbdKey: TCWTermKey; FOnSpeed: TCWTermSpeed; FOnMacro: TNotifyEvent; // Sender.Tag = номер ячейки procedure BuildUI; procedure LogPaint(Sender: TObject); procedure LogResize(Sender: TObject); procedure RewrapAll; procedure AppendToWrap(const S: string; IsTX: Boolean); procedure StyleBtn(B: TFlatButton); procedure StopClick(Sender: TObject); procedure ClearClick(Sender: TObject); procedure DecClick(Sender: TObject); procedure KbdClick(Sender: TObject); procedure CloseClick(Sender: TObject); procedure MacroClick(Sender: TObject); procedure WPMChange(Sender: TObject); procedure FormUTF8Key(Sender: TObject; var UTF8Key: TUTF8Char); procedure FormKeyDownEx(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormKeyUpEx(Sender: TObject; var Key: Word; Shift: TShiftState); procedure PushKbdKey; procedure FocusInput; procedure FormLostFocus(Sender: TObject); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure ApplyTheme(const T: TAppTheme); procedure LoadFrom(const C: TCWSettings); procedure DoShow; override; // Прибавка ленты (из ServiceCWDecoder хозяина). procedure AppendLog(const S: string; IsTX: Boolean); // Строка набора = очередь передачи; статус — скорость/расстройка/сигнал. procedure SetPending(const S: string); procedure SetStatus(const S: string); property OnSend: TCWTermSend read FOnSend write FOnSend; property OnAbort: TNotifyEvent read FOnAbort write FOnAbort; property OnBackspace: TNotifyEvent read FOnBackspace write FOnBackspace; property OnDecoder: TCWTermFlag read FOnDecoder write FOnDecoder; property OnKbdKey: TCWTermKey read FOnKbdKey write FOnKbdKey; property OnSpeed: TCWTermSpeed read FOnSpeed write FOnSpeed; property OnMacro: TNotifyEvent read FOnMacro write FOnMacro; end; implementation const {$IFDEF WINDOWS} UI_FONT = 'Segoe UI'; MONO_FONT = 'Consolas'; {$ELSE} UI_FONT = 'Sans'; MONO_FONT = 'Monospace'; {$ENDIF} FORM_W = 700; FORM_H = 460; PAD = 10; ROW_H = 26; MAX_LINES = 500; constructor TCWTerminalForm.Create(AOwner: TComponent); begin inherited CreateNew(AOwner); FTheme := DarkTheme; FLines := TStringList.Create; FLineTX := TStringList.Create; TSettingsManager.DefaultCW(FCW); Scaled := False; Caption := 'CW Terminal'; BorderStyle := bsSizeable; if AOwner is TCustomForm then begin Position := poOwnerFormCenter; // ★Держим окно ПОВЕРХ главного, пока его не закрыли: набор идёт вслепую по // ленте, и если терминал ныряет под главное окно от любого клика по спектру, // работать в нём невозможно. Через transient-родителя, а не fsStayOnTop: // так окно поднимается над своим приложением, но не лезет поверх чужих // (и это единственный способ, который корректно работает на Wayland). PopupMode := pmExplicit; PopupParent := TCustomForm(AOwner); end else Position := poScreenCenter; Width := DpiScale(FORM_W); Height := DpiScale(FORM_H); Constraints.MinWidth := DpiScale(520); Constraints.MinHeight := DpiScale(300); KeyPreview := True; OnUTF8KeyPress := @FormUTF8Key; OnKeyDown := @FormKeyDownEx; OnKeyUp := @FormKeyUpEx; // ★Отпускание клавиши приходит только сфокусированному окну. Ушёл фокус с // зажатым Ctrl (alt-tab, клик по главному окну) — и несущая осталась бы в // эфире навсегда. Снимаем ключ на любой потере фокуса и при скрытии окна. OnDeactivate := @FormLostFocus; OnHide := @FormLostFocus; BuildUI; ApplyTheme(DarkTheme); end; destructor TCWTerminalForm.Destroy; begin FLines.Free; FLineTX.Free; inherited Destroy; end; procedure TCWTerminalForm.BuildUI; var i, X: Integer; begin // ---- лента --------------------------------------------------------------- FLog := TPaintBox.Create(Self); FLog.Parent := Self; FLog.Align := alClient; FLog.BorderSpacing.Around := DpiScale(PAD); FLog.BorderSpacing.Bottom := DpiScale(PAD + 3 * ROW_H + 3 * 6); FLog.OnPaint := @LogPaint; FLog.OnResize := @LogResize; // ---- строка набора ------------------------------------------------------- FInput := TFlatEdit.Create(Self); FInput.Parent := Self; FInput.Anchors := [akLeft, akRight, akBottom]; FInput.Font.Name := MONO_FONT; FInput.Font.Size := 10; // ★Обработчики ввода НЕ вешаем на поле: TFlatEdit вставляет знак сам в // UTF8KeyPress и гасит клавишу, поэтому его OnKeyPress не вызывается вовсе — // именно из-за этого набранное «исчезало», а в эфир не уходило. Весь ввод // ловим на форме (KeyPreview), а поле остаётся показывать очередь передачи. // ---- нижние ряды --------------------------------------------------------- FBtnStop := TFlatButton.Create(Self); FBtnStop.Parent := Self; FBtnStop.Caption := 'Stop'; FBtnStop.OnClick := @StopClick; FBtnStop.Anchors := [akLeft, akBottom]; FBtnClear := TFlatButton.Create(Self); FBtnClear.Parent := Self; FBtnClear.Caption := 'Clear'; FBtnClear.OnClick := @ClearClick; FBtnClear.Anchors := [akLeft, akBottom]; FBtnDec := TFlatButton.Create(Self); FBtnDec.Parent := Self; FBtnDec.Caption := 'Decoder'; FBtnDec.OnClick := @DecClick; FBtnDec.Anchors := [akLeft, akBottom]; FBtnKbd := TFlatButton.Create(Self); FBtnKbd.Parent := Self; FBtnKbd.Caption := 'Ctrl = key'; FBtnKbd.OnClick := @KbdClick; FBtnKbd.Anchors := [akLeft, akBottom]; FEdWPM := TFlatSpinEdit.Create(Self); FEdWPM.Parent := Self; FEdWPM.MinValue := 5; FEdWPM.MaxValue := 60; FEdWPM.Value := 20; FEdWPM.OnChange := @WPMChange; FEdWPM.Anchors := [akLeft, akBottom]; FLblStatus := TLabel.Create(Self); FLblStatus.Parent := Self; FLblStatus.Font.Name := UI_FONT; FLblStatus.Font.Size := 8; FLblStatus.Anchors := [akLeft, akRight, akBottom]; FLblStatus.AutoSize := False; FBtnClose := TFlatButton.Create(Self); FBtnClose.Parent := Self; FBtnClose.Caption := 'Close'; FBtnClose.OnClick := @CloseClick; FBtnClose.Anchors := [akRight, akBottom]; X := PAD; for i := 0 to CW_MSG_COUNT - 1 do begin FMacroBtns[i] := TFlatButton.Create(Self); FMacroBtns[i].Parent := Self; FMacroBtns[i].Caption := 'F' + IntToStr(i + 1); FMacroBtns[i].Tag := i; FMacroBtns[i].OnClick := @MacroClick; FMacroBtns[i].Anchors := [akLeft, akBottom]; Inc(X, 46); end; LogResize(nil); end; procedure TCWTerminalForm.LogResize(Sender: TObject); // Раскладка нижних рядов руками: якорей хватает по горизонтали, но ряды идут // снизу вверх, и считать их проще одной формулой, чем городить панели. var i, Y, X, W: Integer; begin if FInput = nil then Exit; W := ClientWidth; Y := ClientHeight - DpiScale(PAD) - DpiScale(ROW_H); // ряд 3 (низ): макросы + Close X := DpiScale(PAD); for i := 0 to CW_MSG_COUNT - 1 do begin FMacroBtns[i].SetBounds(X, Y, DpiScale(42), DpiScale(ROW_H)); Inc(X, DpiScale(46)); end; FBtnClose.SetBounds(W - DpiScale(PAD + 70), Y, DpiScale(70), DpiScale(ROW_H)); // ряд 2: кнопки + скорость + статус Dec(Y, DpiScale(ROW_H + 6)); X := DpiScale(PAD); FBtnStop.SetBounds(X, Y, DpiScale(60), DpiScale(ROW_H)); Inc(X, DpiScale(64)); FBtnClear.SetBounds(X, Y, DpiScale(60), DpiScale(ROW_H)); Inc(X, DpiScale(64)); FBtnDec.SetBounds(X, Y, DpiScale(80), DpiScale(ROW_H)); Inc(X, DpiScale(84)); FBtnKbd.SetBounds(X, Y, DpiScale(90), DpiScale(ROW_H)); Inc(X, DpiScale(94)); FEdWPM.SetBounds(X, Y, DpiScale(70), DpiScale(ROW_H)); Inc(X, DpiScale(78)); FLblStatus.SetBounds(X, Y + DpiScale(6), W - X - DpiScale(PAD), DpiScale(18)); // ряд 1: строка набора Dec(Y, DpiScale(ROW_H + 6)); FInput.SetBounds(DpiScale(PAD), Y, W - DpiScale(2 * PAD), DpiScale(ROW_H)); RewrapAll; if FLog <> nil then FLog.Invalidate; end; { ── лента ─────────────────────────────────────────────────────────────────── } procedure TCWTerminalForm.AppendToWrap(const S: string; IsTX: Boolean); // Дописываем знаки в последнюю строку, перенося по ширине окна. Цвет храним // параллельной строкой флагов — так рисование не зависит от разбиения на // фрагменты и переносы получаются посимвольно точными. var i, Cols: Integer; Flag: Char; begin if S = '' then Exit; if FCharW <= 0 then FCharW := 8; Cols := Max(8, (FLog.Width - DpiScale(8)) div FCharW); if FLines.Count = 0 then begin FLines.Add(''); FLineTX.Add(''); end; if IsTX then Flag := '1' else Flag := '0'; for i := 1 to Length(S) do begin if S[i] = #10 then begin FLines.Add(''); FLineTX.Add(''); Continue; end; if Length(FLines[FLines.Count - 1]) >= Cols then begin FLines.Add(''); FLineTX.Add(''); end; FLines[FLines.Count - 1] := FLines[FLines.Count - 1] + S[i]; FLineTX[FLineTX.Count - 1] := FLineTX[FLineTX.Count - 1] + Flag; end; while FLines.Count > MAX_LINES do begin FLines.Delete(0); FLineTX.Delete(0); end; end; procedure TCWTerminalForm.RewrapAll; var i: Integer; begin if FLog = nil then Exit; FLines.Clear; FLineTX.Clear; for i := 0 to High(FRuns) do AppendToWrap(FRuns[i].Text, FRuns[i].IsTX); end; procedure TCWTerminalForm.AppendLog(const S: string; IsTX: Boolean); var n: Integer; begin if S = '' then Exit; n := Length(FRuns); // Соседние фрагменты одного происхождения склеиваем — иначе массив распухнет // на каждый принятый знак. if (n > 0) and (FRuns[n-1].IsTX = IsTX) and (Length(FRuns[n-1].Text) < 4096) then FRuns[n-1].Text := FRuns[n-1].Text + S else begin SetLength(FRuns, n + 1); FRuns[n].Text := S; FRuns[n].IsTX := IsTX; end; // Держим историю ограниченной (окно не журнал связи). if Length(FRuns) > 400 then begin Move(FRuns[100], FRuns[0], (Length(FRuns) - 100) * SizeOf(TCWRun)); SetLength(FRuns, Length(FRuns) - 100); RewrapAll; end else AppendToWrap(S, IsTX); FLog.Invalidate; end; procedure TCWTerminalForm.LogPaint(Sender: TObject); var C: TCanvas; i, j, Y, X, First, Rows: Integer; L, F: string; begin C := FLog.Canvas; C.Brush.Color := FTheme.Panel; C.FillRect(0, 0, FLog.Width, FLog.Height); C.Pen.Color := FTheme.Border; C.Brush.Style := bsClear; C.Rectangle(0, 0, FLog.Width, FLog.Height); C.Font.Name := MONO_FONT; C.Font.Size := 10; if FLineH <= 0 then begin FLineH := C.TextHeight('Wg') + 2; FCharW := C.TextWidth('W'); if FCharW <= 0 then FCharW := 8; end; Rows := Max(1, (FLog.Height - DpiScale(8)) div FLineH); First := Max(0, FLines.Count - Rows); // всегда показываем хвост ленты Y := DpiScale(4); for i := First to FLines.Count - 1 do begin L := FLines[i]; F := FLineTX[i]; X := DpiScale(4); for j := 1 to Length(L) do begin // Своя передача — акцентом, приём — обычным текстом. Разделять их // строками нельзя: в QSK они перемежаются посреди фразы. if (j <= Length(F)) and (F[j] = '1') then C.Font.Color := FTheme.BtnTextActive else C.Font.Color := FTheme.Text; C.TextOut(X, Y, L[j]); Inc(X, FCharW); end; Inc(Y, FLineH); end; end; { ── управление ────────────────────────────────────────────────────────────── } procedure TCWTerminalForm.SetPending(const S: string); begin if FInput = nil then Exit; if FInput.Text = S then Exit; FUpdating := True; try FInput.Text := S; FInput.CaretPos := MaxInt; // курсор всегда в конце очереди набора finally FUpdating := False; end; end; procedure TCWTerminalForm.SetStatus(const S: string); begin if FLblStatus <> nil then FLblStatus.Caption := S; end; procedure TCWTerminalForm.LoadFrom(const C: TCWSettings); var i: Integer; begin FCW := C; FUpdating := True; try if FEdWPM <> nil then FEdWPM.Value := EnsureRange(C.Speed, 5, 60); for i := 0 to CW_MSG_COUNT - 1 do if FMacroBtns[i] <> nil then begin FMacroBtns[i].Hint := C.Messages[i]; FMacroBtns[i].ShowHint := C.Messages[i] <> ''; end; FDecOn := C.Decoder; FKbdOn := C.KbdKey; finally FUpdating := False; end; ApplyTheme(FTheme); // состояние кнопок-переключателей рисуется цветом end; procedure TCWTerminalForm.DoShow; begin inherited DoShow; // Набор — главное занятие в этом окне, курсор должен быть уже там. if FInput <> nil then FInput.SetFocus; end; procedure TCWTerminalForm.FormUTF8Key(Sender: TObject; var UTF8Key: TUTF8Char); // ★Печать уходит в эфир СРАЗУ, посимвольно. Строка набора нами не редактируется: // её содержимое — очередь генератора, и она перезаписывается через SetPending по // мере передачи. Знак гасим, чтобы поле не вставило его ещё и от себя. var Key: Char; begin if UTF8Key = '' then Exit; if ActiveControl <> FInput then Exit; // печатаем только в строке набора Key := UTF8Key[1]; UTF8Key := ''; if Key < #32 then Exit; if Assigned(FOnSend) then FOnSend(UpCase(Key)); // Показываем знак в очереди сразу, не дожидаясь таймера: иначе набор // ощущается «залипающим». Через 100 мс SetPending всё равно перепишет строку // настоящей очередью генератора. FUpdating := True; try FInput.Text := FInput.Text + UpCase(Key); FInput.CaretPos := MaxInt; finally FUpdating := False; end; end; procedure TCWTerminalForm.FocusInput; // ★Клик по любой кнопке уводит фокус на неё, и печать после этого молча // перестаёт уходить в эфир (ввод ловится, только пока фокус в строке набора). // Поэтому после каждого действия возвращаем курсор туда. begin if (FInput <> nil) and FInput.CanFocus then FInput.SetFocus; end; procedure TCWTerminalForm.PushKbdKey; begin if Assigned(FOnKbdKey) then FOnKbdKey(FKbdDot, FKbdDash); end; procedure TCWTerminalForm.FormLostFocus(Sender: TObject); begin if FKbdDot or FKbdDash then begin FKbdDot := False; FKbdDash := False; PushKbdKey; end; end; procedure TCWTerminalForm.FormKeyDownEx(Sender: TObject; var Key: Word; Shift: TShiftState); begin // F1..F8 — те же ячейки памяти, что в главном окне. if (Key >= VK_F1) and (Key <= VK_F8) then begin if Assigned(FOnMacro) then begin FBtnStop.Tag := Key - VK_F1; // переиспользуем Tag как переносчик номера MacroClick(FBtnStop); end; Key := 0; Exit; end; // Правка очереди передачи — только пока фокус в строке набора. Поле не // редактируем сами: его содержимое задаёт генератор (SetPending), поэтому // клавиши правки гасим здесь, до контрола. if ActiveControl = FInput then case Key of VK_BACK: begin if Assigned(FOnBackspace) then FOnBackspace(Self); if FInput.Text <> '' then begin FUpdating := True; try FInput.Text := Copy(FInput.Text, 1, Length(FInput.Text) - 1); FInput.CaretPos := MaxInt; finally FUpdating := False; end; end; Key := 0; Exit; end; VK_ESCAPE: begin if Assigned(FOnAbort) then FOnAbort(Self); Key := 0; Exit; end; // Стрелки/Delete/Enter внутри очереди смысла не имеют: эфир ушёл вперёд. VK_RETURN, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_DELETE, VK_HOME, VK_END: begin Key := 0; Exit; end; end; if not FKbdOn then Exit; // Ctrl = манипулятор. Левый — точка, правый — тире: при иамбике это полноценные // лепестки, при прямом ключе годится любой. if Key = VK_LCONTROL then begin FKbdDot := True; PushKbdKey; Key := 0; end else if Key = VK_RCONTROL then begin FKbdDash := True; PushKbdKey; Key := 0; end else if Key = VK_CONTROL then begin FKbdDot := True; PushKbdKey; Key := 0; end; end; procedure TCWTerminalForm.FormKeyUpEx(Sender: TObject; var Key: Word; Shift: TShiftState); begin if not FKbdOn then Exit; if Key = VK_LCONTROL then begin FKbdDot := False; PushKbdKey; Key := 0; end else if Key = VK_RCONTROL then begin FKbdDash := False; PushKbdKey; Key := 0; end else if Key = VK_CONTROL then begin FKbdDot := False; FKbdDash := False; PushKbdKey; Key := 0; end; end; procedure TCWTerminalForm.MacroClick(Sender: TObject); begin if Assigned(FOnMacro) then FOnMacro(Sender); FocusInput; end; procedure TCWTerminalForm.StopClick(Sender: TObject); begin if Assigned(FOnAbort) then FOnAbort(Self); FocusInput; end; procedure TCWTerminalForm.ClearClick(Sender: TObject); begin SetLength(FRuns, 0); FLines.Clear; FLineTX.Clear; FLog.Invalidate; FocusInput; end; procedure TCWTerminalForm.DecClick(Sender: TObject); begin FDecOn := not FDecOn; if Assigned(FOnDecoder) then FOnDecoder(FDecOn); ApplyTheme(FTheme); FocusInput; end; procedure TCWTerminalForm.KbdClick(Sender: TObject); begin FKbdOn := not FKbdOn; if not FKbdOn then begin FKbdDot := False; FKbdDash := False; PushKbdKey; // отпустить, если выключили с зажатой end; FCW.KbdKey := FKbdOn; ApplyTheme(FTheme); FocusInput; end; procedure TCWTerminalForm.CloseClick(Sender: TObject); begin Hide; end; procedure TCWTerminalForm.WPMChange(Sender: TObject); begin if FUpdating then Exit; if Assigned(FOnSpeed) then FOnSpeed(FEdWPM.Value); end; procedure TCWTerminalForm.StyleBtn(B: TFlatButton); begin if B = nil then Exit; B.ClrNorm := FTheme.BtnNorm; B.ClrBorder := FTheme.BtnBorderNorm; B.ClrHot := FTheme.BtnHot; B.ClrActive := FTheme.BtnActive; B.ClrText := FTheme.BtnText; B.ClrTextAct := FTheme.BtnTextActive; B.Font.Name := UI_FONT; B.Font.Size := 9; B.Invalidate; end; procedure TCWTerminalForm.ApplyTheme(const T: TAppTheme); var i: Integer; begin FTheme := T; Color := T.BG; StyleBtn(FBtnStop); StyleBtn(FBtnClear); StyleBtn(FBtnDec); StyleBtn(FBtnKbd); StyleBtn(FBtnClose); for i := 0 to CW_MSG_COUNT - 1 do StyleBtn(FMacroBtns[i]); // Переключатели: включённое состояние — акцентной рамкой и текстом. if FBtnDec <> nil then begin if FDecOn then begin FBtnDec.ClrBorder := T.BtnTextActive; FBtnDec.ClrText := T.BtnTextActive; end; FBtnDec.Invalidate; end; if FBtnKbd <> nil then begin if FKbdOn then begin FBtnKbd.ClrBorder := T.BtnTextActive; FBtnKbd.ClrText := T.BtnTextActive; end; FBtnKbd.Invalidate; end; if FInput <> nil then FInput.SetAppTheme(T); if FEdWPM <> nil then FEdWPM.SetAppTheme(T); if FLblStatus <> nil then FLblStatus.Font.Color := T.TextDim; if FLog <> nil then FLog.Invalidate; Invalidate; end; end.