From 62ba75ff2f0b927437eaf1706c6c7dbde9210b42 Mon Sep 17 00:00:00 2001 From: 4aiman Date: Sun, 30 Aug 2026 16:34:59 +0300 Subject: [PATCH] =?UTF-8?q?=D0=A1=D0=B1=D0=BE=D1=80=D0=BA=D0=B0=20=D1=80?= =?UTF-8?q?=D0=BE=D0=BB=D0=B8=D0=BA=D0=B0=20=D1=81=20=D1=82=D0=B5=D0=BA?= =?UTF-8?q?=D1=81=D1=82=D0=BE=D0=BC:=20=D0=B2=D0=B6=D0=B8=D0=B3=D0=B0?= =?UTF-8?q?=D0=BD=D0=B8=D0=B5=D0=BC=20=D0=B8=D0=BB=D0=B8=20=D0=BE=D1=82?= =?UTF-8?q?=D0=B4=D0=B5=D0=BB=D1=8C=D0=BD=D0=BE=D0=B9=20=D0=B4=D0=BE=D1=80?= =?UTF-8?q?=D0=BE=D0=B6=D0=BA=D0=BE=D0=B9?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Окно сборки теперь спрашивает не только имя файла: куда собирать, в каком контейнере и что делать с текстом — это один вопрос, ответ на любую часть меняет допустимое в остальных. При MP4 вжигание становится обязательным, и галка запирается. Причина измерена, а не выдумана: отдельной дорожкой субтитров со всем оформлением умеет только Matroska, в MP4 их кладут как mov_text, а он не хранит ни цвета, ни обводки, ни положения. Переключение на MKV возвращает прежний ответ человека — тот, что он давал до того, как MP4 решил за него. Вжигание. Куски, которые задевает надпись, помечаются к пересборке, и каждому подкладывается своя разметка: времена сдвинуты к началу куска и обрезаны по его длине. Иначе никак — фильтр subtitles рисует по времени того файла, который ему дали, а кусок начинается со своего нуля. Текст дорисовывается последним, уже по кадру проекта: раньше он попал бы под масштабирование и уехал бы вместе с картинкой. Отдельная дорожка. Разметка вкладывается в готовый файл кодеком ass при сшивании, ничего не перекодируется. Предупреждение о пересборке теперь считается после подготовки текста: раньше оно показывалось до неё и не знало о вжигаемых участках. Проверено сборкой двух роликов из одного монтажа с надписью на 2..6 секунде. С вжиганием: кадры на 1 и 7 секундах чистые, на 3 и 5 — с надписью, предупреждение назвало 8 секунд из 15.5. Отдельной дорожкой: в файле три потока, третий ass с названием «Надписи», картинка чистая. Своя ошибка, найденная по дороге: установка галки кодом вызывает тот же обработчик, что и щелчок, и навязанное при MP4 значение записывалось как осознанный выбор — при возврате на MKV галка оставалась стоять. Окно хода сборки переименовано в «Ход сборки»: два окна с заголовком «Сборка ролика» путали и меня, и человека. --- src/uAppTypes.pas | 4 + src/uExport.pas | 9 +- src/uExportForm.pas | 286 ++++++++++++++++++++++++++++++++++++++++++++ src/uFfmpegCmd.pas | 68 +++++++++-- src/uMainForm.pas | 78 +++++++----- src/uSubtitles.pas | 122 ++++++++++++++++--- 6 files changed, 506 insertions(+), 61 deletions(-) create mode 100644 src/uExportForm.pas diff --git a/src/uAppTypes.pas b/src/uAppTypes.pas index feef1dd..4a96065 100644 --- a/src/uAppTypes.pas +++ b/src/uAppTypes.pas @@ -84,6 +84,10 @@ type { Готовая цепочка фильтров ffmpeg: как кадр этого исходника ложится в кадр проекта. Считается один раз при уплощении. } Filter: string; + { Разметка субтитров для этого куска: времена уже сдвинуты к его + началу. Пусто — текста здесь нет. Заполняется только при сборке с + вжиганием. } + SubFile: string; { Слои наложения. Пусто — обычный кусок с одним источником, который можно скопировать. Непусто — участок придётся собрать заново. diff --git a/src/uExport.pas b/src/uExport.pas index 6a20665..88ac49f 100644 --- a/src/uExport.pas +++ b/src/uExport.pas @@ -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 diff --git a/src/uExportForm.pas b/src/uExportForm.pas new file mode 100644 index 0000000..01cf3bb --- /dev/null +++ b/src/uExportForm.pas @@ -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. diff --git a/src/uFfmpegCmd.pas b/src/uFfmpegCmd.pas index a8c441c..2e9da67 100644 --- a/src/uFfmpegCmd.pas +++ b/src/uFfmpegCmd.pas @@ -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)]); diff --git a/src/uMainForm.pas b/src/uMainForm.pas index ead47b0..ce085b0 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -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; diff --git a/src/uSubtitles.pas b/src/uSubtitles.pas index 57dd183..5b74bdf 100644 --- a/src/uSubtitles.pas +++ b/src/uSubtitles.pas @@ -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.