4aiman/nlve
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Свойства клипа, порядок дорожек, оценка времени и продолжение сборки

Browse source 
Копирование оформления: Ctrl+Shift+C берёт с выделенного клипа
кадрирование, поворот, увеличение, смещение, прозрачность, ключ,
затухания и громкость, Ctrl+Shift+V применяет их ко всем выделенным. Вид
клипа и текст не переносятся: свойства копируют между разными клипами.

Порядок дорожек: слева в заголовке две стрелки, у крайних дорожек
соответствующая нарисована тускло и не нажимается. Двойной щелчок по
названию переименовывает дорожку — на монтаже из десятка дорожек «карта»
и «титры» читаются лучше, чем V1 и Т1. То же есть и в меню по правому
щелчку. Ввод имени — своим тёмным окном: системный InputQuery выглядел бы
белым пятном.

Окно сборки показывает, сколько прошло и сколько примерно осталось.
Оценка по пройденной доле; скорость на деле меняется, поэтому «примерно»
и пересчёт на каждом шаге.

Прерванная сборка продолжается с готовых кусков. Каждый доведённый до
конца кусок помечается в списке рядом с ними: одного наличия файла мало —
сборку могли прервать посреди записи. Первая строка списка — отпечаток
плана; не совпал, значит монтаж менялся, и всё собирается заново.
Проверено: четыре куска взяты готовыми, два пересобраны, склейка не
потеряла ни одного кадра; при изменённом монтаже готовые куски отвергнуты.
This commit is contained in:
4aiman 2026-08-31 14:55:19 +03:00
commit 638878bea2
9 changed files with 608 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

43
README.md
View file

@ -165,10 +165,21 @@ xdg-mime query default application/x-nlve-project
ролик. Отметки живут в файле проекта: участок относится к монтажу, а не к
привычкам человека.
**Дорожки.** Правый щелчок по заголовку открывает меню: поднять,
опустить, удалить. Заголовок можно и просто потащить мышью — порядок
дорожек и есть порядок перекрытия, и менять его перетаскиванием
привычнее. Удаление дорожки с клипами спрашивает подтверждение.
**Дорожки.** Слева в заголовке две стрелки: поднять и опустить. У верхней
дорожки некуда вверх, у нижней вниз — такая стрелка нарисована тускло и
не нажимается. Заголовок можно и просто потащить мышью. Двойной щелчок по
названию переименовывает дорожку: на монтаже из десятка дорожек «карта»,
«звук мотора» и «титры» читаются несравнимо лучше, чем V1, A2 и Т1.
Правый щелчок по заголовку открывает меню: поднять, опустить,
переименовать, удалить. Удаление дорожки с клипами спрашивает
подтверждение и называет число клипов.
**Копирование свойств клипа.** Ctrl+Shift+C берёт с выделенного клипа всё
оформление — кадрирование, поворот, увеличение, смещение, прозрачность,
цветовой ключ, затухания, громкость, — Ctrl+Shift+V применяет их ко всем
выделенным. Вид клипа и его текст при этом не переносятся: свойства
копируют между разными клипами, и превращать картинку в надпись незачем.
**Схлопывание.** Кнопка внизу показывает и режим, и состояние: утоплена —
автосхлопывание включено, и тогда при перетаскивании клипа всё, что
@ -402,6 +413,30 @@ Linux потом искала по нему `.dll`.
со скопированными, и если он окажется хуже их, разница видна именно на
нём. Лишнее место дешевле.
## Прерванная сборка
Каждый доведённый до конца кусок помечается в списке рядом с самими
кусками (`готово.txt` в кэше). Если сборка не дошла до конца — упала,
была отменена или программу закрыли, — при следующей сборке в тот же файл
программа предложит продолжить с готовых кусков.
Проверяется не только наличие файла: сборку могли прервать посреди
записи, и файл оказался бы обрезанным. Поэтому куском считается только
тот, который успел попасть в список.
Первая строка списка — отпечаток плана: пути, места и длины всех кусков.
Не совпал — значит монтаж с тех пор менялся, и готовые куски не подойдут;
программа скажет об этом и соберёт заново.
## Сколько осталось
Окно сборки показывает, сколько прошло и сколько примерно осталось.
Оценка простая: если четверть пути заняла минуту, весь путь займёт
четыре. На деле скорость меняется — копируемые куски идут мгновенно,
пересобираемые медленно, — поэтому число называется «примерно» и
пересчитывается на каждом шаге. Даже такая оценка отвечает на главный
вопрос: успею ли я сходить за чаем.
## Как собирается ролик
1. Монтаж уплощается в последовательность непересекающихся кусков.

168
src/uExport.pas
View file

