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

Сборка ролика с текстом: вжиганием или отдельной дорожкой

Browse source 
Окно сборки теперь спрашивает не только имя файла: куда собирать, в каком
контейнере и что делать с текстом — это один вопрос, ответ на любую часть
меняет допустимое в остальных.

При MP4 вжигание становится обязательным, и галка запирается. Причина
измерена, а не выдумана: отдельной дорожкой субтитров со всем оформлением
умеет только Matroska, в MP4 их кладут как mov_text, а он не хранит ни
цвета, ни обводки, ни положения. Переключение на MKV возвращает прежний
ответ человека — тот, что он давал до того, как MP4 решил за него.

Вжигание. Куски, которые задевает надпись, помечаются к пересборке, и
каждому подкладывается своя разметка: времена сдвинуты к началу куска и
обрезаны по его длине. Иначе никак — фильтр subtitles рисует по времени
того файла, который ему дали, а кусок начинается со своего нуля. Текст
дорисовывается последним, уже по кадру проекта: раньше он попал бы под
масштабирование и уехал бы вместе с картинкой.

Отдельная дорожка. Разметка вкладывается в готовый файл кодеком ass при
сшивании, ничего не перекодируется.

Предупреждение о пересборке теперь считается после подготовки текста:
раньше оно показывалось до неё и не знало о вжигаемых участках.

Проверено сборкой двух роликов из одного монтажа с надписью на 2..6
секунде. С вжиганием: кадры на 1 и 7 секундах чистые, на 3 и 5 — с
надписью, предупреждение назвало 8 секунд из 15.5. Отдельной дорожкой: в
файле три потока, третий ass с названием «Надписи», картинка чистая.

Своя ошибка, найденная по дороге: установка галки кодом вызывает тот же
обработчик, что и щелчок, и навязанное при MP4 значение записывалось как
осознанный выбор — при возврате на MKV галка оставалась стоять.

Окно хода сборки переименовано в «Ход сборки»: два окна с заголовком
«Сборка ролика» путали и меня, и человека.
This commit is contained in:
4aiman 2026-08-30 16:34:59 +03:00
commit 62ba75ff2f
6 changed files with 506 additions and 61 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/uAppTypes.pas
View file

@ -84,6 +84,10 @@ type
{ Готовая цепочка фильтров ffmpeg: как кадр этого исходника ложится в
кадр проекта. Считается один раз при уплощении. }
Filter: string;
{ Разметка субтитров для этого куска: времена уже сдвинуты к его
началу. Пусто — текста здесь нет. Заполняется только при сборке с
вжиганием. }
SubFile: string;
{ Слои наложения. Пусто — обычный кусок с одним источником, который
можно скопировать. Непусто — участок придётся собрать заново.

9
src/uExport.pas
View file

@ -131,6 +131,7 @@ type
FMaster: TMediaInfo;
FProfile: TEncodeProfile;
FSubtitlePath: string;
{ Формат промежуточных кусков: 'matroska' или 'mpegts'. }
FIntermediateFormat: string;
FIntermediateExt: string;
@ -182,6 +183,10 @@ type
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
property OnLog: TNotifyEvent read FOnLog write FOnLog;
{ Разметка субтитров, которую надо вложить в готовый файл отдельной
дорожкой. Пусто — либо текста нет, либо он вжигается в картинку.
Годится только для Matroska: MP4 хранит субтитры без оформления. }
property SubtitlePath: string read FSubtitlePath write FSubtitlePath;
end;
{ Каталог для временных кусков рядом с готовым файлом. }
@ -563,7 +568,7 @@ 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),
FIntermediateFormat, FSegments[I].Filter, FSegments[I].SubFile),
'Пересборка куска ' + IntToStr(I + 1)) then
Exit;
@ -969,7 +974,7 @@ var
begin
SetStage('Сшиваю');
Res := RunProcess(FfmpegExe,
ArgsMux(FVideoPath, FAudioPath, FOutputPath),
ArgsMux(FVideoPath, FAudioPath, FOutputPath, FSubtitlePath),
@ProgressLine, @ErrorLine, @CancelQuery);
Result := Res.Started and (Res.ExitCode = 0) and FileExists(FOutputPath);
if Res.Cancelled then

