From aba9bd57e4ca12ea92d7b7f182cb449bf4b4df93 Mon Sep 17 00:00:00 2001 From: 4aiman Date: Wed, 30 Sep 2026 15:44:29 +0300 Subject: [PATCH] =?UTF-8?q?=D0=9A=D0=BD=D0=BE=D0=BF=D0=BA=D0=B8=20=D0=B2?= =?UTF-8?q?=D0=BD=D0=B8=D0=B7=D1=83:=20=D0=BF=D0=BE=D0=B4=D1=81=D0=BA?= =?UTF-8?q?=D0=B0=D0=B7=D0=BA=D0=B0=20=D0=BD=D0=B5=20=D0=BF=D0=B5=D1=80?= =?UTF-8?q?=D0=B5=D1=85=D0=B2=D0=B0=D1=82=D1=8B=D0=B2=D0=B0=D0=B5=D1=82=20?= =?UTF-8?q?=D1=89=D0=B5=D0=BB=D1=87=D0=BE=D0=BA,=20=D1=89=D0=B5=D0=BB?= =?UTF-8?q?=D1=87=D0=BA=D0=B8=20=D0=BD=D0=B5=20=D1=82=D0=B5=D1=80=D1=8F?= =?UTF-8?q?=D1=8E=D1=82=D1=81=D1=8F?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Две беды у всех кнопок нижней полосы. Всплывающая подсказка появлялась прямо поверх кнопки, о которой рассказывает, и перехватывала щелчок: нажать кнопку было нельзя. Подсказка переехала в строку состояния — она в той же полосе, ничего не закрывает и меняется сразу после щелчка, не дожидаясь нового наведения. Строка состояния теперь занимает всё свободное место справа, пока рядом не показан ход работы, а самые длинные подсказки укорочены: раньше их обрезало на полуслове. Второй щелчок подряд виджетсет отдавал как двойной, и кнопка его не видела: быстрая очередь щелчков срабатывала через раз. У кнопки убран csDoubleClicks, а на случай, если двойной всё же дойдёт, он считается за обычный. Проверено: tests/lfmcheck, раздел «Кнопки нижней панели», и tests/buttonclicks.sh мышью на невидимом экране — по всем шести переключателям очереди из 1-5 щелчков отрабатываются полностью. --- README.md | 35 +++++++++ src/uMainForm.pas | 143 ++++++++++++++++++++++++++++++++---- src/uTheme.pas | 17 +++++ tests/buttonclicks.sh | 56 ++++++++++++++ tests/lfmcheck/lfmcheck.lpr | 60 ++++++++++++++- 5 files changed, 296 insertions(+), 15 deletions(-) create mode 100755 tests/buttonclicks.sh diff --git a/README.md b/README.md index aafac5d..57157ab 100644 --- a/README.md +++ b/README.md @@ -273,6 +273,29 @@ Ctrl+Shift+R, который схлопывает дыру под курсоро удаляет: она лежит, пока проект не сохранят заново. После сохранения копия не нужна и убирается. +## Кнопки внизу + +Переключатели в нижней полосе — прилипание, прилипание курсора, курсор +посередине, автосхлопывание с выбором режима, режим выделения, журнал. + +**Подсказка идёт в строку состояния, а не во всплывающее окно.** +Всплывающее окно появлялось прямо поверх кнопки, о которой +рассказывало, и перехватывало щелчок: нажать кнопку было нельзя, пока +подсказка не уйдёт. Теперь наведение мыши пишет ту же фразу в строку +состояния справа от кнопок — она ничего не закрывает. Щелчок по кнопке +подсказку тут же переписывает: «Журнал виден» становится «Журнал +спрятан». + +Строка состояния занимает всё свободное место справа и ужимается только +на время, пока рядом показан ход работы. + +**Каждый щелчок считается.** Раньше второй щелчок подряд оконная +библиотека отдавала как двойной, и до кнопки он не доходил: нажимаешь +журнал три раза быстро — срабатывает один. Теперь двойных щелчков +кнопкам не приходит вовсе, и любая очередь щелчков отрабатывается вся +(`tests/lfmcheck`, раздел «Кнопки нижней панели»; `tests/buttonclicks.sh` +проверяет то же самое мышью на невидимом экране). + ## Два режима выделения Кнопка внизу (справа от схлопывания) и клавиша `D`. Режим показан @@ -778,6 +801,18 @@ Wine с новой библиотекой не грузилось ничего. `TThread`, `Name` и `Caption` — у формы. Компилятор ловит это как «Duplicate identifier», но причину не объясняет. +**Двойной щелчок съедает второй щелчок.** Пока у элемента есть +`csDoubleClicks`, второй щелчок подряд приходит не как `Click`, а как +`DblClick`, и обработчик кнопки его не видит: человек щёлкает три раза, +срабатывает один. Лечится двумя строками в конструкторе: +`ControlStyle := ControlStyle - [csDoubleClicks]` и `DblClick`, +переопределённый в `Click`, — на случай, если двойной всё же дойдёт. + +**Всплывающая подсказка перехватывает щелчок.** Окно подсказки в gtk2 +встаёт поверх кнопки, о которой рассказывает, и щелчок попадает в него, +а не в кнопку. У кнопок в тесной полосе `ShowHint` выключен, а текст +подсказки идёт в строку состояния (`UseStatusHints` в `uMainForm`). + ## Консольный инструмент проверок Часть вещей проверяется числами, а не глазами. Сборка: `./build.sh tool`. diff --git a/src/uMainForm.pas b/src/uMainForm.pas index 2c11e2a..e148d85 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -226,6 +226,13 @@ type FStatusHoldUntil: TDateTime; { Автосохранение не удалось — жалуемся один раз, а не каждые полминуты. } FAutoSaveBroken: Boolean; + { Что было в строке состояния до того, как её занял рассказ о кнопке + под указателем, и чья именно это подсказка. Кнопка нужна затем, что + при переходе с одной на соседнюю события приходят вперемешку: уход + со старой может прийти после прихода на новую, и без проверки он + затёр бы свежую подсказку. } + FStatusBeforeHint: string; + FHintControl: TControl; procedure ApplyVolumeAt(const ATime: Double); { Переписывает файл субтитров и отдаёт его плееру. } @@ -244,6 +251,15 @@ type procedure UpdateSnapButton; procedure UpdateGlueButton; procedure UpdateSelectModeButton; + { Подсказки нижних кнопок показываются строкой состояния, а не + всплывающим окном. } + procedure BarButtonEnter(Sender: TObject); + procedure BarButtonLeave(Sender: TObject); + procedure UseStatusHints(const AButtons: array of TThemedButton); + { Перечитывает подсказку кнопки, над которой стоит указатель. } + procedure RefreshBarHint; + { Ширина строки состояния: до показателя работы или до края панели. } + procedure UpdateStatusWidth; procedure TimelineSelectModeChange(Sender: TObject); procedure UpdateCenterButton; procedure ToggleCenterPlayhead; @@ -947,12 +963,13 @@ begin FLogButton.TabStop := False; FLogButton.Down := True; FLogButton.OnClick := @LogButtonClick; - FLogButton.ShowHint := True; FLogButton.Hint := 'Журнал: спрятать или показать полосу с сообщениями'; - { Строка состояния ужимается, чтобы её длинные сообщения не залезали - под показатель и под кнопку. } - lblStatus.Width := pnlBottom.ClientWidth - lblStatus.Left - JobWidth - 24; + { Все кнопки нижней панели рассказывают о себе строкой состояния. } + UseStatusHints([btnSnap, btnGlue, btnCenter, btnRipple, btnRippleMenu, + btnSelectMode, FLogButton]); + + UpdateStatusWidth; { Сто миллисекунд, а не триста: полоска должна ползти, а не дёргаться ступеньками. } @@ -1078,6 +1095,7 @@ begin FLogButton.Hint := 'Журнал виден. Нажмите, чтобы спрятать.' else FLogButton.Hint := 'Журнал спрятан. Нажмите, чтобы показать.'; + RefreshBarHint; end; { Как растёт полоска. @@ -1159,6 +1177,7 @@ begin begin FJobLabel.Visible := False; FJobBar.Visible := False; + UpdateStatusWidth; end; { Следующая работа начинается с пустой полоски, а не с того места, где кончилась прошлая. } @@ -1196,6 +1215,7 @@ begin begin FJobLabel.Visible := True; FJobBar.Visible := True; + UpdateStatusWidth; end; end; @@ -1491,7 +1511,14 @@ begin FStatusHoldUntil := Now + StatusHoldTime else FStatusHoldUntil := 0; - lblStatus.Caption := AText; + { Указатель стоит на кнопке нижней панели, и в строке сейчас её + подсказка. Затирать подсказку нельзя: человек читает её ровно + потому, что навёл мышь. Ответ ложится под подсказку и покажется, + как только указатель уйдёт с кнопки. } + if FHintControl <> nil then + FStatusBeforeHint := AText + else + lblStatus.Caption := AText; end; procedure TMainForm.UpdateCaption; @@ -2532,10 +2559,12 @@ begin btnRipple.Hint := 'Автосхлопывание включено, режим: ' + ModeText + '.' else btnRipple.Hint := 'Автосхлопывание выключено, режим: ' + ModeText + '.'; + { Коротко: подсказка идёт одной строкой в нижней панели, и длинный + хвост там просто обрезается. } btnRipple.Hint := btnRipple.Hint + LineEnding + - 'Ctrl+K — включить или выключить. Режим действует и при выключенном ' + - 'автосхлопывании: по нему работает Ctrl+Shift+R.'; + 'Ctrl+K — включить или выключить. Режим действует и на Ctrl+Shift+R.'; btnRippleMenu.Hint := 'Выбрать режим схлопывания'; + RefreshBarHint; end; { Прилипание краёв клипов друг к другу. @@ -2557,6 +2586,7 @@ begin State := 'выключено'; btnSnap.Hint := 'Прилипание: ' + State + '.' + LineEnding + 'Shift во время перетаскивания меняет решение на противоположное.'; + RefreshBarHint; end; procedure TMainForm.btnSnapClick(Sender: TObject); @@ -2581,6 +2611,7 @@ begin State := 'выключено'; btnGlue.Hint := 'Прилипание курсора к границам клипов: ' + State + '.' + LineEnding + 'Shift при щелчке меняет решение на противоположное.'; + RefreshBarHint; end; procedure TMainForm.btnGlueClick(Sender: TObject); @@ -2589,6 +2620,90 @@ begin UpdateGlueButton; end; +{ Подсказка к кнопке нижней панели показывается в строке состояния. + + Всплывающее окно здесь мешало: оно появлялось прямо поверх кнопки, о + которой рассказывает, перехватывало щелчок, и нажать кнопку было нельзя. + Строка состояния стоит в той же панели, ничего не закрывает и читается + без наведения мыши. } +procedure TMainForm.BarButtonEnter(Sender: TObject); +begin + if not (Sender is TControl) then + Exit; + if TControl(Sender).Hint = '' then + Exit; + if FHintControl = nil then + FStatusBeforeHint := lblStatus.Caption; + FHintControl := TControl(Sender); + RefreshBarHint; +end; + +procedure TMainForm.BarButtonLeave(Sender: TObject); +begin + { Ушли не с той кнопки, чья подсказка сейчас показана — значит указатель + уже на соседней, и трогать строку нельзя. } + if (FHintControl = nil) or (Sender <> FHintControl) then + Exit; + FHintControl := nil; + lblStatus.Caption := FStatusBeforeHint; +end; + +{ Подсказка переключателя меняется от щелчка по нему: «спрятан» — + «виден», «включено» — «выключено». Указатель при этом остаётся на + кнопке, второго наведения не будет, и без этого вызова в строке + состояния висел бы прежний текст — прямо противоположный тому, что + кнопка теперь делает. } +procedure TMainForm.RefreshBarHint; +var + Line: string; +begin + if FHintControl = nil then + Exit; + Line := FHintControl.Hint; + if Line = '' then + Line := FStatusBeforeHint + else + { Подсказки писались в несколько строк для всплывающего окна; в + строке состояния они идут одной. } + Line := StringReplace(Line, LineEnding, ' ', [rfReplaceAll]); + lblStatus.Caption := Line; +end; + +{ Строка состояния занимает всё, что свободно справа. + + Показатель работы появляется только пока что-то собирается или + разбирается. Всё остальное время его место пустует, а подсказки к + кнопкам — длинные, и в отведённые под них шестьсот точек не влезали: + человек видел «Переключит…» вместо целой фразы. Поэтому ширина + пересчитывается каждый раз, когда показатель появляется или прячется. } +procedure TMainForm.UpdateStatusWidth; +var + Right: Integer; +begin + if (FJobLabel = nil) or (lblStatus = nil) then + Exit; + if FJobLabel.Visible then + Right := FJobLabel.Left - 12 + else + Right := pnlBottom.ClientWidth - 12; + lblStatus.Width := Max(120, Right - lblStatus.Left); +end; + +{ Переводит кнопки на подсказки в строке состояния. } +procedure TMainForm.UseStatusHints(const AButtons: array of TThemedButton); +var + I: Integer; +begin + for I := 0 to High(AButtons) do + begin + if AButtons[I] = nil then + Continue; + AButtons[I].ShowHint := False; + AButtons[I].OnMouseEnter := @BarButtonEnter; + AButtons[I].OnMouseLeave := @BarButtonLeave; + end; +end; + { Кнопка режима выделения. Режима два, и кнопка показывает не «включено-выключено», а какой сейчас: @@ -2605,19 +2720,18 @@ begin if FTimeline.SelectionMode = smRange then begin btnSelectMode.Icon := tiSelectRange; - btnSelectMode.Hint := 'Выделение по времени: протяжка отмечает ' + - 'промежуток по всем дорожкам.' + LineEnding + - 'S режет все дорожки по обоим краям промежутка.' + LineEnding + - 'Переключить (D) на выделение клипов рамкой.'; + btnSelectMode.Hint := 'Выделение по времени: протяжка метит ' + + 'промежуток на всех дорожках, S режет по его краям.' + LineEnding + + 'Переключить (D) на выделение клипов.'; end else begin btnSelectMode.Icon := tiSelectClips; btnSelectMode.Hint := 'Выделение клипов: рамка выделяет всё, что ' + - 'задела.' + LineEnding + - 'S режет по курсору.' + LineEnding + - 'Переключить (D) на выделение промежутка по времени.'; + 'задела, S режет по курсору.' + LineEnding + + 'Переключить (D) на выделение промежутка.'; end; + RefreshBarHint; end; procedure TMainForm.btnSelectModeClick(Sender: TObject); @@ -2660,6 +2774,7 @@ begin State := 'выключено'; btnCenter.Hint := 'Курсор посередине при воспроизведении: ' + State + '.' + LineEnding + 'Клавиша \ переключает.'; + RefreshBarHint; end; procedure TMainForm.ToggleCenterPlayhead; diff --git a/src/uTheme.pas b/src/uTheme.pas index f531cd9..4c70aa4 100644 --- a/src/uTheme.pas +++ b/src/uTheme.pas @@ -132,6 +132,9 @@ type X, Y: Integer); override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyUp(var Key: Word; Shift: TShiftState); override; + { Если двойной щелчок всё же дойдёт (виджетсет может послать его и + без csDoubleClicks), считаем его обычным нажатием. } + procedure DblClick; override; procedure TextChanged; override; class function GetControlClassDefaultSize: TSize; override; public @@ -163,6 +166,10 @@ type property Flat: Boolean read FFlat write SetFlat default False; property Font; property Hint; + { Наведение и уход: главному окну они нужны, чтобы показывать + подсказку строкой состояния, а не всплывающим окном поверх кнопки. } + property OnMouseEnter; + property OnMouseLeave; property ModalResult: TModalResult read FModalResult write FModalResult default mrNone; property ParentFont; @@ -392,6 +399,11 @@ begin { csHasDefaultAction говорит форме, что нашу кнопку осмысленно вызывать по Enter; без этого Enter до неё не дойдёт. } ControlStyle := ControlStyle + [csHasDefaultAction, csHasCancelAction]; + { Двойной щелчок кнопке не нужен, а вреден. Второе нажатие подряд + приходит как двойное и обычным щелчком не считается — нажатие просто + пропадало. Со стороны это выглядело как «нажимаю быстро — не + срабатывает, нажимаю медленно — срабатывает». } + ControlStyle := ControlStyle - [csDoubleClicks]; TabStop := True; DoubleBuffered := True; { Без явного значения образец был бы чёрным (ноль — это clBlack), и @@ -733,6 +745,11 @@ begin с клавиатуры давало одну. } end; +procedure TThemedButton.DblClick; +begin + Click; +end; + procedure TThemedButton.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); diff --git a/tests/buttonclicks.sh b/tests/buttonclicks.sh new file mode 100755 index 0000000..54ac5e1 --- /dev/null +++ b/tests/buttonclicks.sh @@ -0,0 +1,56 @@ +#!/bin/sh +# Проверка того, что каждый быстрый щелчок по кнопке нижней полосы +# доходит до неё. +# +# Кнопки там — переключатели: щелчок меняет вид полосы. Значит, N щелчков +# подряд должны дать N переключений, и снимки с одинаковой чётностью +# числа щелчков обязаны совпасть, с разной — разойтись. Раньше второй +# щелчок подряд приходил как двойной и пропадал. +# +# Запуск (редактор уже должен идти на невидимом экране :99): +# tests/buttonclicks.sh <окно> +# где окно — из `DISPLAY=:99 xdotool search --name nlve`, а x и y — +# точка внутри кнопки. +set -e +cd "$(dirname "$0")/.." +WIN=$1 +X=$2 +Y=$3 +DISP=${DISP:-:99} +SHOT=${SHOT:-test/кадры-кнопок} +rm -rf "$SHOT"; mkdir -p "$SHOT" + +# Снимается низ окна: там и полоса сообщений, и сами кнопки. +H=$(DISPLAY=$DISP xwininfo -id "$WIN" | awk '/Height:/ {print $2}') +W=$(DISPLAY=$DISP xwininfo -id "$WIN" | awk '/Width:/ {print $2}') +CROP="${W}x200+0+$((H - 200))" + +# Мышь уводится с кнопки перед снимком: под курсором подсказка идёт в +# строку состояния, и её текст сам по себе отличал бы снимки. +snap() { + DISPLAY=$DISP xdotool mousemove $((W / 2)) $((H / 3)) + sleep 0.4 + DISPLAY=$DISP import -window "$WIN" -crop "$CROP" +repage "$SHOT/$1.png" +} +same() { compare -metric AE "$SHOT/$1.png" "$SHOT/$2.png" null: 2>&1 | cut -d' ' -f1; } + +snap base +TOTAL=0 +for N in 1 2 3 4 5; do + I=0 + while [ $I -lt $N ]; do + DISPLAY=$DISP xdotool mousemove "$X" "$Y" click 1 + I=$((I + 1)) + sleep 0.12 + done + TOTAL=$((TOTAL + N)) + sleep 1.2 + snap "после$TOTAL" + echo "залпом $N, всего щелчков $TOTAL: отличий от исходной $(same base "после$TOTAL")" +done + +# Полоса сообщений прирастает строками сама по себе, поэтому сверяемся не +# с исходной картинкой, а снимками между собой. +echo " 3 и 15 щелчков (оба нечётные, должны совпасть): $(same после3 после15)" +echo " 6 и 10 щелчков (оба чётные, должны совпасть): $(same после6 после10)" +echo " 6 и 15 щелчков (чётное и нечётное, должны разойтись): $(same после6 после15)" diff --git a/tests/lfmcheck/lfmcheck.lpr b/tests/lfmcheck/lfmcheck.lpr index 0765eef..e9cba41 100644 --- a/tests/lfmcheck/lfmcheck.lpr +++ b/tests/lfmcheck/lfmcheck.lpr @@ -14,7 +14,7 @@ program lfmcheck; uses { Interfaces нужен, чтобы связалась вся LCL и заработала загрузка файлов форм. } - Interfaces, Forms, Classes, SysUtils, Math, TypInfo, uTheme, + Interfaces, Forms, Controls, Classes, SysUtils, Math, TypInfo, uTheme, uMediaProbe, uProject, uTransform, uTimelineCtrl, uPanCropForm, uDepsForm, uMismatchForm, uProgressForm, uProjectInfoForm, uRemuxForm; @@ -753,6 +753,63 @@ begin end; end; +{ Кнопка нижней панели и быстрые щелчки. + + Второй щелчок подряд оконная библиотека отдаёт не как щелчок, а как + двойной — и обработчик кнопки его не видел. Человек нажимал кнопку + дважды, а срабатывало один раз. + + Проверяется двумя способами: у кнопки нет csDoubleClicks (тогда + двойных щелчков к ней вообще не приходит), и даже если двойной + придёт, он считается за щелчок. } +type + TButtonProbe = class(TThemedButton) + public + procedure Twice; + end; + +procedure TButtonProbe.Twice; +begin + DblClick; +end; + +var + ClickCount: Integer = 0; + +type + TClickCounter = class + procedure Clicked(Sender: TObject); + end; + +procedure TClickCounter.Clicked(Sender: TObject); +begin + Inc(ClickCount); +end; + +procedure CheckButtonClicks; +var + Btn: TButtonProbe; + Counter: TClickCounter; +begin + WriteLn; + WriteLn('Кнопки нижней панели'); + WriteLn; + + Counter := TClickCounter.Create; + Btn := TButtonProbe.Create(nil); + try + Btn.OnClick := @Counter.Clicked; + CheckTrue('двойные щелчки кнопке не приходят', + not (csDoubleClicks in Btn.ControlStyle)); + ClickCount := 0; + Btn.Twice; + CheckTrue('двойной щелчок считается за щелчок', ClickCount = 1); + finally + Btn.Free; + Counter.Free; + end; +end; + begin WriteLn('Свойства из файлов форм'); WriteLn; @@ -788,6 +845,7 @@ begin CheckSplitAndPlayhead; CheckSplitAllTracks; CheckGapTolerance; + CheckButtonClicks; WriteLn; if Failed = 0 then