@ -116,6 +116,12 @@ type
FFraction: Double;
FPendingLog: string;
FLogPath: string;
FResume: Boolean;
FReusedParts: Integer;
{ Имена кусков, доведённых до конца в этой или прошлой сборке. }
FDone: TStringList;
{ Признак того, что готовые куски относятся к этому же монтажу. }
FPlanKey: string;
FReport: TExportReport;
FOnProgress: TNotifyEvent;
@ -144,6 +150,15 @@ type
procedure SyncLog;
procedure Log(const AText: string);
procedure WriteLogLine(const AText: string);
{ Отпечаток плана сборки: пути, места и длины кусков. По нему видно,
что готовые куски сделаны из того же монтажа, а не от прошлой
правки. }
function PlanKey: string;
procedure LoadDoneList;
function IsDone(const AName: string): Boolean;
procedure MarkDone(const AName: string);
{ Готов ли кусок с прошлого раза. Заполняет отчёт по нему. }
function TakeReadyPart(AIndex: Integer; out ARep: TSegmentReport): Boolean;
procedure SetStage(const AText: string);
procedure PublishProgress;
@ -171,6 +186,7 @@ type
{ AMaster нужен, чтобы понять, влезут ли кодеки проекта в MPEG-TS.
Можно передать пустую запись — тогда способ склейки выберется
по одному лишь числу источников. }
destructor Destroy; override;
constructor Create(const ASegments, AAudio: TFlatSegmentArray;
const AOutputPath: string; AKeepIntermediate: Boolean;
const AMaster: TMediaInfo; const AProfile: TEncodeProfile);
@ -197,6 +213,15 @@ type
следующим запуском. Строка пишется сразу, а не копится в памяти:
если сборка упадёт, важна как раз последняя строка. }
property LogPath: string read FLogPath write FLogPath;
{ Продолжать прерванную сборку: готовые куски берутся с диска, а не
считаются заново.
Что считается готовым, помечено в списке рядом с самими кусками.
Проверять по одному только наличию файла нельзя: сборку могли
прервать посреди записи, и файл окажется обрезанным. }
property Resume: Boolean read FResume write FResume;
{ Сколько кусков взято готовыми. Для отчёта. }
property ReusedParts: Integer read FReusedParts;
end;
{ Каталог для временных кусков рядом с готовым файлом. }
@ -205,7 +230,7 @@ function CacheDirFor(const AOutputPath: string): string;
implementation
uses
Math, FileUtil, uFfmpegCmd, uProcRunner;
Math, md5, FileUtil, uFfmpegCmd, uProcRunner;
function CacheDirFor(const AOutputPath: string): string;
begin
@ -214,6 +239,12 @@ begin
PathDelim;
end;
destructor TExportThread.Destroy;
begin
FDone.Free;
inherited Destroy;
end;
constructor TExportThread.Create(const ASegments, AAudio: TFlatSegmentArray;
const AOutputPath: string; AKeepIntermediate: Boolean;
const AMaster: TMediaInfo; const AProfile: TEncodeProfile);
@ -311,6 +342,116 @@ begin
end;
end;
function TExportThread.PlanKey: string;
var
I: Integer;
begin
Result := Format('%dx%d %d/%d %s %s|', [FMaster.Width, FMaster.Height,
FMaster.FpsNum, FMaster.FpsDen, FMaster.VideoCodec, FMaster.PixFmt]);
for I := 0 to High(FSegments) do
Result := Result + Format('%s@%s+%s#%d%s;',
[ExtractFileName(FSegments[I].FilePath),
SecondsToStr(FSegments[I].SrcStart),
SecondsToStr(FSegments[I].Duration),
Length(FSegments[I].Layers),
FSegments[I].SubFile]);
Result := MD5Print(MD5String(Result));
end;
{ Список готовых кусков рядом с ними самими. Первая строка — отпечаток
плана: не совпал, значит куски от другого монтажа и брать их нельзя. }
procedure TExportThread.LoadDoneList;
var
Path: string;
begin
FDone := TStringList.Create;
FPlanKey := PlanKey;
Path := FCacheDir + 'готово.txt';
if not FResume then
begin
if FileExists(Path) then
SysUtils.DeleteFile(Path);
Exit;
end;
if not FileExists(Path) then
Exit;
try
FDone.LoadFromFile(Path);
except
FDone.Clear;
end;
if (FDone.Count = 0) or (FDone[0] <> FPlanKey) then
begin
Log('Готовые куски от другой расстановки — собираю заново.');
FDone.Clear;
end;
end;
function TExportThread.IsDone(const AName: string): Boolean;
begin
Result := (FDone <> nil) and (FDone.IndexOf(AName) > 0) and
(FileExists(FCacheDir + AName)) and (FileSize(FCacheDir + AName) > 0);
end;
procedure TExportThread.MarkDone(const AName: string);
var
Path: string;
begin
if FDone = nil then
Exit;
if FDone.Count = 0 then
FDone.Add(FPlanKey);
if FDone.IndexOf(AName) < 0 then
FDone.Add(AName);
Path := FCacheDir + 'готово.txt';
try
{ Записываем сразу: список нужен именно на случай, когда сборка не
доживёт до конца. }
FDone.SaveToFile(Path);
except
{ Не записалось — просто соберём заново в следующий раз. }
end;
end;
function TExportThread.TakeReadyPart(AIndex: Integer;
out ARep: TSegmentReport): Boolean;
var
Names: array[0..2] of string;
I: Integer;
begin
Result := False;
ARep := Default(TSegmentReport);
if (FDone = nil) or (FDone.Count = 0) then
Exit;
{ Имя куска зависит от того, каким путём он делался: обычный, с
наложением, с точным резом. Проверяем все три. }
Names[0] := Format('part_%.3d_a%s', [AIndex, FIntermediateExt]);
Names[1] := Format('part_%.3d_x%s', [AIndex, FIntermediateExt]);
Names[2] := Format('part_%.3d_b%s', [AIndex, FIntermediateExt]);
for I := 0 to 1 do
if IsDone(Names[I]) then
begin
{ Кусок с точным резом состоит из двух частей; если вторая тоже
готова, её возьмёт следующий заход — здесь достаточно первой. }
ARep.Index := AIndex;
ARep.SourcePath := FSegments[AIndex].FilePath;
ARep.RequestedStart := FSegments[AIndex].SrcStart;
ARep.ActualStart := FSegments[AIndex].SrcStart;
ARep.Duration := FSegments[AIndex].Duration;
ARep.Packets := -1;
ARep.Encoded := I = 1;
ARep.TempPath := FCacheDir + Names[I];
Inc(FReusedParts);
Log(Format('Кусок %d уже собран — беру готовый.', [AIndex + 1]));
Exit(True);
end;
end;
procedure TExportThread.Log(const AText: string);
begin
WriteLogLine(AText);
@ -527,6 +668,16 @@ begin
Exit;
end;
{ Кусок, доведённый до конца в прошлый раз, берём готовым. На длинном
ролике это разница между «собрать заново всё» и «доделать хвост». }
if TakeReadyPart(I, Rep) then
begin
AddPart(Rep);
FDoneWork := FDoneWork + FSegments[I].Duration;
PublishProgress;
Continue;
end;
SetStage(Format('Вырезаю кусок %d из %d', [I + 1, Length(FSegments)]));
{ Сгенерированные вставки берутся из файла, который заведомо длиннее
@ -552,6 +703,8 @@ begin
Exit;
Rep.TempPath := Dst;
MarkDone(ExtractFileName(Dst));
AddPart(Rep);
Continue;
end;
@ -583,6 +736,8 @@ begin
Exit;
Rep.TempPath := Dst;
MarkDone(ExtractFileName(Dst));
AddPart(Rep);
Continue;
end;
@ -630,6 +785,8 @@ begin
Exit;
Rep.TempPath := Dst;
MarkDone(ExtractFileName(Dst));
AddPart(Rep);
Continue;
end;
@ -677,6 +834,7 @@ begin
Rep.Duration := EncodeUntil - FSegments[I].SrcStart;
Rep.TempPath := Dst;
Rep.Encoded := True;
MarkDone(ExtractFileName(Dst));
AddPart(Rep);
if EncodeUntil < SegEnd - 0.0005 then
@ -693,6 +851,7 @@ begin
Rep.Duration := SegEnd - EncodeUntil;
Rep.TempPath := Dst;
Rep.Encoded := False;
MarkDone(ExtractFileName(Dst));
AddPart(Rep);
end;
@ -724,6 +883,7 @@ begin
Rep.Duration := FSegments[I].Duration;
Rep.TempPath := Dst;
Rep.Encoded := False;
MarkDone(ExtractFileName(Dst));
AddPart(Rep);
end;
@ -1070,6 +1230,12 @@ begin
Log('Временные куски: ' + FCacheDir);
ChooseIntermediateFormat;
{ Список готовых кусков — после выбора промежуточного формата: от него
зависят их имена. }
LoadDoneList;
if FResume and (FDone.Count > 1) then
Log(Format('Продолжаю прерванную сборку: готовых кусков %d.',
[FDone.Count - 1]));
{ Единица учёта работы — секунда материала. Каждая секунда проходит
через вырезание, склейку и сборку звука, отсюда тройной вес. }

165
src/uMainForm.pas
View file

@ -103,6 +103,9 @@ type
FExportLogPath: string;
{ Разметка текста, отданная плееру в прошлый раз. }
FLastAss: string;
{ Клип, с которого скопированы свойства. Хранится копией, а не
ссылкой: исходный клип могут удалить, а свойства должны остаться. }
FLookClip: TClip;
{ Проект открыт из командной строки: спросить про клипы на чужих
дорожках можно только когда окно уже показано. }
FCheckMisplacedOnShow: Boolean;
@ -215,6 +218,8 @@ type
const AScreenPos: TPoint);
procedure TimelineRegionChange(Sender: TObject);
procedure TrackMenuDelete(Sender: TObject);
procedure TrackMenuRename(Sender: TObject);
procedure TimelineTrackRename(Sender: TObject; ATrackIndex: Integer);
procedure TrackMenuUp(Sender: TObject);
procedure TrackMenuDown(Sender: TObject);
procedure UpdateSnapButton;
@ -326,6 +331,9 @@ type
procedure MenuSplitPrecise(Sender: TObject);
procedure MenuDelete(Sender: TObject);
procedure MenuColorKey(Sender: TObject);
procedure MenuCopyLook(Sender: TObject);
procedure MenuPasteLook(Sender: TObject);
function FirstSelectedClip: TClip;
procedure MenuRegionIn(Sender: TObject);
procedure MenuRegionOut(Sender: TObject);
procedure MenuRegionClear(Sender: TObject);
@ -355,6 +363,8 @@ type
procedure ShowExportReport(const AReport: TExportReport);
{ Строка и в общий журнал программы, и в журнал этой сборки. }
procedure LogExport(const AText: string);
{ Предлагает продолжить прерванную сборку с готовых кусков. }
function AskResume(const AOutputPath: string): Boolean;
procedure NormalizeProgress(Sender: TObject);
procedure NormalizeLog(Sender: TObject);
procedure NormalizeDone(Sender: TObject);
@ -477,6 +487,7 @@ end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
Log('Закрытие: останавливаю предпросмотр.');
FreeAndNil(FLookClip);
FPreviewTimer.Enabled := False;
if Assigned(FThumbThread) then
begin
@ -592,6 +603,7 @@ begin
FTimeline.OnClipTransform := @TimelineClipTransform;
FTimeline.OnTrackAdded := @TimelineTrackAdded;
FTimeline.OnTrackMenu := @TimelineTrackMenu;
FTimeline.OnTrackRename := @TimelineTrackRename;
FTimeline.OnRegionChange := @TimelineRegionChange;
FTimeline.OnActiveTrackChange := @TimelineActiveTrackChange;
end;
@ -699,6 +711,11 @@ begin
AddItem(MEdit, 'Выделить всё', @MenuSelectAll, ShortCut(VK_A, [ssCtrl]));
AddItem(MEdit, 'Цветовой ключ клипа...', @MenuColorKey);
AddSep(MEdit);
AddItem(MEdit, 'Скопировать свойства клипа', @MenuCopyLook,
ShortCut(VK_C, [ssCtrl, ssShift]));
AddItem(MEdit, 'Применить свойства к выделенным', @MenuPasteLook,
ShortCut(VK_V, [ssCtrl, ssShift]));
AddSep(MEdit);
AddItem(MEdit, 'Отметить начало участка', @MenuRegionIn, ShortCut(VK_I, []));
AddItem(MEdit, 'Отметить конец участка', @MenuRegionOut, ShortCut(VK_O, []));
AddItem(MEdit, 'Снять отметки участка', @MenuRegionClear);
@ -2497,6 +2514,11 @@ begin
Item.OnClick := @TrackMenuDown;
FTrackMenu.Items.Add(Item);
Item := TMenuItem.Create(FTrackMenu);
Item.Caption := 'Переименовать...';
Item.OnClick := @TrackMenuRename;
FTrackMenu.Items.Add(Item);
Item := TMenuItem.Create(FTrackMenu);
Item.Caption := '-';
FTrackMenu.Items.Add(Item);
@ -2541,6 +2563,33 @@ end;
{ Удаление дорожки. С клипами — только с подтверждением: вместе с
дорожкой уходит всё, что на ней лежит, а отменить можно только одним
шагом назад. }
{ Переименование дорожки.
Имя — только подпись, но на монтаже из десятка дорожек «карта», «звук
мотора» и «титры» читаются несравнимо лучше, чем V1, A2 и Т1. }
procedure TMainForm.TimelineTrackRename(Sender: TObject; ATrackIndex: Integer);
var
NewName: string;
begin
if (ATrackIndex < 0) or (ATrackIndex >= FProject.TrackCount) then
Exit;
NewName := FProject.Tracks[ATrackIndex].Name;
if not ThemedInputDlg('Имя дорожки', 'Как назвать дорожку:', NewName) then
Exit;
FProject.BeginChange;
FProject.Tracks[ATrackIndex].Name := NewName;
FProject.EnsureUniqueTrackNames;
FTimeline.Invalidate;
UpdateCaption;
SetStatus('Дорожка названа: ' + FProject.Tracks[ATrackIndex].Name);
end;
procedure TMainForm.TrackMenuRename(Sender: TObject);
begin
TimelineTrackRename(nil, FTrackMenuIndex);
end;
procedure TMainForm.TrackMenuDelete(Sender: TObject);
var
Track: TTrack;
@ -3417,6 +3466,76 @@ end;
Отметки ставятся по курсору, как в монтажных программах. Перепутанные
местами меняются сами: требовать от человека помнить порядок — лишняя
строгость там, где всё однозначно. }
{ Первый выделенный клип: с него берут свойства. }
function TMainForm.FirstSelectedClip: TClip;
var
T, C: Integer;
begin
Result := nil;
for T := 0 to FProject.TrackCount - 1 do
for C := 0 to FProject.Tracks[T].Count - 1 do
if FProject.Tracks[T][C].Selected then
Exit(FProject.Tracks[T][C]);
end;
{ Копирование оформления с клипа на клип.
Настроить кадрирование, ключ и прозрачность — работа на минуты, а
клипов с одинаковой настройкой в монтаже бывает десяток: та же
миникарта, разрезанная на куски, или несколько снимков в одной рамке. }
procedure TMainForm.MenuCopyLook(Sender: TObject);
var
Src: TClip;
begin
Src := FirstSelectedClip;
if Src = nil then
begin
SetStatus('Сначала выделите клип, с которого брать свойства.');
Exit;
end;
if FLookClip = nil then
FLookClip := TClip.Create;
FLookClip.Kind := Src.Kind;
FLookClip.CopyLookFrom(Src);
SetStatus('Свойства клипа скопированы. Применить: Ctrl+Shift+V.');
end;
procedure TMainForm.MenuPasteLook(Sender: TObject);
var
T, C, N: Integer;
begin
if FLookClip = nil then
begin
SetStatus('Сначала скопируйте свойства клипа: Ctrl+Shift+C.');
Exit;
end;
N := 0;
FProject.BeginChange;
for T := 0 to FProject.TrackCount - 1 do
for C := 0 to FProject.Tracks[T].Count - 1 do
if FProject.Tracks[T][C].Selected then
begin
FProject.Tracks[T][C].CopyLookFrom(FLookClip);
Inc(N);
end;
if N = 0 then
begin
FProject.CancelChange;
SetStatus('Выделите клипы, к которым применить свойства.');
Exit;
end;
FTimeline.Invalidate;
FLastLoadedEdl := '';
SchedulePreview;
UpdateCaption;
SetStatus(Format('Свойства применены к %d %s.',
[N, Plural(N, 'клипу', 'клипам', 'клипам')]));
end;
procedure TMainForm.MenuRegionIn(Sender: TObject);
begin
FProject.RegionStart := FTimeline.Playhead;
@ -3790,6 +3909,7 @@ begin
FExportChoice.Path, True, Master, AProfile);
FExport.SubtitlePath := SubsPath;
FExport.LogPath := FExportLogPath;
FExport.Resume := AskResume(FExportChoice.Path);
FExport.OnProgress := @ExportProgress;
FExport.OnLog := @ExportLog;
FExport.OnTerminate := @ExportDone;
@ -3809,6 +3929,10 @@ begin
if Assigned(FExport) then
begin
FExport.WaitFor;
if FExport.ReusedParts > 0 then
LogExport(Format('Взято готовыми из прошлой сборки: %d %s.',
[FExport.ReusedParts,
Plural(FExport.ReusedParts, 'кусок', 'куска', 'кусков')]));
ShowExportReport(FExport.Report);
FreeAndNil(FExport);
end;
@ -3877,6 +4001,47 @@ begin
end;
end;
{ Прерванная сборка: куски от неё лежат в кэше рядом с готовым файлом.
Спрашиваем, а не продолжаем молча: человек мог править монтаж между
попытками, и тогда «готовые» куски — от другой расстановки. Сама сборка
это проверит по отпечатку плана и при несовпадении соберёт заново, но
знать об этом человек должен заранее. }
function TMainForm.AskResume(const AOutputPath: string): Boolean;
var
DonePath: string;
Done: TStringList;
N: Integer;
begin
Result := False;
DonePath := CacheDirFor(AOutputPath) + 'готово.txt';
if not FileExists(DonePath) then
Exit;
Done := TStringList.Create;
try
try
Done.LoadFromFile(DonePath);
except
Exit;
end;
{ Первая строка — отпечаток плана, куски идут дальше. }
N := Done.Count - 1;
if N <= 0 then
Exit;
Result := ThemedMessageDlg('nlve',
Format('От прошлой сборки осталось готовых кусков: %d.' + LineEnding +
LineEnding +
'Продолжить с них? Если монтаж с тех пор менялся, куски не ' +
'подойдут — программа это заметит и соберёт заново.',
[N]),
mtConfirmation, [mbYes, mbNo], 0) = mrYes;
finally
Done.Free;
end;
end;
procedure TMainForm.ShowExportReport(const AReport: TExportReport);
var
I, Encoded: Integer;

