Участок сборки, качество пересборки и пропавшие куски

Отмеченный участок. Клавиши I и O ставят начало и конец по курсору,
полоса под линейкой показывает отмеченное, сборка собирает только его.
Без этого проверить правку на длинном монтаже нельзя: каждая проверка
стоит столько же, сколько идёт весь ролик. Отметки живут в проекте.
Разметка текста при этом берётся с начала участка, иначе надписи легли бы
со сдвигом.

Фотография пропадала из ролика. Кусок с наложением подаёт слои в ffmpeg
как есть, а одиночная картинка даёт ровно один кадр: кусок в три секунды
получался длиной 0.016667 с. Теперь у слоя есть признак «это картинка», и
она повторяется ключом -loop с частотой кадров проекта.

Текст пропадал там же. Вжигание помечает кусок разметкой, но ветка
наложения про неё не знала. Пока оверлей лежит на всём ролике, этой
веткой идут все куски — и текста не было нигде. Теперь разметка вжигается
последним звеном цепочки, поверх сведённой картинки.

Качество пересобранных кусков. Битрейт не задавался вовсе, и кодировщик
брал своё значение по умолчанию: 5.9 Мбит/с там, где исходник 56. Теперь
пересборка целится в наибольший битрейт среди файлов проекта, с потолком
в полтора раза выше и буфером вдвое. Тем же битрейтом делаются вставки из
фотографий.

Проверки: обрезка списка кусков по участку (nlvetool flattest, 9),
сборка фотографии под наложением и вжигание текста поверх наложения
(nlvetool render ... burn).
This commit is contained in:
4aiman 2026-08-31 10:37:25 +03:00
commit 71381bb774
12 changed files with 446 additions and 37 deletions

View file

@ -153,6 +153,14 @@ xdg-mime query default application/x-nlve-project
времени. На слабой машине это может быть заметнее, потому выключатель и
есть.
**Отмеченный участок.** Клавиша `I` ставит начало по курсору, `O` —
конец; оба пункта есть в меню «Правка», там же снятие отметок. Участок
показан полосой под линейкой и стойками по краям. Пока он отмечен, сборка
собирает только его — это единственный способ проверить правку на длинном
монтаже, не тратя на каждую проверку столько же времени, сколько идёт сам
ролик. Отметки живут в файле проекта: участок относится к монтажу, а не к
привычкам человека.
**Схлопывание.** Кнопка внизу показывает и режим, и состояние: утоплена —
автосхлопывание включено, и тогда при перетаскивании клипа всё, что
начинается не раньше него, едет следом. Стрелка рядом открывает выбор
@ -370,6 +378,21 @@ Linux потом искала по нему `.dll`.
каждого слоя считается на каждый отсчёт, и длина результата получается
ровно такой, какая нужна.
## Качество пересобираемых кусков
Куски, которые нельзя скопировать, целятся в наибольший битрейт среди
файлов проекта. Без этого кодировщик берёт своё значение по умолчанию, и
оно скромное: на съёмке 2688x1512 с 56 Мбит/с NVENC выдавал 5.9 Мбит/с —
пересобранный кусок бросался в глаза среди скопированных соседей.
Кроме среднего задаётся потолок в полтора раза выше и буфер вдвое: без
них кодировщик разгоняется на сложных кадрах ровно настолько, насколько
позволит средний, и мелкие детали всё равно теряются.
Берётся именно наибольший, а не средний: пересобранный кусок стоит рядом
со скопированными, и если он окажется хуже их, разница видна именно на
нём. Лишнее место дешевле.
## Как собирается ролик
1. Монтаж уплощается в последовательность непересекающихся кусков.

View file

@ -58,6 +58,12 @@ type
Y: Integer;
{ Постоянная непрозрачность слоя. }
Opacity: Double;
{ Слой — неподвижная картинка, а не видео.
Её надо повторять: одиночный файл даёт ffmpeg ровно один кадр, и
кусок с наложением схлопывался в одну шестидесятую секунды —
фотография из ролика просто пропадала. }
IsImage: Boolean;
{ Цветовой ключ слоя: этот цвет становится прозрачным. Ключ выключен,
если KeyEnabled равно False. }
KeyEnabled: Boolean;

View file

@ -537,7 +537,8 @@ begin
FSegments[I].Duration, FMaster.Width, FMaster.Height,
FMaster.FpsNum, FMaster.FpsDen, FMaster.PixFmt,
PreferredEncoder(FMaster.VideoCodec),
FIntermediateFormat = 'mpegts'),
FIntermediateFormat = 'mpegts', FMaster.VideoBitrate,
FSegments[I].SubFile),
'Наложение в куске ' + IntToStr(I + 1)) then
Exit;
@ -568,7 +569,8 @@ begin
FMaster.Width, FMaster.Height, FMaster.FpsNum, FMaster.FpsDen,
FMaster.VideoCodec, FMaster.PixFmt, FMaster.AudioCodec,
FMaster.SampleRate, FMaster.Channels, FSegments[I].Volume,
FIntermediateFormat, FSegments[I].Filter, FSegments[I].SubFile),
FIntermediateFormat, FSegments[I].Filter, FSegments[I].SubFile,
FMaster.VideoBitrate),
'Пересборка куска ' + IntToStr(I + 1)) then
Exit;

