mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:37:33 +00:00
feat(cw): терминал телеграфа — набор с клавиатуры и декодер приёма
Окно (ПКМ по CWL/CWU, F9, кнопка в настройках CW): одна лента, где принятое декодером и СВОЯ передача идут вперемешку — своё акцентным цветом. Разделять их нельзя: в QSK они перемежаются посреди фразы. Под лентой строка набора. Печать уходит в эфир ПОСИМВОЛЬНО, а не по Enter: строка показывает ровно то, что ещё не передано (очередь генератора), знаки уходят из неё по мере отправки, Backspace стирает с хвоста очереди — то, что уже звучит, вернуть нельзя. Ctrl работает манипулятором (левый точка, правый тире; у кейера прошивки лепестков нет — там это прямой ключ через бит CWX), по умолчанию выключено, чтобы Ctrl+C не уводил в эфир. Отпускание ключа ловится и на потере фокуса: иначе уход из окна с зажатым Ctrl оставил бы несущую в эфире навсегда. CWDecoder.pas: аудио → текст. Отвод берётся до громкости и мьюта — там нет программного сайдтона, зато уже отработал узкий CW-фильтр, лучшего предетектора не найти. Гёрцель гребёнкой из пяти бинов вокруг pitch (заодно показывает расстройку) → огибающая → адаптивный порог с гистерезисом → длительности → адаптивная точка → обратная таблица Морзе. Длительности живут в шагах анализа, а не в показаниях часов: разбор идёт пачками с таймера, и привязка ко времени вызова ломала бы тайминг на любой загрузке. Вылезло на тестах и учтено: пик обязан клампиться не ниже пола шума (иначе на старте порог уходит НИЖЕ шума и первым «знаком» читается собственный шум); порог дребезга берётся от текущей точки, фиксированный либо пропускает щелчки на медленной передаче, либо ест посылки на быстрой; длина посылки меряется за вычетом подтверждения дребезга, иначе скорость занижалась на 15%; расстройка запоминается только на полной амплитуде посылки, иначе индикатор пляшет. Граница честная: при вдвое неверной подсказке скорости теряется первое слово — пока не услышана настоящая точка, длина элемента неизвестна. Лента расшифровки продублирована строкой под спектром (пан 0), эхо передачи и очередь набора появились у обоих отправителей — и у локального генератора, и у кейера прошивки. ★TFlatEdit получил публичный CaretPos: он вставляет знак сам в UTF8KeyPress и гасит клавишу, поэтому OnKeyPress контрола не вызывается вовсе — из-за этого набранное «исчезало», а в эфир не уходило. Ввод перенесён на уровень формы. Проверено оффлайн: 12/20/40 WPM, расстройка, шум, слабый сигнал, цифры и знаки; плюс сквозной прогон против шести станций CW-стенда в hpsdrsim. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Claude Opus 5
@@ -0,0 +1,678 @@
|
||||
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.
|
||||
Reference in New Issue
Block a user