286
src/uExportForm.pas Normal file
View file

@ -0,0 +1,286 @@
{
uExportForm — окно сборки ролика.
Здесь выбирается не только имя файла, но и то, что от него зависит:
контейнер и способ попадания текста в ролик. Разделять их нельзя —
выбор одного меняет допустимое в другом.
Почему при MP4 вжигание становится обязательным. Отдельной дорожкой
субтитров со всем оформлением умеет только Matroska. В MP4 их кладут
как mov_text, а он не хранит ни цвета, ни обводки, ни положения — от
надписи остаётся голый текст в углу, и это хуже, чем ничего. Поэтому
при MP4 галка ставится и запирается: выбора всё равно нет.
Запертой она остаётся ровно пока выбран MP4. Переключение на MKV
возвращает и галку, и прежний ответ человека — тот, что он давал до
того, как MP4 всё за него решил.
}
unit uExportForm;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Forms, Graphics, StdCtrls, Dialogs,
uTheme;
type
{ Что человек выбрал в окне. }
TExportChoice = record
Path: string;
{ Вжигать ли текст в картинку. При MP4 всегда True. }
BurnText: Boolean;
end;
{ Показывает окно.
AHasText — есть ли в проекте надписи: без них про текст и спрашивать
незачем. APreferMkv — в монтаже есть точные резы, и MKV надёжнее.
ABurnDefault — ответ, данный в прошлый раз. }
function AskExport(var AChoice: TExportChoice; AHasText, APreferMkv: Boolean;
const ADefaultDir: string): Boolean;
implementation
type
TExportDialog = class(TComponent)
public
Form: TForm;
edPath: TEdit;
BtnMp4: TThemedButton;
BtnMkv: TThemedButton;
cbBurn: TCheckBox;
lblNote: TLabel;
HasText: Boolean;
{ Ответ человека про вжигание, сохранённый до того, как MP4 навязал
своё. К нему возвращаемся при переходе на MKV. }
BurnWanted: Boolean;
{ Идёт ли согласование: пока идёт, ответы человека не запоминаются.
Установка галки кодом вызывает тот же обработчик, что и щелчок, и
без этого признака навязанное при MP4 значение записывалось бы как
осознанный выбор — при возврате на MKV галка так и оставалась
стоять. }
Applying: Boolean;
procedure FormatClick(Sender: TObject);
procedure BrowseClick(Sender: TObject);
procedure BurnClick(Sender: TObject);
function IsMp4: Boolean;
procedure ApplyFormat;
end;
function TExportDialog.IsMp4: Boolean;
begin
Result := BtnMp4.Down;
end;
{ Приводит имя файла и галку в согласие с выбранным контейнером. }
procedure TExportDialog.ApplyFormat;
var
Ext: string;
begin
Applying := True;
try
if IsMp4 then
Ext := '.mp4'
else
Ext := '.mkv';
if Trim(edPath.Text) <> '' then
edPath.Text := ChangeFileExt(edPath.Text, Ext);
if not HasText then
begin
lblNote.Caption := '';
Exit;
end;
if IsMp4 then
begin
{ Сначала запираем, потом ставим: наоборот обработчик успел бы счесть
навязанное значение осознанным. }
cbBurn.Enabled := False;
cbBurn.Checked := True;
lblNote.Caption := 'В MP4 отдельная дорожка субтитров теряет цвет, ' +
'обводку и положение, поэтому текст вжигается. Участки с текстом ' +
'придётся пересобрать.';
end
else
begin
cbBurn.Enabled := True;
cbBurn.Checked := BurnWanted;
if cbBurn.Checked then
lblNote.Caption := 'Участки с текстом придётся пересобрать. ' +
'Текст будет виден в любом проигрывателе.'
else
lblNote.Caption := 'Текст ляжет отдельной дорожкой субтитров: ' +
'сборка останется мгновенной, но показывать его будет не всякий ' +
'проигрыватель.';
end;
finally
Applying := False;
end;
end;
procedure TExportDialog.FormatClick(Sender: TObject);
begin
BtnMp4.Down := Sender = BtnMp4;
BtnMkv.Down := Sender = BtnMkv;
ApplyFormat;
end;
procedure TExportDialog.BurnClick(Sender: TObject);
begin
if Applying then
Exit;
{ Запоминаем только осознанный ответ: при MP4 галка стоит не по воле
человека, и запоминать её значило бы соврать ему в следующий раз. }
if cbBurn.Enabled then
BurnWanted := cbBurn.Checked;
ApplyFormat;
end;
procedure TExportDialog.BrowseClick(Sender: TObject);
var
Dlg: TSaveDialog;
begin
Dlg := TSaveDialog.Create(nil);
try
Dlg.Title := 'Куда собрать ролик';
Dlg.Options := Dlg.Options + [ofOverwritePrompt, ofPathMustExist];
if IsMp4 then
begin
Dlg.DefaultExt := '.mp4';
Dlg.Filter := 'MP4|*.mp4';
end
else
begin
Dlg.DefaultExt := '.mkv';
Dlg.Filter := 'Matroska|*.mkv';
end;
Dlg.FileName := edPath.Text;
if Dlg.Execute then
edPath.Text := Dlg.FileName;
finally
Dlg.Free;
end;
end;
function AskExport(var AChoice: TExportChoice; AHasText, APreferMkv: Boolean;
const ADefaultDir: string): Boolean;
var
Dlg: TExportDialog;
Lbl: TLabel;
BtnBrowse, BtnOk, BtnCancel: TThemedButton;
Dir: string;
begin
Result := False;
Dlg := TExportDialog.Create(nil);
try
Dlg.HasText := AHasText;
Dlg.BurnWanted := AChoice.BurnText;
Dlg.Form := TForm.CreateNew(nil);
Dlg.Form.Caption := 'Сборка ролика';
Dlg.Form.Position := poScreenCenter;
Dlg.Form.ClientWidth := 620;
Dlg.Form.ClientHeight := 250;
Lbl := TLabel.Create(Dlg.Form);
Lbl.Parent := Dlg.Form;
Lbl.SetBounds(12, 12, 200, 20);
Lbl.Caption := 'Куда собрать';
Dlg.edPath := TEdit.Create(Dlg.Form);
Dlg.edPath.Parent := Dlg.Form;
Dlg.edPath.SetBounds(12, 34, 490, 26);
Dlg.edPath.Anchors := [akTop, akLeft, akRight];
BtnBrowse := TThemedButton.Create(Dlg.Form);
BtnBrowse.Parent := Dlg.Form;
BtnBrowse.SetBounds(510, 33, 96, 28);
BtnBrowse.Anchors := [akTop, akRight];
BtnBrowse.Caption := 'Обзор...';
BtnBrowse.OnClick := @Dlg.BrowseClick;
Lbl := TLabel.Create(Dlg.Form);
Lbl.Parent := Dlg.Form;
Lbl.SetBounds(12, 76, 100, 20);
Lbl.Caption := 'Контейнер';
Dlg.BtnMp4 := TThemedButton.Create(Dlg.Form);
Dlg.BtnMp4.Parent := Dlg.Form;
Dlg.BtnMp4.SetBounds(110, 72, 90, 28);
Dlg.BtnMp4.Caption := 'MP4';
Dlg.BtnMp4.TabStop := False;
Dlg.BtnMp4.OnClick := @Dlg.FormatClick;
Dlg.BtnMkv := TThemedButton.Create(Dlg.Form);
Dlg.BtnMkv.Parent := Dlg.Form;
Dlg.BtnMkv.SetBounds(206, 72, 90, 28);
Dlg.BtnMkv.Caption := 'MKV';
Dlg.BtnMkv.TabStop := False;
Dlg.BtnMkv.OnClick := @Dlg.FormatClick;
Dlg.cbBurn := TCheckBox.Create(Dlg.Form);
Dlg.cbBurn.Parent := Dlg.Form;
Dlg.cbBurn.SetBounds(12, 116, 300, 22);
Dlg.cbBurn.Caption := 'Вжечь текст в картинку';
Dlg.cbBurn.Visible := AHasText;
Dlg.cbBurn.OnClick := @Dlg.BurnClick;
Dlg.lblNote := TLabel.Create(Dlg.Form);
Dlg.lblNote.Parent := Dlg.Form;
Dlg.lblNote.SetBounds(12, 144, 596, 52);
Dlg.lblNote.Anchors := [akTop, akLeft, akRight];
Dlg.lblNote.AutoSize := False;
Dlg.lblNote.WordWrap := True;
BtnOk := TThemedButton.Create(Dlg.Form);
BtnOk.Parent := Dlg.Form;
BtnOk.SetBounds(400, 208, 100, 30);
BtnOk.Anchors := [akRight, akBottom];
BtnOk.Caption := 'Собрать';
BtnOk.ModalResult := mrOk;
BtnOk.Default := True;
BtnCancel := TThemedButton.Create(Dlg.Form);
BtnCancel.Parent := Dlg.Form;
BtnCancel.SetBounds(508, 208, 100, 30);
BtnCancel.Anchors := [akRight, akBottom];
BtnCancel.Caption := 'Отмена';
BtnCancel.ModalResult := mrCancel;
BtnCancel.Cancel := True;
ApplyDarkTheme(Dlg.Form);
{ Начальное имя: где были в прошлый раз, с расширением по контейнеру. }
Dir := ADefaultDir;
if Dir = '' then
Dir := GetCurrentDir;
if AChoice.Path <> '' then
Dlg.edPath.Text := AChoice.Path
else
Dlg.edPath.Text := IncludeTrailingPathDelimiter(Dir) + 'ролик.mkv';
{ Точные резы просят Matroska: в MP4 перекодированный стык может
воспроизводиться неправильно. }
Dlg.BtnMkv.Down := APreferMkv or
(LowerCase(ExtractFileExt(Dlg.edPath.Text)) = '.mkv');
Dlg.BtnMp4.Down := not Dlg.BtnMkv.Down;
Dlg.ApplyFormat;
if Dlg.Form.ShowModal <> mrOk then
Exit;
AChoice.Path := Trim(Dlg.edPath.Text);
if AChoice.Path = '' then
Exit;
AChoice.BurnText := AHasText and Dlg.cbBurn.Checked;
Result := True;
finally
Dlg.Form.Free;
Dlg.Free;
end;
end;
end.