View file

@ -37,9 +37,13 @@ type
AHasText — есть ли в проекте надписи: без них про текст и спрашивать
незачем. APreferMkv — в монтаже есть точные резы, и MKV надёжнее.
ABurnDefault — ответ, данный в прошлый раз. }
ABurnDefault — ответ, данный в прошлый раз.
ARegion — описание отмеченного участка. Не пусто — окно прямо говорит,
что собирается не весь ролик: это легко забыть и потом долго искать,
почему в файле не хватает половины. }
function AskExport(var AChoice: TExportChoice; AHasText, APreferMkv: Boolean;
const ADefaultDir: string): Boolean;
const ADefaultDir: string; const ARegion: string = ''): Boolean;
implementation
@ -166,7 +170,7 @@ begin
end;
function AskExport(var AChoice: TExportChoice; AHasText, APreferMkv: Boolean;
const ADefaultDir: string): Boolean;
const ADefaultDir: string; const ARegion: string): Boolean;
var
Dlg: TExportDialog;
Lbl: TLabel;
@ -221,6 +225,16 @@ begin
Dlg.BtnMkv.TabStop := False;
Dlg.BtnMkv.OnClick := @Dlg.FormatClick;
if ARegion <> '' then
begin
Lbl := TLabel.Create(Dlg.Form);
Lbl.Parent := Dlg.Form;
Lbl.SetBounds(310, 76, 300, 20);
Lbl.Anchors := [akTop, akLeft, akRight];
Lbl.Caption := 'Только участок: ' + ARegion;
Lbl.Font.Color := TColor($30A0D0);
end;
Dlg.cbBurn := TCheckBox.Create(Dlg.Form);
Dlg.cbBurn.Parent := Dlg.Form;
Dlg.cbBurn.SetBounds(12, 116, 300, 22);

View file

