From 44c0a5de240ac3062cc54fd31a77818692b534e7 Mon Sep 17 00:00:00 2001 From: 4aiman Date: Thu, 1 Oct 2026 15:50:10 +0300 Subject: [PATCH] =?UTF-8?q?=D0=9F=D0=BE=D0=BA=D0=B0=D0=B7=D0=B0=D1=82?= =?UTF-8?q?=D0=B5=D0=BB=D1=8C=20=D1=80=D0=B0=D0=B1=D0=BE=D1=82=D1=8B:=20?= =?UTF-8?q?=D1=87=D0=B8=D1=81=D0=BB=D0=BE=20=D0=B8=20=D0=BF=D0=BE=D0=BB?= =?UTF-8?q?=D0=BE=D1=81=D0=B0=20=D0=BF=D0=BE=D0=BA=D0=B0=D0=B7=D1=8B=D0=B2?= =?UTF-8?q?=D0=B0=D1=8E=D1=82=20=D0=BE=D0=B4=D0=BD=D0=BE=20=D0=B8=20=D1=82?= =?UTF-8?q?=D0=BE=20=D0=B6=D0=B5?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Полоса ползла по догадке, а подпись показывала замер — и человек видел полосу, заполненную на девять десятых, рядом с нулём процентов. Что в этот момент происходит, по такой паре понять нельзя. Теперь доля одна на обоих. Берётся она у самого ffmpeg: сборка участка с затуханием идёт минуту и дольше, а «кусок 1 из 1» всё это время не меняется, поэтому ffmpeg спрашивают ключом -progress, докуда он дошёл. Пока он не ответил ни разу, полоса трогается с места на пару процентов и там стоит — пустая полоса и есть правда о только что начатой работе. Догадка заодно перестала закрывать промежуток до вехи целиком: предел — девять десятых, остаток виден глазом. Проверка на это добавлена в tests/progress. Полоса в окне сборки была системной, и под gtk2 заполнялась ступенями по восемь кусков на ширину. Теперь там та же своя полоса, что и внизу главного окна, — заполняется сплошь. Чтобы она читалась из файла формы, у неё опубликованы Anchors, Align и Visible: читатель формы берёт только опубликованные свойства, и без этого окно падало при открытии. Проверено глазами на невидимом экране: «Собираю наложение 1 из 1 — 2%» при полосе в 2%, через четыре секунды 69% при полосе в 69%. --- README.md | 18 +++++++++++ src/uAppTypes.pas | 18 +++++++++++ src/uGenerate.pas | 60 +++++++++++++++++++++++++++++++++++-- src/uMainForm.pas | 29 +++++++++++++++--- src/uProgressForm.lfm | 7 ++--- src/uProgressForm.pas | 17 +++++------ src/uTheme.pas | 7 +++++ tests/progress/progtest.lpr | 16 ++++++++++ 8 files changed, 151 insertions(+), 21 deletions(-) diff --git a/README.md b/README.md index 2465c7e..23ee6a7 100644 --- a/README.md +++ b/README.md @@ -634,6 +634,24 @@ Linux потом искала по нему `.dll`. пересчитывается на каждом шаге. Даже такая оценка отвечает на главный вопрос: успею ли я сходить за чаем. +**Полоса и число — одно и то же число.** Показатель работы внизу главного +окна подписан процентами, и это ровно та доля, которую он нарисовал. +Раньше полоса ползла по догадке, а подпись показывала замер: человек +видел полосу, заполненную на девять десятых, рядом с нулём процентов, и +понять по такой паре было нельзя ничего. + +**Доля берётся у ffmpeg, а не угадывается.** Сборка участка с наложением +или затуханием может идти минуту и дольше, и всё это время «кусок 1 из 1» +не меняется. Поэтому ffmpeg спрашивают, докуда он дошёл (`-progress`), и +доля считается по его ответу. Пока он не ответил ни разу, полоса трогается +с места на пару процентов и там стоит: пустая полоса и есть правда о +только что начатой работе. + +**Обе полосы рисует один и тот же код.** Полоса в окне сборки раньше была +системной (`TProgressBar`), и под gtk2 она заполнялась ступенями — восемь +кусков на всю ширину. Теперь и там, и внизу главного окна стоит своя +`TThemedProgress`, которая заполняется сплошь. + ## Как собирается ролик 1. Монтаж уплощается в последовательность непересекающихся кусков. diff --git a/src/uAppTypes.pas b/src/uAppTypes.pas index c7b9144..9571e2c 100644 --- a/src/uAppTypes.pas +++ b/src/uAppTypes.pas @@ -232,12 +232,30 @@ begin end; function AdvanceProgress(AShown, AReal, ANext, AStepShare: Double): Double; +var + Guessed: Double; begin Result := AShown; if AReal > Result then Result := AReal; if ANext > Result then Result := Result + (ANext - Result) * AStepShare; + + { Догадка не закрывает промежуток до вехи целиком. + + Шаги мельчают, но за сотню их полоса подбиралась к вехе вплотную, и + на единственном шаге — когда веха одна и она же конец — доползала до + края. Человек видел заполненную полосу у работы, которая ещё идёт, и + считал программу зависшей. Девять десятых промежутка — предел: + остаток виден глазом и говорит, что веха не достигнута. } + Guessed := AReal + (ANext - AReal) * 0.9; + { Назад полоса не идёт никогда, даже если веха сместилась: предел не + опускается ниже уже показанного. } + if Guessed < AShown then + Guessed := AShown; + if (ANext > AReal) and (Result > Guessed) then + Result := Guessed; + { До самого конца полоска не доходит: конец наступает тогда, когда работа кончилась, а не когда мы досчитали. } if Result > 0.999 then diff --git a/src/uGenerate.pas b/src/uGenerate.pas index cc7ff28..3bda511 100644 --- a/src/uGenerate.pas +++ b/src/uGenerate.pas @@ -36,6 +36,13 @@ type FCancelled: Boolean; FMessage: string; FCurrent: Integer; + { Насколько сделан кусок, который считается прямо сейчас: 0..1. + Берётся у самого ffmpeg, а не угадывается. } + FStepFraction: Double; + FStepSeconds: Double; + { Сказал ли ffmpeg хоть раз, докуда он дошёл по этому куску. Пока не + сказал, настоящей доли нет и показывать нечего. } + FStepKnown: Boolean; FOnProgress: TNotifyEvent; FOnLog: TNotifyEvent; @@ -44,6 +51,8 @@ type procedure Log(const AText: string); function CancelQuery: Boolean; procedure ErrorLine(const ALine: string); + { Строки «ключ=значение», которые ffmpeg шлёт о ходе работы. } + procedure ProgressLine(const ALine: string); procedure Publish; protected procedure Execute; override; @@ -57,6 +66,13 @@ type работы: по ним он знает, докуда ползти до следующей вехи. } function Total: Integer; property Done: Integer read FCurrent; + { Доля сделанного внутри текущего куска. Показателю работы она нужна, + чтобы полоса ползла по настоящему ходу, а не по догадке: кусок + бывает и на полторы минуты, и всё это время Done не меняется. } + property StepFraction: Double read FStepFraction; + { Есть ли по текущему куску настоящий замер. Нет — показатель работы + не имеет права рисовать заполненную полосу. } + property StepKnown: Boolean read FStepKnown; { Место на монтаже, которое считается прямо сейчас. Ноль в обоих — значит, к монтажу это отношения не имеет. } function BusyFrom: Double; @@ -138,6 +154,35 @@ begin Log('ffmpeg: ' + ALine); end; +{ Ход работы берётся у самого ffmpeg. + + Раньше показатель знал только «кусок такой-то из стольких» и между + кусками полз вслепую. На коротких вставках это проходило, а на + затухании в полторы минуты полоса успевала доползти до края и застыть: + со стороны это выглядело как зависшая программа. Теперь ffmpeg каждые + полсекунды сообщает, до какого места он дошёл, и доля честная. } +procedure TGenerateThread.ProgressLine(const ALine: string); +var + Seconds: Double; + AtEnd: Boolean; +begin + if FStepSeconds <= 0 then + Exit; + Seconds := 0; + AtEnd := False; + if not ParseProgressLine(ALine, Seconds, AtEnd) then + Exit; + FStepKnown := True; + FStepFraction := Seconds / FStepSeconds; + if FStepFraction < 0 then + FStepFraction := 0; + { Единицу не отдаём: единица — это «кусок готов», а готовым он станет, + когда ffmpeg закончит и файл окажется на месте. } + if FStepFraction > 0.99 then + FStepFraction := 0.99; + Publish; +end; + function TGenerateThread.Total: Integer; begin Result := Length(FRequests); @@ -162,7 +207,7 @@ end; procedure TGenerateThread.Publish; begin if Length(FRequests) > 0 then - FFraction := FCurrent / Length(FRequests) + FFraction := (FCurrent + FStepFraction) / Length(FRequests) else FFraction := 1; Synchronize(@SyncProgress); @@ -214,6 +259,11 @@ begin end; FCurrent := I; + { Длина куска нужна, чтобы перевести «дошёл до такой-то секунды» в + долю. У вставок она и есть длительность заказа. } + FStepFraction := 0; + FStepKnown := False; + FStepSeconds := FRequests[I].Duration; case FRequests[I].Kind of gkBlack: FStageText := Format('Делаю чёрную вставку %d из %d', @@ -269,7 +319,8 @@ begin end; Log('> ' + CommandToString(FfmpegExe, Args)); - Res := RunProcess(FfmpegExe, Args, nil, @ErrorLine, @CancelQuery); + Res := RunProcess(FfmpegExe, Args, @ProgressLine, @ErrorLine, + @CancelQuery); { Распаковка на видеокарте не пошла — повторяем на процессоре. @@ -286,7 +337,10 @@ begin FMaster.PixFmt, FMaster.VideoCodec, False, FMaster.VideoBitrate, '', NotPiped, False); Log('> ' + CommandToString(FfmpegExe, Args)); - Res := RunProcess(FfmpegExe, Args, nil, @ErrorLine, @CancelQuery); + FStepFraction := 0; + FStepKnown := False; + Res := RunProcess(FfmpegExe, Args, @ProgressLine, @ErrorLine, + @CancelQuery); end; if Res.Cancelled then diff --git a/src/uMainForm.pas b/src/uMainForm.pas index fb0efd7..dfc4510 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -1128,7 +1128,8 @@ var { Не Text: так называется свойство самой формы, а имена в Паскале нечувствительны к регистру. } Note: string; - Frac: Double; + Frac, Step: Double; + StepKnown: Boolean; Total, Done, Kind: Integer; begin {$IFDEF LCLWIN32} @@ -1144,6 +1145,9 @@ begin Total := 0; Done := 0; Kind := 0; + { Доля сделанного внутри текущего шага и есть ли она вообще. } + Step := 0; + StepKnown := False; { Порядок важен: показываем то, чего человек ждёт прямо сейчас. @@ -1155,6 +1159,8 @@ begin Kind := 1; Total := FGenerate.Total; Done := FGenerate.Done; + Step := FGenerate.StepFraction; + StepKnown := FGenerate.StepKnown; Note := FGenerate.StageText; if Note = '' then Note := 'Готовлю участки монтажа'; @@ -1204,8 +1210,17 @@ begin if Total > 0 then begin - FJobReal := Done / Total; - FJobNext := (Done + 1) / Total; + FJobReal := (Done + Step) / Total; + if StepKnown then + { Работа сама говорит, докуда дошла. Догадываться тут нечего и + нельзя: догадка разойдётся с числом, которое мы же и показываем, + и получится полная полоса рядом с нулём процентов. } + FJobNext := FJobReal + else + { Замера ещё нет — только запустились. Полоса трогается с места, + чтобы было видно, что работа жива, но уходит недалеко: пустая + полоса и есть правда о начале работы. } + FJobNext := FJobReal + 0.05 / Total; end else begin @@ -1216,7 +1231,13 @@ begin AdvanceJobBar; Frac := FJobShown; - FJobLabel.Caption := Note; + { Число и полоса — одно и то же число. + + Раньше полоса показывала догадку, а подпись — замер, и человек видел + полосу, заполненную на девять десятых, рядом с нулём процентов. Что + в этот момент происходит, по такой паре понять нельзя. Теперь + показывается ровно то, что нарисовано. } + FJobLabel.Caption := Note + Format(' — %d%%', [Round(Frac * 100)]); FJobBar.Fraction := Frac; if not FJobLabel.Visible then begin diff --git a/src/uProgressForm.lfm b/src/uProgressForm.lfm index 0a829ac..6f43c91 100644 --- a/src/uProgressForm.lfm +++ b/src/uProgressForm.lfm @@ -30,13 +30,12 @@ object ProgressForm: TProgressForm Caption = 'Готовлю' ParentColor = False end - object pbBar: TProgressBar + object pbBar: TThemedProgress Left = 12 - Height = 22 - Top = 40 + Height = 10 + Top = 46 Width = 736 Anchors = [akTop, akLeft, akRight] - TabOrder = 0 end object lblEta: TLabel Left = 12 diff --git a/src/uProgressForm.pas b/src/uProgressForm.pas index 269e6c5..4029766 100644 --- a/src/uProgressForm.pas +++ b/src/uProgressForm.pas @@ -28,7 +28,11 @@ type lblStage: TLabel; lblEta: TLabel; memoLog: TLogView; - pbBar: TProgressBar; + { Полоса своя, а не системная: TProgressBar под gtk2 рисуется + ступеньками, по восемь кусков на всю ширину, и ход работы в ней + виден рывками. Эта заполняется сплошь, как та, что внизу главного + окна. } + pbBar: TThemedProgress; pnlTop: TPanel; procedure btnActionClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); @@ -59,11 +63,6 @@ implementation {$R *.lfm} -const - { Прогресс держим в целых долях от десяти тысяч: с шагом в один процент - полоса на длинной операции выглядит замершей. } - BarScale = 10000; - { TProgressForm } procedure TProgressForm.FormCreate(Sender: TObject); @@ -71,9 +70,7 @@ begin { Цвета задаём сами: системная тема может быть светлой, и тогда тёмный таймлайн оказался бы в белой рамке. } ApplyDarkTheme(Self); - pbBar.Min := 0; - pbBar.Max := BarScale; - pbBar.Position := 0; + pbBar.Fraction := 0; memoLog.Clear; btnAction.Caption := 'Отмена'; FStartedAt := Now; @@ -121,7 +118,7 @@ begin AValue := 0; if AValue > 1 then AValue := 1; - pbBar.Position := Round(AValue * BarScale); + pbBar.Fraction := AValue; FLastFraction := AValue; Elapsed := (Now - FStartedAt) * SecsPerDay; diff --git a/src/uTheme.pas b/src/uTheme.pas index 4c70aa4..abeae9e 100644 --- a/src/uTheme.pas +++ b/src/uTheme.pas @@ -93,6 +93,13 @@ type public constructor Create(AOwner: TComponent); override; property Fraction: Double read FFraction write SetFraction; + published + { Опубликовано ради файлов форм: читатель формы берёт только + опубликованные свойства, и без этого «Anchors» в .lfm роняет окно + при открытии — не при сборке. } + property Anchors; + property Align; + property Visible; end; { Кнопка, которая рисует себя сама. diff --git a/tests/progress/progtest.lpr b/tests/progress/progtest.lpr index 7706b25..4a96e76 100644 --- a/tests/progress/progtest.lpr +++ b/tests/progress/progtest.lpr @@ -99,6 +99,22 @@ begin end; Check('ход монотонный', V >= Prev); + { 7. Одна-единственная веха — и та конец. + + Так выглядит сборка одного куска: сделано ноль из одного. Полоса + ползёт к единице и раньше подбиралась к ней вплотную — заполненная + полоса у работы, которая ещё идёт, читается как зависшая программа. + Теперь догадка не закрывает промежуток целиком, и остаток виден. } + V := 0; + for I := 1 to 1000 do + V := AdvanceProgress(V, 0, 1, Step); + Check('без замеров полоса не доходит до края: ' + + FloatToStrF(V, ffFixed, 8, 3), V <= 0.91); + + { А как только приходит настоящий замер, полоса слушается его. } + V := AdvanceProgress(V, 0.95, 1, Step); + Check('настоящий замер перекрывает догадку', V >= 0.95); + WriteLn; if Failed = 0 then WriteLn('ВЕРДИКТ: все проверки пройдены')