Files
ewsdr/CWTerminalForm.pas
ew8bakandClaude Opus 5 b02b68aa6a 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>
2026-08-10 21:28:48 +03:00

679 lines
24 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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.