@ -87,7 +87,7 @@ function ArgsTranscodeSegment(const ASrc, ADst: string; AStart, AEnd: Double;
const AVideoCodec, APixFmt, AAudioCodec: string;
ASampleRate, AChannels: Integer; AVolume: Double;
const AFormat: string; const AFilter: string = '';
const ASubFile: string = ''): TArgs;
const ASubFile: string = ''; ABitrate: Int64 = 0): TArgs;
{ Путь внутри строки фильтра. Двоеточие там разделяет настройки, обратная
косая и кавычка имеют своё значение — всё это надо обезвредить, иначе
@ -146,11 +146,16 @@ function ArgsEncodeAudio(const ASource, ATarget: string;
Постоянная непрозрачность делается наложением с приглушённым альфа-
каналом, переход — фильтром xfade. Их нельзя перепутать: xfade умеет
плавно менять долю во времени, а простое наложение — нет. }
плавно менять долю во времени, а простое наложение — нет.
ASubFile — разметка текста, которую надо вжечь в этот кусок. Пусто — не
вжигать. Без этого текст пропадал везде, где есть наложение: кусок шёл
этой веткой, а она про субтитры не знала. }
function ArgsRenderLayers(const ALayers: array of TSegmentLayer;
const ATarget: string; const ADuration: Double;
AWidth, AHeight, AFpsNum, AFpsDen: Integer;
const APixFmt, ACodec: string; AIsTs: Boolean): TArgs;
const APixFmt, ACodec: string; AIsTs: Boolean;
ABitrate: Int64 = 0; const ASubFile: string = ''): TArgs;
{ Сшивание готовой картинки с готовым звуком. Оба потока копируются.
@ -197,7 +202,7 @@ function ArgsNormalize(const ASrc, ADst: string;
function ArgsImageClip(const ASrc, ADst: string; ADuration: Double;
AWidth, AHeight, AFpsNum, AFpsDen: Integer;
const AVideoCodec, APixFmt, AAudioCodec: string;
ASampleRate, AChannels: Integer): TArgs;
ASampleRate, AChannels: Integer; ABitrate: Int64 = 0): TArgs;
{ Сделать чёрный клип с тишиной заданной длины.
@ -237,6 +242,10 @@ implementation
uses
StrUtils, uTransform;
{ Ключи качества. Объявлено в самом начале: ими пользуется отрисовка
слоёв, а она по тексту раньше самой функции. }
function BitrateArgs(ABitrate: Int64): TArgs; forward;
{ Общие параметры вывода в формате проекта. Объявлено заранее, потому что
используется выше по тексту, чем определено. }
function ArgsExtractAudioRaw(const ASource, ATarget: string;
@ -279,20 +288,33 @@ end;
function ArgsRenderLayers(const ALayers: array of TSegmentLayer;
const ATarget: string; const ADuration: Double;
AWidth, AHeight, AFpsNum, AFpsDen: Integer;
const APixFmt, ACodec: string; AIsTs: Boolean): TArgs;
const APixFmt, ACodec: string; AIsTs: Boolean;
ABitrate: Int64; const ASubFile: string): TArgs;
var
I: Integer;
Graph, Fit, Src: string;
Graph, Fit, Src, OutLabel: string;
Crossfade: Boolean;
begin
Result := ['-hide_banner', '-nostdin', '-loglevel', 'warning', '-y'];
{ Каждый слой — отдельный вход, вырезанный ровно по длине участка. }
{ Каждый слой — отдельный вход, вырезанный ровно по длине участка.
Неподвижная картинка — случай особый: её надо повторять ключом -loop,
иначе ffmpeg отдаёт один-единственный кадр, и весь кусок с наложением
схлопывается в одну шестидесятую секунды. Перематывать её тоже
незачем: у картинки нет времени. }
for I := 0 to High(ALayers) do
Result := Concat(Result,
['-ss', SecondsToStr(ALayers[I].SrcStart),
'-t', SecondsToStr(ADuration),
'-i', ALayers[I].FilePath]);
if ALayers[I].IsImage then
Result := Concat(Result,
['-loop', '1',
'-framerate', Format('%d/%d', [AFpsNum, AFpsDen]),
'-t', SecondsToStr(ADuration),
'-i', ALayers[I].FilePath])
else
Result := Concat(Result,
['-ss', SecondsToStr(ALayers[I].SrcStart),
'-t', SecondsToStr(ADuration),
'-i', ALayers[I].FilePath]);
{ Переход отличается от наложения тем, что доля меняется во времени. }
Crossfade := (Length(ALayers) = 2) and
@ -360,15 +382,27 @@ begin
ALayers[High(ALayers)].X, ALayers[High(ALayers)].Y]);
end;
{ Текст вжигается последним: он ложится поверх уже сведённой картинки,
как и в куске без наложения. Разметка приходит со сдвигом под этот
кусок, поэтому время в ней считается от его начала. }
if ASubFile <> '' then
Graph := Graph + Format(';[out]subtitles=filename=''%s''[outs]',
[EscapeFilterPath(ASubFile)]);
{ Кодировщик выбирается предпочтительный, а не тот, что ffmpeg возьмёт
по имени кодека. Имя «hevc» уводит его на процессорный x265, и участок
наложения считался медленнее реального времени: замерено 9.6 с
материала за 11.2 с работы. }
if ASubFile <> '' then
OutLabel := '[outs]'
else
OutLabel := '[out]';
Result := Concat(Result,
['-filter_complex', Graph, '-map', '[out]',
['-filter_complex', Graph, '-map', OutLabel,
'-t', SecondsToStr(ADuration),
'-c:v', PreferredEncoder(ACodec), '-r', Format('%d/%d', [AFpsNum, AFpsDen]),
'-pix_fmt', APixFmt]);
Result := Concat(Result, BitrateArgs(ABitrate));
Result := Concat(Result,
['-bf', '0', '-an', '-avoid_negative_ts', 'make_zero',
'-progress', 'pipe:1', '-nostats']);
@ -403,7 +437,7 @@ end;
function MasterOutputArgs(AWidth, AHeight, AFpsNum, AFpsDen: Integer;
const AVideoCodec, APixFmt, AAudioCodec: string;
ASampleRate, AChannels: Integer): TArgs; forward;
ASampleRate, AChannels: Integer; ABitrate: Int64 = 0): TArgs; forward;
{ Запрет двунаправленных кадров. Объявлено заранее по той же причине. }
function NoBFramesArgs: TArgs; forward;
@ -617,7 +651,7 @@ function ArgsTranscodeSegment(const ASrc, ADst: string; AStart, AEnd: Double;
const AVideoCodec, APixFmt, AAudioCodec: string;
ASampleRate, AChannels: Integer; AVolume: Double;
const AFormat: string; const AFilter: string;
const ASubFile: string): TArgs;
const ASubFile: string; ABitrate: Int64): TArgs;
var
Chain: string;
begin
@ -651,7 +685,7 @@ begin
Result := Concat(Result, ['-af', 'volume=' + SecondsToStr(AVolume)]);
Result := Concat(Result, MasterOutputArgs(0, 0, AFpsNum, AFpsDen,
AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels));
AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels, ABitrate));
Result := Concat(Result, NoBFramesArgs);
Result := Concat(Result, ['-avoid_negative_ts', 'make_zero']);
Result := Concat(Result, ProgressArgs);
@ -925,9 +959,31 @@ begin
end;
{ Реализация объявленной выше функции. }
{ Ключи качества для пересобираемых кусков.
Без них кодировщик берёт своё значение по умолчанию, а оно скромное: на
съёмке 2688x1512 с 56 Мбит/с NVENC выдавал 5.9 Мбит/с, и пересобранный
кусок бросался в глаза среди скопированных. Поэтому целимся в тот же
битрейт, что у исходного материала.
Кроме среднего задаётся потолок и размер буфера: без них кодировщик
разгоняется на сложных кадрах ровно настолько, насколько ему позволит
средний, и мелкие детали всё равно пропадают. }
function BitrateArgs(ABitrate: Int64): TArgs;
begin
Result := [];
{ Ниже ста килобит в секунду — это не битрейт, а неизвестность: ffprobe
не всегда его сообщает. Тогда оставляем решение кодировщику. }
if ABitrate < 100000 then
Exit;
Result := ['-b:v', IntToStr(ABitrate div 1000) + 'k',
'-maxrate', IntToStr(ABitrate * 3 div 2000) + 'k',
'-bufsize', IntToStr(ABitrate div 500) + 'k'];
end;
function MasterOutputArgs(AWidth, AHeight, AFpsNum, AFpsDen: Integer;
const AVideoCodec, APixFmt, AAudioCodec: string;
ASampleRate, AChannels: Integer): TArgs;
ASampleRate, AChannels: Integer; ABitrate: Int64): TArgs;
var
Fps: string;
begin
@ -943,6 +999,7 @@ begin
Result := Concat(Result, ['-r', Fps]);
if APixFmt <> '' then
Result := Concat(Result, ['-pix_fmt', APixFmt]);
Result := Concat(Result, BitrateArgs(ABitrate));
if AAudioCodec <> '' then
begin
@ -975,7 +1032,7 @@ end;
function ArgsImageClip(const ASrc, ADst: string; ADuration: Double;
AWidth, AHeight, AFpsNum, AFpsDen: Integer;
const AVideoCodec, APixFmt, AAudioCodec: string;
ASampleRate, AChannels: Integer): TArgs;
ASampleRate, AChannels: Integer; ABitrate: Int64): TArgs;
begin
{ -loop 1 повторяет единственный кадр, -t задаёт длину.
Картинка вписывается в кадр целиком с чёрными полями по краям:
@ -998,7 +1055,7 @@ begin
[AWidth, AHeight, AWidth, AHeight])]);
Result := Concat(Result, MasterOutputArgs(0, 0, AFpsNum, AFpsDen,
AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels));
AVideoCodec, APixFmt, AAudioCodec, ASampleRate, AChannels, ABitrate));
Result := Concat(Result, NoBFramesArgs);
Result := Concat(Result, ['-shortest']);
Result := Concat(Result, ProgressArgs);