9
src/uProgressForm.lfm
View file

@ -38,6 +38,15 @@ object ProgressForm: TProgressForm
Anchors = [akTop, akLeft, akRight]
TabOrder = 0
end
object lblEta: TLabel
Left = 12
Height = 20
Top = 74
Width = 500
Anchors = [akTop, akLeft, akRight]
Caption = ''
ParentColor = False
end
object btnAction: TThemedButton
Left = 648
Height = 28

53
src/uProgressForm.pas
View file

@ -26,6 +26,7 @@ type
TProgressForm = class(TForm)
btnAction: TThemedButton;
lblStage: TLabel;
lblEta: TLabel;
memoLog: TLogView;
pbBar: TProgressBar;
pnlTop: TPanel;
@ -36,6 +37,11 @@ type
FFinished: Boolean;
FCancelRequested: Boolean;
FOnCancelRequest: TNotifyEvent;
{ Когда началась работа и какую долю показывали в прошлый раз: по ним
считается, сколько осталось. }
FStartedAt: TDateTime;
FLastFraction: Double;
function FormatSpan(const ASeconds: Double): string;
public
procedure SetStage(const AText: string);
procedure SetFraction(AValue: Double);
@ -70,6 +76,9 @@ begin
pbBar.Position := 0;
memoLog.Clear;
btnAction.Caption := 'Отмена';
FStartedAt := Now;
FLastFraction := 0;
lblEta.Caption := '';
end;
procedure TProgressForm.SetStage(const AText: string);
@ -77,13 +86,55 @@ begin
lblStage.Caption := AText;
end;
{ Время в виде «3 мин 20 с»: секунды сотнями человек не читает. }
function TProgressForm.FormatSpan(const ASeconds: Double): string;
var
Total, M, S: Integer;
begin
Total := Round(ASeconds);
if Total < 0 then
Total := 0;
M := Total div 60;
S := Total mod 60;
if M >= 60 then
Result := Format('%d ч %d мин', [M div 60, M mod 60])
else if M > 0 then
Result := Format('%d мин %d с', [M, S])
else
Result := Format('%d с', [S]);
end;
{ Сколько прошло и сколько осталось.
Осталось считается по простому правилу: если четверть пути заняла
минуту, весь путь займёт четыре. На деле скорость меняется — куски,
которые копируются, идут мгновенно, а те, что пересобираются,
медленно, — поэтому число называется «примерно» и пересчитывается на
каждом шаге. Даже такая оценка отвечает на главный вопрос: успею ли я
сходить за чаем. }
procedure TProgressForm.SetFraction(AValue: Double);
var
{ Не Left: так называется свойство формы. }
Elapsed, Remain: Double;
begin
if AValue < 0 then
AValue := 0;
if AValue > 1 then
AValue := 1;
pbBar.Position := Round(AValue * BarScale);
FLastFraction := AValue;
Elapsed := (Now - FStartedAt) * SecsPerDay;
{ Пока сделано меньше сотой доли, оценка была бы гаданием: первые
секунды уходят на запуск ffmpeg, а не на работу. }
if (AValue > 0.01) and (Elapsed > 1) then
begin
Remain := Elapsed * (1 - AValue) / AValue;
lblEta.Caption := Format('Прошло %s, осталось примерно %s (%d%%)',
[FormatSpan(Elapsed), FormatSpan(Remain), Round(AValue * 100)]);
end
else
lblEta.Caption := 'Прошло ' + FormatSpan(Elapsed);
end;
procedure TProgressForm.AddLog(const AText: string);
@ -98,6 +149,8 @@ begin
FFinished := True;
btnAction.Caption := 'Закрыть';
lblStage.Caption := AMessage;
{ На месте оценки — итог: сколько всё это заняло. }
lblEta.Caption := 'Заняло ' + FormatSpan((Now - FStartedAt) * SecsPerDay);
if ASuccess then
lblStage.Font.Color := clDefault
else