68
src/uFfmpegCmd.pas
View file

@ -86,7 +86,13 @@ function ArgsTranscodeSegment(const ASrc, ADst: string; AStart, AEnd: Double;
AWidth, AHeight, AFpsNum, AFpsDen: Integer;
const AVideoCodec, APixFmt, AAudioCodec: string;
ASampleRate, AChannels: Integer; AVolume: Double;
const AFormat: string; const AFilter: string = ''): TArgs;
const AFormat: string; const AFilter: string = '';
const ASubFile: string = ''): TArgs;
{ Путь внутри строки фильтра. Двоеточие там разделяет настройки, обратная
косая и кавычка имеют своё значение — всё это надо обезвредить, иначе
путь с пробелом или двоеточием развалит разбор. }
function EscapeFilterPath(const APath: string): string;
{ Кадр одиночной картинки для окна кадрирования. }
function ArgsPreviewFrame(const ASrc, ADst: string; const ATime: Double;
@ -146,8 +152,12 @@ function ArgsRenderLayers(const ALayers: array of TSegmentLayer;
AWidth, AHeight, AFpsNum, AFpsDen: Integer;
const APixFmt, ACodec: string; AIsTs: Boolean): TArgs;
{ Сшивание готовой картинки с готовым звуком. Оба потока копируются. }
function ArgsMux(const AVideo, AAudio, ATarget: string): TArgs;
{ Сшивание готовой картинки с готовым звуком. Оба потока копируются.
ASubFile — разметка субтитров, которую надо вложить отдельной дорожкой.
Пусто — не вкладывать. }
function ArgsMux(const AVideo, AAudio, ATarget: string;
const ASubFile: string = ''): TArgs;
function ArgsRemux(const ASrc, ADst: string): TArgs;
@ -335,13 +345,28 @@ begin
Result := Concat(Result, [ATarget]);
end;
function ArgsMux(const AVideo, AAudio, ATarget: string): TArgs;
function ArgsMux(const AVideo, AAudio, ATarget: string;
const ASubFile: string): TArgs;
begin
Result := ['-hide_banner', '-nostdin', '-loglevel', 'warning', '-y',
'-i', AVideo, '-i', AAudio,
'-map', '0:v:0', '-map', '1:a:0', '-c', 'copy',
'-i', AVideo, '-i', AAudio];
{ Субтитры отдельной дорожкой: ничего не перекодируется, проигрыватель
может их включить или выключить. Кодек ass сохраняет всё оформление —
в MP4 такого нет, там субтитры кладутся голым текстом, поэтому туда
их и не предлагают. }
if ASubFile <> '' then
Result := Concat(Result, ['-i', ASubFile]);
Result := Concat(Result, ['-map', '0:v:0', '-map', '1:a:0']);
if ASubFile <> '' then
Result := Concat(Result, ['-map', '2:s:0', '-c:s', 'ass',
'-metadata:s:s:0', 'title=Надписи',
'-metadata:s:s:0', 'language=rus']);
Result := Concat(Result, ['-c:v', 'copy', '-c:a', 'copy',
'-avoid_negative_ts', 'make_zero',
'-progress', 'pipe:1', '-nostats', ATarget];
'-progress', 'pipe:1', '-nostats', ATarget]);
end;
function MasterOutputArgs(AWidth, AHeight, AFpsNum, AFpsDen: Integer;
@ -548,11 +573,21 @@ begin
Result := Concat(Result, ['-f', AFormat, ADst]);
end;
function EscapeFilterPath(const APath: string): string;
begin
Result := StringReplace(APath, '\', '/', [rfReplaceAll]);
Result := StringReplace(Result, '''', '\''', [rfReplaceAll]);
Result := StringReplace(Result, ':', '\:', [rfReplaceAll]);
end;
function ArgsTranscodeSegment(const ASrc, ADst: string; AStart, AEnd: Double;
AWidth, AHeight, AFpsNum, AFpsDen: Integer;
const AVideoCodec, APixFmt, AAudioCodec: string;
ASampleRate, AChannels: Integer; AVolume: Double;
const AFormat: string; const AFilter: string): TArgs;
const AFormat: string; const AFilter: string;
const ASubFile: string): TArgs;
var
Chain: string;
begin
Result := Concat(CommonFfmpegPrefix, [
'-ss', SecondsToStr(AStart),
@ -565,11 +600,20 @@ begin
{ Как именно кадр ложится в кадр проекта, решено заранее и передано
готовой цепочкой фильтров. }
if AFilter <> '' then
Result := Concat(Result, ['-vf', AFilter])
Chain := AFilter
else
Result := Concat(Result, ['-vf', Format(
'scale=%d:%d:force_original_aspect_ratio=decrease,pad=%d:%d:(ow-iw)/2:(oh-ih)/2,setsar=1',
[AWidth, AHeight, AWidth, AHeight])]);
Chain := Format(
'scale=%d:%d:force_original_aspect_ratio=decrease,' +
'pad=%d:%d:(ow-iw)/2:(oh-ih)/2,setsar=1',
[AWidth, AHeight, AWidth, AHeight]);
{ Текст рисуется последним — уже по кадру проекта. Раньше он попал бы
под масштабирование и уехал бы вместе с картинкой. }
if ASubFile <> '' then
Chain := Chain + ',subtitles=filename=''' +
EscapeFilterPath(ASubFile) + '''';
Result := Concat(Result, ['-vf', Chain]);
if Abs(AVolume - 1) >= 0.001 then
Result := Concat(Result, ['-af', 'volume=' + SecondsToStr(AVolume)]);

78
src/uMainForm.pas
View file

@ -29,7 +29,7 @@ uses
uRemuxForm, uMismatchForm,
uFfmpegJob, uSettings, uThumbs, uTransform, uPanCropForm,
uProjectInfoForm, ImgList, uTheme, uLogView, uDepsForm, uWaveform,
uIconData, uSubtitles, uTextMeasure, uTextForm;
uIconData, uSubtitles, uTextMeasure, uTextForm, uExportForm;
const
{ Номера системных сообщений о перерисовке рамки окна. Берём числами, а
@ -109,6 +109,9 @@ type
FJobLabel: TLabel;
FJobBar: TThemedProgress;
FJobTimer: TTimer;
{ Что выбрали в окне сборки в прошлый раз. Держится между вызовами,
чтобы не задавать один и тот же вопрос заново. }
FExportChoice: TExportChoice;
FLogButton: TThemedButton;
{ Показанная доля выполнения. Отдельно от настоящей, потому что растёт
она по своим правилам — см. AdvanceJobBar. }
@ -2979,6 +2982,7 @@ var
HasPrecise: Boolean;
T, C: Integer;
Rebuilt: Double;
SubsPath: string;
begin
if not FlattenProject(FProject, Segments, AudioSegs, Missing) then
begin
@ -3005,18 +3009,6 @@ begin
if Segments[T].Transcode or (Length(Segments[T].Layers) > 0) then
Rebuilt := Rebuilt + Segments[T].Duration;
if Rebuilt > 0.5 then
if ThemedMessageDlg('nlve',
Format('Часть ролика придётся пересобрать: %s с из %s.' + LineEnding +
LineEnding +
'Пересобираются участки с наложением, переходами, прозрачностью и ' +
'куски файлов, не совпадающих с параметрами проекта. Остальное ' +
'копируется без потерь и почти мгновенно.' + LineEnding + LineEnding +
'Продолжить?',
[SecondsToStr(Rebuilt), SecondsToStr(TotalDuration(Segments))]),
mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
Exit;
{ Если есть хоть один точный рез, предупреждаем про контейнер: в MP4
перекодированный кусок и скопированный уживаются не всегда, а MKV
к смене параметров потока терпимее. }
@ -3027,22 +3019,15 @@ begin
(FProject.Tracks[T][C].EdgeOut = edPrecise) then
HasPrecise := True;
if HasPrecise then
begin
SaveExportDialog.DefaultExt := '.mkv';
SaveExportDialog.FileName := 'ролик.mkv';
end
else
begin
SaveExportDialog.DefaultExt := '.mp4';
SaveExportDialog.FileName := 'ролик.mp4';
end;
if not SaveExportDialog.Execute then
{ Куда собирать, в каком контейнере и что делать с текстом — один
вопрос: ответ на любую его часть меняет допустимое в остальных. }
if not AskExport(FExportChoice, HasText(FProject), HasPrecise,
FSettings.LastExportDir) then
Exit;
FSettings.LastExportDir := ExtractFilePath(SaveExportDialog.FileName);
FSettings.LastExportDir := ExtractFilePath(FExportChoice.Path);
if HasPrecise and (LowerCase(ExtractFileExt(SaveExportDialog.FileName)) <> '.mkv') then
if HasPrecise and
(LowerCase(ExtractFileExt(FExportChoice.Path)) <> '.mkv') then
if ThemedMessageDlg('nlve',
'В монтаже есть точные резы. В MP4 перекодированный стык может ' +
'воспроизводиться неправильно — надёжнее MKV.' + LineEnding +
@ -3050,20 +3035,53 @@ begin
mtWarning, [mbYes, mbNo], 0) <> mrYes then
Exit;
Log('Сборка в ' + SaveExportDialog.FileName);
{ Вжигание меняет расклад: куски с текстом перестают копироваться.
Готовим их до подсчёта того, сколько придётся пересобрать. }
SubsPath := '';
if HasText(FProject) then
begin
if FExportChoice.BurnText then
Rebuilt := Rebuilt +
BurnTextIntoSegments(FProject, Segments, FProject.CacheDir)
else
begin
SubsPath := IncludeTrailingPathDelimiter(FProject.CacheDir) +
'export.ass';
if not WriteAssFile(FProject, SubsPath) then
SubsPath := '';
end;
end;
if Rebuilt > 0.5 then
if ThemedMessageDlg('nlve',
Format('Часть ролика придётся пересобрать: %s с из %s.' + LineEnding +
LineEnding +
'Пересобираются участки с наложением, переходами, прозрачностью, ' +
'вжигаемым текстом и куски файлов, не совпадающих с параметрами ' +
'проекта. Остальное копируется без потерь и почти мгновенно.' +
LineEnding + LineEnding +
'Продолжить?',
[SecondsToStr(Rebuilt), SecondsToStr(TotalDuration(Segments))]),
mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
Exit;
Log('Сборка в ' + FExportChoice.Path);
Log(Format('%d %s, длительность %s с',
[Length(Segments), Plural(Length(Segments), 'кусок', 'куска', 'кусков'),
SecondsToStr(TotalDuration(Segments))]));
FExport := TExportThread.Create(Segments, AudioSegs,
SaveExportDialog.FileName, True, FProject.Master, AProfile);
FExportChoice.Path, True, FProject.Master, AProfile);
FExport.SubtitlePath := SubsPath;
FExport.OnProgress := @ExportProgress;
FExport.OnLog := @ExportLog;
FExport.OnTerminate := @ExportDone;
FExportUi := TProgressForm.Create(Self);
try
FExportUi.Caption := 'Сборка ролика';
{ Не «Сборка ролика»: так называется окно настроек, и два окна с
одинаковым заголовком путают. }
FExportUi.Caption := 'Ход сборки';
FExportUi.OnCancelRequest := @ExportCancel;
FExport.Start;
FExportUi.ShowModal;

122
src/uSubtitles.pas
View file

@ -26,7 +26,7 @@ unit uSubtitles;
interface
uses
Classes, SysUtils, uAppTypes, uProject;
Classes, SysUtils, uAppTypes, uProject, uFlatten;
type
{ Как померить ширину строки. Возвращает ширину в точках кадра. }
@ -66,6 +66,23 @@ function FitTextForPreview(const AText: string; const AStyle: TTextStyle;
приходится только в те куски, которые он покрывает. }
function TextCovers(AProject: TProject; const AFrom, ATo: Double): Boolean;
{ Разметка для одного куска монтажа: события сдвинуты к его началу и
обрезаны по его длине.
Нужно вжиганию. Фильтр subtitles рисует по времени того файла, который
ему дали, а кусок начинается со своего нуля — общая разметка легла бы
не туда. }
function WriteAssForRange(AProject: TProject; const AFrom, ATo: Double;
const APath: string): Boolean;
{ Готовит куски к вжиганию: тем, которые задевает текст, ставит признак
пересборки и подкладывает свою разметку.
Возвращает, сколько секунд придётся пересобрать сверх того, что и так
пересобиралось: человеку это говорят до начала. }
function BurnTextIntoSegments(AProject: TProject;
var ASegments: TFlatSegmentArray; const ACacheDir: string): Double;
implementation
uses
@ -304,7 +321,10 @@ begin
end;
end;
function BuildAss(AProject: TProject): string;
{ Общая сборка. AFrom и ATo ограничивают выборку; ATo меньше нуля значит
«до конца монтажа». При ненулевом AFrom времена сдвигаются к нулю — так
разметка годится для отдельного куска. }
function BuildAssRange(AProject: TProject; const AFrom, ATo: Double): string;
var
Lines: TStringList;
Styles, Events: TStringList;
@ -313,6 +333,7 @@ var
Track: TTrack;
Name, Body: string;
W, H, MarginH, MarginV: Integer;
StartAt, EndAt: Double;
begin
Result := '';
if (AProject = nil) or (not HasText(AProject)) then
@ -345,6 +366,11 @@ begin
Clip := Track[C];
if Trim(Clip.Text) = '' then
Continue;
{ Надписи, не попадающие в нужный отрезок, разбирать незачем. }
if (ATo >= 0) and (Clip.TlStart >= ATo - 0.0005) then
Continue;
if Clip.TlEnd <= AFrom + 0.0005 then
Continue;
Size := FitText(Clip.Text, Clip.TextStyle, W, H, Lines);
@ -374,8 +400,16 @@ begin
Body := Body + AssEscape(Lines[I]);
end;
{ Обрезаем по границам куска и сдвигаем к его началу. }
StartAt := Max(Clip.TlStart, AFrom) - AFrom;
EndAt := Clip.TlEnd - AFrom;
if ATo >= 0 then
EndAt := Min(EndAt, ATo - AFrom);
if EndAt <= StartAt then
Continue;
Events.Add(Format('Dialogue: 0,%s,%s,%s,,0,0,0,,%s',
[AssTime(Clip.TlStart), AssTime(Clip.TlEnd), Name, Body]));
[AssTime(StartAt), AssTime(EndAt), Name, Body]));
end;
end;
@ -410,10 +444,76 @@ begin
end;
end;
function BuildAss(AProject: TProject): string;
begin
Result := BuildAssRange(AProject, 0, -1);
end;
function WriteText(const AText, APath: string): Boolean;
var
Stream: TFileStream;
begin
Result := False;
try
ForceDirectories(ExtractFilePath(APath));
Stream := TFileStream.Create(APath, fmCreate);
try
if Length(AText) > 0 then
Stream.WriteBuffer(AText[1], Length(AText));
finally
Stream.Free;
end;
Result := True;
except
Result := False;
end;
end;
function WriteAssForRange(AProject: TProject; const AFrom, ATo: Double;
const APath: string): Boolean;
var
Text: string;
begin
Text := BuildAssRange(AProject, AFrom, ATo);
Result := (Text <> '') and WriteText(Text, APath);
end;
function BurnTextIntoSegments(AProject: TProject;
var ASegments: TFlatSegmentArray; const ACacheDir: string): Double;
var
I: Integer;
At, SegEnd: Double;
Path: string;
begin
Result := 0;
if (AProject = nil) or (not HasText(AProject)) then
Exit;
At := 0;
for I := 0 to High(ASegments) do
begin
SegEnd := At + ASegments[I].Duration;
if TextCovers(AProject, At, SegEnd) then
begin
Path := IncludeTrailingPathDelimiter(ACacheDir) +
Format('burn_%.3d.ass', [I]);
if WriteAssForRange(AProject, At, SegEnd, Path) then
begin
{ Кусок, который и так пересобирался, дороже не становится —
считаем только те, что раньше копировались. }
if not (ASegments[I].Transcode or (Length(ASegments[I].Layers) > 0)) then
Result := Result + ASegments[I].Duration;
ASegments[I].SubFile := Path;
ASegments[I].Transcode := True;
end;
end;
At := SegEnd;
end;
end;
function WriteAssFile(AProject: TProject; const APath: string): Boolean;
var
Text: string;
Stream: TFileStream;
begin
Result := False;
Text := BuildAss(AProject);
@ -426,19 +526,7 @@ begin
Exit;
end;
try
ForceDirectories(ExtractFilePath(APath));
Stream := TFileStream.Create(APath, fmCreate);
try
if Length(Text) > 0 then
Stream.WriteBuffer(Text[1], Length(Text));
finally
Stream.Free;
end;
Result := True;
except
Result := False;
end;
Result := WriteText(Text, APath);
end;
end.