View file

@ -152,6 +152,20 @@ function FlattenPreview(AProject: TProject;
out AMissing: TGenRequests;
AWithKey: Boolean = False): Boolean;
{ Оставляет от списка кусков только то, что попадает в участок.
Куски, задетые краем, подрезаются: у начального сдвигается точка входа в
исходник, у конечного укорачивается длина. Слои внутри куска сдвигаются
вместе с ним — иначе наложение поехало бы относительно картинки.
Зачем: собрать кусок монтажа, не собирая весь ролик. На длинном
материале это разница между минутой и часом, и без этого проверить
правку в готовом файле почти невозможно.
Возвращает, сколько секунд осталось. }
function ClipSegmentsToRange(var ASegments: TFlatSegmentArray;
const AFrom, ATo: Double): Double;
{ Путь к сгенерированному клипу. Имя выводится из содержимого запроса,
поэтому одинаковые запросы дают один и тот же файл, и он делается
один раз. }
@ -277,6 +291,48 @@ begin
ALayers[I].KeySimilarity, ALayers[I].KeyBlend]);
end;
function ClipSegmentsToRange(var ASegments: TFlatSegmentArray;
const AFrom, ATo: Double): Double;
var
I, J, N: Integer;
At, SegStart, SegEnd, NewStart, NewEnd, Shift: Double;
Kept: TFlatSegmentArray;
Seg: TFlatSegment;
begin
Result := 0;
if ATo <= AFrom then
Exit;
N := 0;
At := 0;
SetLength(Kept, Length(ASegments));
for I := 0 to High(ASegments) do
begin
SegStart := At;
SegEnd := At + ASegments[I].Duration;
At := SegEnd;
NewStart := Max(SegStart, AFrom);
NewEnd := Min(SegEnd, ATo);
if NewEnd <= NewStart + 0.0005 then
Continue;
Seg := ASegments[I];
Shift := NewStart - SegStart;
Seg.SrcStart := Seg.SrcStart + Shift;
Seg.Duration := NewEnd - NewStart;
for J := 0 to High(Seg.Layers) do
Seg.Layers[J].SrcStart := Seg.Layers[J].SrcStart + Shift;
Kept[N] := Seg;
Inc(N);
Result := Result + Seg.Duration;
end;
SetLength(Kept, N);
ASegments := Kept;
end;
procedure ResolveLayers(AProject: TProject; var ASegments: TFlatSegmentArray;
var AMissing: TGenRequests);
var
@ -437,6 +493,7 @@ var
if It = nil then
Exit;
Result.FilePath := It.EffectivePath;
Result.IsImage := (AClip.Kind = ckImage) or (It.Info.Kind = mkImage);
Result.SrcStart := AClip.SrcIn + (AAt - AClip.TlStart);
Result.KeyEnabled := AClip.ColorKey.Enabled;
Result.KeyColor := AClip.ColorKey.Color;

View file