22
src/uProject.pas
View file

@ -156,6 +156,14 @@ type
прозрачность: она переставала быть наложением и закрывала собой всё,
что ниже. }
procedure CopySettingsFrom(ASource: TClip);
{ Переносит только оформление: кадрирование, поворот, увеличение,
смещение, прозрачность, ключ, затухания, громкость.
От CopySettingsFrom отличается тем, что не трогает вид клипа и его
текст: свойства переносят между разными клипами, и превращать
картинку в надпись при этом незачем. Оформление надписи переносится
только между надписями. }
procedure CopyLookFrom(ASource: TClip);
function TlEnd: Double;
function SrcOut: Double;
{ Попадает ли момент внутрь клипа. Правый край не включается: там уже
@ -473,6 +481,20 @@ begin
FTextStyle := ASource.TextStyle;
end;
procedure TClip.CopyLookFrom(ASource: TClip);
begin
if ASource = nil then
Exit;
FTransform := ASource.Transform;
FOpacity := ASource.Opacity;
FColorKey := ASource.ColorKey;
FFadeIn := ASource.FadeIn;
FFadeOut := ASource.FadeOut;
FVolume := ASource.Volume;
if (FKind = ckText) and (ASource.Kind = ckText) then
FTextStyle := ASource.TextStyle;
end;
constructor TClip.Create;
begin
inherited Create;

57
src/uTheme.pas
View file

@ -234,6 +234,11 @@ function ThemedMessageDlg(const ACaption, AText: string;
function ThemedChoiceDlg(const ACaption, AText: string;
const ACaptions: array of string): Integer;
{ Ввод одной строки в тёмном окне. Системный InputQuery выглядел бы белым
пятном посреди тёмной программы. }
function ThemedInputDlg(const ACaption, APrompt: string;
var AValue: string): Boolean;
implementation
{$IFDEF LCLGTK2}
@ -1372,6 +1377,58 @@ begin
end;
end;
function ThemedInputDlg(const ACaption, APrompt: string;
var AValue: string): Boolean;
var
Dlg: TForm;
Lbl: TLabel;
Edit: TEdit;
BtnOk, BtnCancel: TThemedButton;
begin
Result := False;
Dlg := TForm.CreateNew(nil);
try
Dlg.Caption := ACaption;
Dlg.BorderStyle := bsDialog;
Dlg.Position := poScreenCenter;
Dlg.ClientWidth := 360;
Dlg.ClientHeight := 130;
Lbl := TLabel.Create(Dlg);
Lbl.Parent := Dlg;
Lbl.SetBounds(16, 16, 328, 20);
Lbl.Caption := APrompt;
Edit := TEdit.Create(Dlg);
Edit.Parent := Dlg;
Edit.SetBounds(16, 40, 328, 26);
Edit.Text := AValue;
BtnOk := TThemedButton.Create(Dlg);
BtnOk.Parent := Dlg;
BtnOk.SetBounds(136, 84, 100, 30);
BtnOk.Caption := 'Готово';
BtnOk.ModalResult := mrOk;
BtnOk.Default := True;
BtnCancel := TThemedButton.Create(Dlg);
BtnCancel.Parent := Dlg;
BtnCancel.SetBounds(244, 84, 100, 30);
BtnCancel.Caption := 'Отмена';
BtnCancel.ModalResult := mrCancel;
BtnCancel.Cancel := True;
ApplyDarkTheme(Dlg);
Edit.SetFocus;
if Dlg.ShowModal <> mrOk then
Exit;
AValue := Trim(Edit.Text);
Result := AValue <> '';
finally
Dlg.Free;
end;
end;
function ThemedMessageDlg(const ACaption, AText: string;
ADlgType: TMsgDlgType; AButtons: TMsgDlgButtons;
AHelpCtx: Longint): TModalResult;

97
src/uTimelineCtrl.pas
View file

@ -45,13 +45,16 @@ type
);
{ Что находится под указателем в полосе заголовков дорожек. }
THeaderPart = (hpNone, hpBody, hpMute, hpSolo);
THeaderPart = (hpNone, hpBody, hpMute, hpSolo, hpUp, hpDown, hpName);
{ Правый щелчок по заголовку дорожки. Само меню строит окно: компонент
не знает, что с дорожкой можно делать. }
TTrackMenuEvent = procedure(Sender: TObject; ATrackIndex: Integer;
const AScreenPos: TPoint) of object;
{ Дорожку просят переименовать: окно спросит новое имя. }
TTrackRenameEvent = procedure(Sender: TObject; ATrackIndex: Integer) of object;
{ Файл из списка проекта бросили на монтаж.
ATrackIndex = -1 означает, что бросили ниже всех дорожек и нужна новая.
@ -133,6 +136,7 @@ type
FOnRegionChange: TNotifyEvent;
{ Правый щелчок по заголовку дорожки: окно покажет своё меню. }
FOnTrackMenu: TTrackMenuEvent;
FOnTrackRename: TTrackRenameEvent;
{ Дорожка, которую тащат за заголовок. }
FDragTrackIndex: Integer;
FDragTrackFrom: Integer;
@ -161,6 +165,8 @@ type
procedure DrawRegion(ACanvas: TCanvas);
procedure DrawRegionHandle(ACanvas: TCanvas; AX: Integer;
AIsStart: Boolean);
procedure DrawTrackArrow(ACanvas: TCanvas; ALeft, ATop: Integer;
AUp, AEnabled: Boolean);
function RegionHandleAt(AX, AY: Integer): Integer;
procedure DragRegionEdge(AX: Integer; AIsStart: Boolean);
procedure DrawTracks(ACanvas: TCanvas);
@ -307,6 +313,8 @@ type
write FOnRegionChange;
property OnTrackMenu: TTrackMenuEvent read FOnTrackMenu
write FOnTrackMenu;
property OnTrackRename: TTrackRenameEvent read FOnTrackRename
write FOnTrackRename;
property OnMediaDrop: TMediaDropEvent read FOnMediaDrop write FOnMediaDrop;
{ Нажата кнопка кадрирования в углу клипа. }
property OnClipTransform: TClipEvent read FOnClipTransform
@ -327,6 +335,9 @@ const
SnapPixels = 8;
{ Уголок отметки участка: сторона треугольника в точках. }
RegionHandleWidth = 9;
{ Стрелки порядка дорожек в заголовке. }
ArrowSize = 14;
ArrowLeft = 5;
{ Полоса участка вверху линейки: в ней живут уголки, и протяжка по ней
отмечает участок, а не двигает курсор. Так же устроено в монтажных
программах: у линейки два этажа, верхний про отметки, нижний про
@ -549,6 +560,22 @@ begin
Result := hpBody;
RowTop := TrackTop(ATrackIndex);
{ Стрелки порядка — слева, одна под другой: дорожку двигают вверх и
вниз чаще, чем делают с ней что-либо ещё, и лезть за этим в меню
неудобно. }
if (AX >= ArrowLeft) and (AX < ArrowLeft + ArrowSize) then
begin
if (AY >= RowTop + 6) and (AY < RowTop + 6 + ArrowSize) then
Exit(hpUp);
if (AY >= RowTop + 8 + ArrowSize) and (AY < RowTop + 8 + 2 * ArrowSize) then
Exit(hpDown);
end;
{ Имя: по двойному щелчку его переименовывают. }
if (AY >= RowTop + 4) and (AY < RowTop + 22) and (AX >= ArrowLeft + ArrowSize) then
Exit(hpName);
BtnTop := RowTop + FTrackHeight - HeaderButtonSize - 6;
if (AY < BtnTop) or (AY > BtnTop + HeaderButtonSize) then
Exit;
@ -1440,18 +1467,25 @@ begin
ACanvas.Font.Color := clGray;
ACanvas.Font.Height := -12;
ACanvas.Font.Style := [fsBold];
ACanvas.TextOut(8, RowTop + 6, Track.Name);
ACanvas.TextOut(ArrowLeft + ArrowSize + 6, RowTop + 6, Track.Name);
ACanvas.Font.Style := [];
ACanvas.Font.Color := clGray;
ACanvas.Font.Height := -10;
if T = 0 then
ACanvas.TextOut(8, RowTop + 24,
ACanvas.TextOut(ArrowLeft + ArrowSize + 6, RowTop + 24,
IntToStr(Track.Count) + ' кл. верх')
else
ACanvas.TextOut(8, RowTop + 24, IntToStr(Track.Count) + ' кл.');
ACanvas.TextOut(ArrowLeft + ArrowSize + 6, RowTop + 24,
IntToStr(Track.Count) + ' кл.');
ACanvas.Brush.Style := bsSolid;
{ Стрелки порядка. У верхней дорожки некуда вверх, у нижней вниз —
такая стрелка рисуется тускло и не нажимается. }
DrawTrackArrow(ACanvas, ArrowLeft, RowTop + 6, True, T > 0);
DrawTrackArrow(ACanvas, ArrowLeft, RowTop + 8 + ArrowSize, False,
T < FProject.TrackCount - 1);
BtnTop := RowTop + FTrackHeight - HeaderButtonSize - 6;
BtnLeft := FHeaderWidth - 2 * HeaderButtonSize - HeaderButtonGap - 8;
{ М — выключить дорожку целиком, С — слушать только её. }
@ -1463,6 +1497,36 @@ begin
ACanvas.Brush.Style := bsSolid;
end;
{ Треугольник порядка дорожек. }
procedure TTimelineControl.DrawTrackArrow(ACanvas: TCanvas;
ALeft, ATop: Integer; AUp, AEnabled: Boolean);
var
Pts: array[0..2] of TPoint;
Mid: Integer;
begin
Mid := ALeft + ArrowSize div 2;
if AUp then
begin
Pts[0] := Point(Mid, ATop + 2);
Pts[1] := Point(ALeft + 1, ATop + ArrowSize - 3);
Pts[2] := Point(ALeft + ArrowSize - 1, ATop + ArrowSize - 3);
end
else
begin
Pts[0] := Point(Mid, ATop + ArrowSize - 3);
Pts[1] := Point(ALeft + 1, ATop + 2);
Pts[2] := Point(ALeft + ArrowSize - 1, ATop + 2);
end;
ACanvas.Brush.Style := bsSolid;
if AEnabled then
ACanvas.Brush.Color := ColorRulerText
else
ACanvas.Brush.Color := ColorButtonOff;
ACanvas.Pen.Color := ACanvas.Brush.Color;
ACanvas.Polygon(Pts);
end;
procedure TTimelineControl.DrawPlayhead(ACanvas: TCanvas);
var
X: Integer;
@ -1795,6 +1859,31 @@ begin
FProject.Tracks[Idx].Solo := not FProject.Tracks[Idx].Solo;
StructureChanged;
end;
hpUp:
if Idx > 0 then
begin
FProject.MoveTrack(Idx, Idx - 1);
FActiveTrack := Idx - 1;
FProject.Modified := True;
StructureChanged;
end;
hpDown:
if Idx < FProject.TrackCount - 1 then
begin
FProject.MoveTrack(Idx, Idx + 1);
FActiveTrack := Idx + 1;
FProject.Modified := True;
StructureChanged;
end;
hpName:
begin
FActiveTrack := Idx;
Invalidate;
{ Двойной щелчок по имени — переименование. Одиночный просто
выбирает дорожку: имя правят редко, а выбирают часто. }
if (ssDouble in Shift) and Assigned(FOnTrackRename) then
FOnTrackRename(Self, Idx);
end;
hpBody:
begin
FActiveTrack := Idx;

3
tests/nlvetool.lpr
View file

@ -1380,6 +1380,9 @@ begin
Thread := TExportThread.Create(Segs, AudioSegs,
ExpandFileName(ParamStr(3)), True, Proj.Master, Default(TEncodeProfile));
{ Словом resume просят продолжить прерванную сборку: готовые куски
берутся с диска, а не считаются заново. }
Thread.Resume := (ParamCount >= 4) and (LowerCase(ParamStr(4)) = 'resume');
Watcher := TExportWatcher.Create(Thread);
try
Thread.OnProgress := @Watcher.Progress;