@ -226,11 +226,13 @@ begin
FMaster.VideoCodec, FMaster.PixFmt, AudioCodec,
FMaster.SampleRate, FMaster.Channels);
gkImage:
{ Фотография попадает в ролик наравне со съёмкой, и жать её
сильнее, чем её соседей, незачем. }
Args := ArgsImageClip(FRequests[I].SourcePath, FRequests[I].TargetPath,
FRequests[I].Duration,
FMaster.Width, FMaster.Height, FMaster.FpsNum, FMaster.FpsDen,
FMaster.VideoCodec, FMaster.PixFmt, AudioCodec,
FMaster.SampleRate, FMaster.Channels);
FMaster.SampleRate, FMaster.Channels, FMaster.VideoBitrate);
gkSilence:
Args := ArgsSilenceClip(FRequests[I].TargetPath,
FRequests[I].Duration, AudioCodec,
@ -243,7 +245,7 @@ begin
Args := ArgsRenderLayers(FRequests[I].Layers,
FRequests[I].TargetPath, FRequests[I].Duration,
FMaster.Width, FMaster.Height, FMaster.FpsNum, FMaster.FpsDen,
FMaster.PixFmt, FMaster.VideoCodec, False);
FMaster.PixFmt, FMaster.VideoCodec, False, FMaster.VideoBitrate);
else
Continue;
end;

View file

@ -303,6 +303,11 @@ type
procedure MenuSplitPrecise(Sender: TObject);
procedure MenuDelete(Sender: TObject);
procedure MenuColorKey(Sender: TObject);
procedure MenuRegionIn(Sender: TObject);
procedure MenuRegionOut(Sender: TObject);
procedure MenuRegionClear(Sender: TObject);
{ Что и откуда собирать: с учётом отмеченного участка. }
procedure DescribeRegion(out AFrom, ATo: Double);
procedure MenuSelectAll(Sender: TObject);
procedure MenuRipple(Sender: TObject);
procedure MenuToggleRipple(Sender: TObject);
@ -665,6 +670,10 @@ begin
AddItem(MEdit, 'Выделить всё', @MenuSelectAll, ShortCut(VK_A, [ssCtrl]));
AddItem(MEdit, 'Цветовой ключ клипа...', @MenuColorKey);
AddSep(MEdit);
AddItem(MEdit, 'Отметить начало участка', @MenuRegionIn, ShortCut(VK_I, []));
AddItem(MEdit, 'Отметить конец участка', @MenuRegionOut, ShortCut(VK_O, []));
AddItem(MEdit, 'Снять отметки участка', @MenuRegionClear);
AddSep(MEdit);
AddItem(MEdit, 'Схлопнуть дыру под курсором', @MenuRipple,
ShortCut(VK_R, [ssCtrl, ssShift]));
AddItem(MEdit, 'Автосхлопывание при перетаскивании', @MenuToggleRipple,
@ -1877,6 +1886,7 @@ procedure TMainForm.RebuildPreview;
var
Segments, AudioSegs, TrackSegs: TFlatSegmentArray;
Overlays: TPreviewOverlays;
GenMaster: TMediaInfo;
Missing, TrackMissing: TGenRequests;
I, J: Integer;
TotalLen: Double;
@ -1953,7 +1963,11 @@ begin
begin
FGenerateBusy := True;
SetStatus('Готовлю вставки для предпросмотра...');
FGenerate := TGenerateThread.Create(Missing, FProject.Master);
{ Вставки — картинки и связки — попадают в ролик наравне со съёмкой,
поэтому целятся в тот же битрейт. }
GenMaster := FProject.Master;
GenMaster.VideoBitrate := FProject.MaxVideoBitrate;
FGenerate := TGenerateThread.Create(Missing, GenMaster);
FGenerate.OnProgress := @GenerateProgress;
FGenerate.OnLog := @GenerateLog;
FGenerate.OnTerminate := @GenerateDone;
@ -3112,6 +3126,67 @@ begin
SetStatus('Цветовой ключ выключен.');
end;
{ Отметки участка.
Участок нужен, чтобы собрать кусок монтажа, а не весь ролик: на длинном
материале проверить правку иначе почти невозможно — сборка занимает
столько же, сколько сам ролик, а то и больше.
Отметки ставятся по курсору, как в монтажных программах. Перепутанные
местами меняются сами: требовать от человека помнить порядок — лишняя
строгость там, где всё однозначно. }
procedure TMainForm.MenuRegionIn(Sender: TObject);
begin
FProject.RegionStart := FTimeline.Playhead;
if FProject.RegionEnd <= FProject.RegionStart then
FProject.RegionEnd := FProject.EndTime;
FTimeline.Invalidate;
UpdateCaption;
SetStatus(Format('Участок: %s — %s',
[SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]));
end;
procedure TMainForm.MenuRegionOut(Sender: TObject);
var
Tmp: Double;
begin
FProject.RegionEnd := FTimeline.Playhead;
if FProject.RegionEnd < FProject.RegionStart then
begin
Tmp := FProject.RegionStart;
FProject.RegionStart := FProject.RegionEnd;
FProject.RegionEnd := Tmp;
end;
FTimeline.Invalidate;
UpdateCaption;
SetStatus(Format('Участок: %s — %s',
[SecondsToStr(FProject.RegionStart), SecondsToStr(FProject.RegionEnd)]));
end;
procedure TMainForm.MenuRegionClear(Sender: TObject);
begin
FProject.RegionStart := 0;
FProject.RegionEnd := 0;
FTimeline.Invalidate;
UpdateCaption;
SetStatus('Отметки участка сняты: собирается весь монтаж.');
end;
{ Границы того, что собираем. Без отметок — весь монтаж. }
procedure TMainForm.DescribeRegion(out AFrom, ATo: Double);
begin
if FProject.HasRegion then
begin
AFrom := Max(0, FProject.RegionStart);
ATo := FProject.RegionEnd;
end
else
begin
AFrom := 0;
ATo := FProject.EndTime;
end;
end;
procedure TMainForm.MenuSelectAll(Sender: TObject);
begin
FTimeline.SelectAll;
@ -3259,8 +3334,9 @@ var
Missing: TGenRequests;
HasPrecise: Boolean;
T, C: Integer;
Rebuilt: Double;
SubsPath: string;
Rebuilt, RegionFrom, RegionTo: Double;
SubsPath, RegionCaption: string;
Master: TMediaInfo;
begin
if not FlattenProject(FProject, Segments, AudioSegs, Missing) then
begin
@ -3278,6 +3354,24 @@ begin
Exit;
end;
{ Отмеченный участок: от списка кусков остаётся только он. Куски,
задетые краем, подрезаются — картинка и звук режутся по одному и тому
же времени, иначе они разъедутся. }
DescribeRegion(RegionFrom, RegionTo);
RegionCaption := '';
if FProject.HasRegion then
begin
RegionCaption := SecondsToStr(RegionFrom) + ' — ' + SecondsToStr(RegionTo);
ClipSegmentsToRange(Segments, RegionFrom, RegionTo);
ClipSegmentsToRange(AudioSegs, RegionFrom, RegionTo);
if Length(Segments) = 0 then
begin
ThemedMessageDlg('nlve',
'В отмеченном участке нечего собирать.', mtInformation, [mbOK], 0);
Exit;
end;
end;
{ Сколько материала придётся пересобрать. Наложение, переход,
полупрозрачность и чужие параметры файла — всё это перекодирование, и
человек должен знать цену заранее, а не обнаружить её по времени
@ -3300,7 +3394,7 @@ begin
{ Куда собирать, в каком контейнере и что делать с текстом — один
вопрос: ответ на любую его часть меняет допустимое в остальных. }
if not AskExport(FExportChoice, HasText(FProject), HasPrecise,
FSettings.LastExportDir) then
FSettings.LastExportDir, RegionCaption) then
Exit;
FSettings.LastExportDir := ExtractFilePath(FExportChoice.Path);
@ -3319,13 +3413,17 @@ begin
if HasText(FProject) then
begin
if FExportChoice.BurnText then
{ Начало списка — не обязательно начало монтажа: при отмеченном
участке текст надо брать с его начала. }
Rebuilt := Rebuilt +
BurnTextIntoSegments(FProject, Segments, FProject.CacheDir)
BurnTextIntoSegments(FProject, Segments, FProject.CacheDir, RegionFrom)
else
begin
SubsPath := IncludeTrailingPathDelimiter(FProject.CacheDir) +
'export.ass';
if not WriteAssFile(FProject, SubsPath) then
{ Разметка тоже по участку: иначе субтитры в готовом файле
появлялись бы со сдвигом на его начало. }
if not WriteAssForRange(FProject, RegionFrom, RegionTo, SubsPath) then
SubsPath := '';
end;
end;
@ -3343,13 +3441,22 @@ begin
mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
Exit;
if FProject.HasRegion then
Log(Format('Собирается отмеченный участок: %s — %s',
[SecondsToStr(RegionFrom), SecondsToStr(RegionTo)]));
Log('Сборка в ' + FExportChoice.Path);
Log(Format('%d %s, длительность %s с',
[Length(Segments), Plural(Length(Segments), 'кусок', 'куска', 'кусков'),
SecondsToStr(TotalDuration(Segments))]));
{ Пересобираемые куски целятся в битрейт самого щедрого исходника, а не
в то, что кодировщик выберет сам: его выбор скромнее в разы, и
пересобранный кусок оказывается заметно хуже соседних скопированных. }
Master := FProject.Master;
Master.VideoBitrate := FProject.MaxVideoBitrate;
FExport := TExportThread.Create(Segments, AudioSegs,
FExportChoice.Path, True, FProject.Master, AProfile);
FExportChoice.Path, True, Master, AProfile);
FExport.SubtitlePath := SubsPath;
FExport.OnProgress := @ExportProgress;
FExport.OnLog := @ExportLog;

View file

@ -249,6 +249,9 @@ type
FTracks: TObjectList;
FMaster: TMediaInfo;
FRippleMode: TRippleMode;
{ Отмеченный участок монтажа: от и до. Пока не отмечен, оба нуля. }
FRegionStart: Double;
FRegionEnd: Double;
FRippleEnabled: Boolean;
FFileName: string;
FModified: Boolean;
@ -361,6 +364,22 @@ type
{ Режим действует всегда, даже когда автосхлопывание выключено:
он определяет, что сделает Ctrl+Shift+R. }
property RippleMode: TRippleMode read FRippleMode write FRippleMode;
{ Отмеченный участок: собирать можно только его. Нужен, чтобы
проверить кусок монтажа, не собирая весь ролик — на длинном
материале это разница между минутой и часом.
Отметок две, и обе живут в проекте, а не в настройках программы:
участок относится к этому монтажу, а не к привычкам человека. }
property RegionStart: Double read FRegionStart write FRegionStart;
property RegionEnd: Double read FRegionEnd write FRegionEnd;
function HasRegion: Boolean;
{ Наибольший битрейт среди видеофайлов проекта.
Им целятся при пересборке кусков. Брать средний или битрейт первого
файла нельзя: пересобранный кусок стоит рядом со скопированными, и
если он окажется хуже их, разница бросится в глаза именно на нём.
Лучше потратить место, чем показать шакала посреди чистой съёмки. }
function MaxVideoBitrate: Int64;
{ Автоматическое схлопывание при перетаскивании клипов. }
property RippleEnabled: Boolean read FRippleEnabled write FRippleEnabled;
property FileName: string read FFileName write FFileName;
@ -576,6 +595,8 @@ begin
FMaster := Default(TMediaInfo);
FRippleMode := rmCurrentTrack;
FRippleEnabled := False;
FRegionStart := 0;
FRegionEnd := 0;
FFileName := '';
FModified := False;
FNextId := 1;
@ -962,6 +983,29 @@ begin
end;
end;
{ Участок считается отмеченным, только если он не пустой: две отметки в
одной точке — это отсутствие участка, а не участок нулевой длины. }
function TProject.HasRegion: Boolean;
begin
Result := FRegionEnd > FRegionStart + 0.001;
end;
function TProject.MaxVideoBitrate: Int64;
var
I: Integer;
Item: TMediaItem;
begin
Result := FMaster.VideoBitrate;
for I := 0 to FPool.Count - 1 do
begin
Item := TMediaItem(FPool[I]);
if not Item.Info.HasVideo then
Continue;
if Item.Info.VideoBitrate > Result then
Result := Item.Info.VideoBitrate;
end;
end;
procedure TProject.ClearSelection;
var
T, C: Integer;
@ -1462,7 +1506,9 @@ begin
Root.Add('settings', TJSONObject.Create([
'ripple_mode', RippleModeToStr(FRippleMode),
'ripple_enabled', FRippleEnabled
'ripple_enabled', FRippleEnabled,
'region_start', FRegionStart,
'region_end', FRegionEnd
]));
Result := Root.FormatJSON;
@ -1585,6 +1631,8 @@ begin
begin
FRippleMode := StrToRippleMode(Settings.Get('ripple_mode', 'current'));
FRippleEnabled := Settings.Get('ripple_enabled', False);
FRegionStart := Settings.Get('region_start', Double(0));
FRegionEnd := Settings.Get('region_end', Double(0));
{ Старые проекты хранили один флаг «все дорожки». }
if Settings.Get('ripple_all_tracks', False) then
FRippleMode := rmAllTracks;

View file

@ -79,9 +79,14 @@ function WriteAssForRange(AProject: TProject; const AFrom, ATo: Double;
пересборки и подкладывает свою разметку.
Возвращает, сколько секунд придётся пересобрать сверх того, что и так
пересобиралось: человеку это говорят до начала. }
пересобиралось: человеку это говорят до начала.
AStartTime — время монтажа, которому соответствует начало списка.
Нужен, когда собирают не весь ролик, а отмеченный участок: иначе текст
брался бы с начала монтажа и лёг бы не на те куски. }
function BurnTextIntoSegments(AProject: TProject;
var ASegments: TFlatSegmentArray; const ACacheDir: string): Double;
var ASegments: TFlatSegmentArray; const ACacheDir: string;
const AStartTime: Double = 0): Double;
implementation
@ -479,7 +484,8 @@ begin
end;
function BurnTextIntoSegments(AProject: TProject;
var ASegments: TFlatSegmentArray; const ACacheDir: string): Double;
var ASegments: TFlatSegmentArray; const ACacheDir: string;
const AStartTime: Double): Double;
var
I: Integer;
At, SegEnd: Double;
@ -489,7 +495,7 @@ begin
if (AProject = nil) or (not HasText(AProject)) then
Exit;
At := 0;
At := AStartTime;
for I := 0 to High(ASegments) do
begin
SegEnd := At + ASegments[I].Duration;

View file

@ -143,6 +143,7 @@ type
function YToVolume(const AY: Integer; ATop: Integer): Double;
procedure DrawRuler(ACanvas: TCanvas);
procedure DrawRegion(ACanvas: TCanvas);
procedure DrawTracks(ACanvas: TCanvas);
procedure DrawClip(ACanvas: TCanvas; AClip: TClip; ATop: Integer);
procedure DrawPlayhead(ACanvas: TCanvas);
@ -351,6 +352,8 @@ const
ColorClipBorder = TColor($5080AA); // светлая рамка клипа
ColorClipText = TColor($F0F0F0);
ColorPlayhead = TColor($4040FF); // красный: привычный цвет курсора
ColorRegion = TColor($30A0D0); // отмеченный участок: янтарная полоса
ColorRegionEdge = TColor($1878B0);
ColorEdgeSnap = TColor($909090); // серый: рез притянут к опорному кадру
ColorEdgePrecise = TColor($FFC030); // голубой: рез потребует перекодирования
ColorWave = TColor($96C8D2); // пастельно-жёлтый: форма звука
@ -704,9 +707,41 @@ begin
T := T + Step;
end;
{ Отмеченный участок: полоса по низу линейки и стойки по краям.
Рисуется после делений, чтобы не оказаться под ними, и только на
линейке: закрашивать сами дорожки нельзя — под краской не разглядеть
клипы, а участок отмечают как раз чтобы в них разбираться. }
DrawRegion(ACanvas);
ACanvas.Brush.Style := bsSolid;
end;
procedure TTimelineControl.DrawRegion(ACanvas: TCanvas);
var
L, R: Integer;
begin
if (FProject = nil) or (not FProject.HasRegion) then
Exit;
L := Max(FHeaderWidth, TimeToX(FProject.RegionStart));
R := Min(ClientWidth, TimeToX(FProject.RegionEnd));
if R <= L then
Exit;
ACanvas.Brush.Style := bsSolid;
ACanvas.Brush.Color := ColorRegion;
ACanvas.FillRect(L, FRulerHeight - 6, R, FRulerHeight - 1);
{ Стойки во всю высоту: край участка должен быть виден и там, где
линейка уже уехала вверх за пределы видимого. }
ACanvas.Pen.Color := ColorRegionEdge;
if TimeToX(FProject.RegionStart) >= FHeaderWidth then
ACanvas.Line(L, 0, L, ClientHeight);
if TimeToX(FProject.RegionEnd) <= ClientWidth then
ACanvas.Line(R - 1, 0, R - 1, ClientHeight);
end;
procedure TTimelineControl.DrawClip(ACanvas: TCanvas; AClip: TClip;
ATop: Integer);
var

View file

@ -781,6 +781,51 @@ begin
end;
WriteLn;
{ --- 9. Обрезка списка кусков по отмеченному участку --- }
WriteLn(' 9. Сборка только отмеченного участка');
Proj := MakeProject(1, Media);
try
{ Три куска по 5 секунд из разных мест файла: склеиться в один они не
могут, и границы участка приходятся на середину крайних. }
Proj.AddClip(Proj.Tracks[0], Media, 100, 5, 0);
Proj.AddClip(Proj.Tracks[0], Media, 200, 5, 5);
Proj.AddClip(Proj.Tracks[0], Media, 300, 5, 10);
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
Check(Length(Segs) = 3, 'до обрезки три куска');
Check(Abs(ClipSegmentsToRange(Segs, 2, 12) - 10) < 0.001,
'осталось десять секунд');
DumpSegments(Segs);
Check(Length(Segs) = 3, 'куски остались все три');
if Length(Segs) = 3 then
begin
Check(Abs(Segs[0].SrcStart - 102) < 0.001,
'первый начинается на две секунды позже');
Check(Abs(Segs[0].Duration - 3) < 0.001, 'и длится три секунды');
Check(Abs(Segs[1].SrcStart - 200) < 0.001, 'средний не тронут');
Check(Abs(Segs[1].Duration - 5) < 0.001, 'и целиком');
Check(Abs(Segs[2].SrcStart - 300) < 0.001, 'последний с начала');
Check(Abs(Segs[2].Duration - 2) < 0.001, 'и укорочен до двух секунд');
end;
{ Участок целиком внутри одного куска. }
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
Check(Abs(ClipSegmentsToRange(Segs, 6, 8) - 2) < 0.001,
'внутри одного куска остались две секунды');
Check(Length(Segs) = 1, 'и один кусок');
if Length(Segs) = 1 then
Check(Abs(Segs[0].SrcStart - 201) < 0.001, 'взят с нужного места');
{ Участок мимо монтажа. }
FlattenStream(Proj, tkVideo, 0, Segs, Missing);
Check(Abs(ClipSegmentsToRange(Segs, 100, 200)) < 0.001,
'за концом монтажа не осталось ничего');
Check(Length(Segs) = 0, 'и ни одного куска');
finally
Proj.Free;
end;
WriteLn;
WriteLn;
if FailCount = 0 then
begin
@ -1239,6 +1284,13 @@ begin
end;
end;
{ Вжигание текста — последним, уже по окончательному списку кусков:
повторное уплощение стёрло бы отметки о разметке. Так же устроено и
окно сборки. }
if (ParamCount >= 4) and (LowerCase(ParamStr(4)) = 'burn') then
WriteLn('вжигаю текст, пересобрать придётся ',
SecondsToStr(BurnTextIntoSegments(Proj, Segs, Proj.CacheDir)), ' с');
Thread := TExportThread.Create(Segs, AudioSegs,
ExpandFileName(ParamStr(3)), True, Proj.Master, Default(TEncodeProfile));
Watcher := TExportWatcher.Create(Thread);