From acb921d5f7c346a543b7ca13eda3ac05b6275777 Mon Sep 17 00:00:00 2001 From: 4aiman Date: Mon, 31 Aug 2026 00:10:28 +0300 Subject: [PATCH] =?UTF-8?q?=D0=A6=D0=B2=D0=B5=D1=82=D0=BE=D0=B2=D0=BE?= =?UTF-8?q?=D0=B9=20=D0=BA=D0=BB=D1=8E=D1=87=20=D0=B8=20=D0=B6=D0=B8=D0=B2?= =?UTF-8?q?=D0=BE=D0=B5=20=D0=BD=D0=B0=D0=BB=D0=BE=D0=B6=D0=B5=D0=BD=D0=B8?= =?UTF-8?q?=D0=B5=20=D0=B2=20=D0=BF=D1=80=D0=B5=D0=B4=D0=BF=D1=80=D0=BE?= =?UTF-8?q?=D1=81=D0=BC=D0=BE=D1=82=D1=80=D0=B5?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Клипу задаётся цвет, который при сборке становится прозрачным. Окно ключа показывает кадр: цвет берётся щелчком по нему, выбитое показано клеткой, допуск и смягчение края — ползунками. Открывается из окна кадрирования и из меню «Правка», на монтаже клип помечен квадратиком выбиваемого цвета. Предпросмотр перестал сводить такие участки в файлы. Плеер играет две дорожки одна поверх другой: оверлей во весь ролик больше не заставляет пересобирать весь фильм после каждой правки. Замерено: наложение стоит 0.4 с на 10 с материала 2688x1512, вчетверо быстрее реального времени. Починено в сборке: уменьшенный клип обкладывался чёрными полями, и они закрывали собой нижнее видео — оставалась видна только дырка, выбитая ключом. Теперь верхний слой кладётся по координатам, тем же, по которым его показывает предпросмотр. Смещение по горизонтали и вертикали работает и там, где картинка меньше кадра проекта: раньше уменьшенный клип нельзя было сдвинуть в угол. Проверки форм теперь создают каждое окно из файла формы: элемент, забытый в классе, вскрывается на сборке, а не при открытии окна. --- BACKLOG.md | 28 ++- build.sh | 4 + src/uAppTypes.pas | 35 +++- src/uColorKeyForm.pas | 397 ++++++++++++++++++++++++++++++++++++ src/uFfmpegCmd.pas | 56 ++++- src/uFlatten.pas | 235 ++++++++++++++++++++- src/uMainForm.pas | 165 ++++++++++++++- src/uMpvPlayer.pas | 219 ++++++++++++++++++-- src/uPanCropForm.lfm | 9 + src/uPanCropForm.pas | 60 +++++- src/uProject.pas | 67 ++++++ src/uTimelineCtrl.pas | 12 ++ src/uTransform.pas | 71 ++++++- tests/lfmcheck/lfmcheck.lpr | 48 ++++- tests/nlvetool.lpr | 109 +++++++++- 15 files changed, 1449 insertions(+), 66 deletions(-) create mode 100644 src/uColorKeyForm.pas diff --git a/BACKLOG.md b/BACKLOG.md index 1661ee8..ef3652d 100644 --- a/BACKLOG.md +++ b/BACKLOG.md @@ -54,14 +54,38 @@ GPL-3+ или совместимой. ffmpeg проблемой не является: он запускается отдельной программой. +## Настоящая прозрачность в исходном файле + +Цветовой ключ выбивает цвет, но бывает и прозрачность, записанная в самом +файле: WebM с VP8/VP9, ProRes 4444, QuickTime Animation. ffmpeg их +распаковывает в кадр с альфа-каналом, и ключ таким файлам не нужен — +достаточно не выбрасывать альфу по дороге. + +Что для этого потребуется, когда дойдут руки: + +- при добавлении файла запоминать, есть ли у него альфа (`pix_fmt` с + буквой «a»: yuva420p, yuva444p10le, argb); +- такой клип считать несплошным так же, как клип с ключом, — то есть + собирать участок слоями; +- в цепочке фильтров следить, чтобы альфа не терялась: `scale` её + сохраняет, а `pad` — только с прозрачным цветом полей; +- аппаратное декодирование к таким файлам не применять: альфа в VP9 + лежит отдельным потоком, и видеокарта его не отдаёт. + +Чего не будет в любом случае: раздать готовый ролик с прозрачностью в +MP4/H.264 нельзя — контейнер и кодек альфу не хранят. Для этого нужен +отдельный вывод в VP9 или ProRes 4444. + ## Мелочи, до которых не дошли руки **Значок файла программы под Windows.** Значок окна задаётся из `uIconData`, а значок самого `.exe` в проводнике берётся из ресурса при сборке — там он до сих пор стандартный. -**Кэш наложений не убирается.** Каждая правка прозрачности создаёт в -кэше проекта новый файл; старые остаются лежать. +**Кэш наложений не убирается.** Каждая правка наплыва создаёт в кэше +проекта новый файл; старые остаются лежать. Клипы с ключом и +прозрачностью сюда больше не попадают — их показывает сам плеер, — так +что расти кэшу теперь почти не с чего. **Окно кадрирования открывается около четырёх секунд.** Оно синхронно достаёт два кадра ffmpeg-ом (по 2.2 с каждый на шестигигабайтном файле) и diff --git a/build.sh b/build.sh index d64f1f7..2c2d87d 100755 --- a/build.sh +++ b/build.sh @@ -177,6 +177,10 @@ run_tests() { else status=1 fi + # Окно зависимостей при создании записывает рядом с собой список + # пакетов по умолчанию. Проверке это не мешает, а в дереве исходников + # такому файлу не место. + rm -f "$HERE/tests/lfmcheck/deps-linux.json" else echo "не собралось" >&2 status=1 diff --git a/src/uAppTypes.pas b/src/uAppTypes.pas index 4a96065..f1cbd9f 100644 --- a/src/uAppTypes.pas +++ b/src/uAppTypes.pas @@ -45,10 +45,25 @@ type TSegmentLayer = record FilePath: string; SrcStart: Double; - { Цепочка кадрирования этого слоя. } + { Цепочка кадрирования этого слоя: с полями до кадра проекта. Годится + там, где слой сам по себе занимает весь кадр. } Filter: string; + { Та же цепочка без полей и место, куда слой встаёт в кадре. + + Верхний слой полями обкладывать нельзя: поле чёрное и непрозрачное, + и уменьшенный клип закрывал бы им всё нижнее видео вместо того, + чтобы лечь в свой угол. } + FitFilter: string; + X: Integer; + Y: Integer; { Постоянная непрозрачность слоя. } Opacity: Double; + { Цветовой ключ слоя: этот цвет становится прозрачным. Ключ выключен, + если KeyEnabled равно False. } + KeyEnabled: Boolean; + KeyColor: TRgb; + KeySimilarity: Integer; + KeyBlend: Integer; { Переход: непрозрачность меняется от начала куска к концу. Если оба значения равны Opacity, перехода нет. } FadeFrom: Double; @@ -57,6 +72,24 @@ type TSegmentLayers = array of TSegmentLayer; + { Окно наложения для плеера: когда, куда и каким фильтром класть + оверлей поверх основы. + + Живёт в базовых типах, а не в уплощении, потому что плеер про + уплощение знать не должен: ему отдают готовое описание. } + TOverlayWindow = record + TlStart: Double; + TlEnd: Double; + { Цепочка фильтров для самого оверлея: размер, поворот. Без полей — + поля закрыли бы нижнее видео. } + Filter: string; + X: Integer; + Y: Integer; + Width: Integer; + Height: Integer; + end; + TOverlayWindows = array of TOverlayWindow; + TFlatSegment = record FilePath: string; SrcStart: Double; diff --git a/src/uColorKeyForm.pas b/src/uColorKeyForm.pas new file mode 100644 index 0000000..ae2de3e --- /dev/null +++ b/src/uColorKeyForm.pas @@ -0,0 +1,397 @@ +{ + uColorKeyForm — окно цветового ключа. + + Цветовой ключ выбивает из клипа один цвет: всё, что достаточно на него + похоже, становится прозрачным, и сквозь клип видно то, что лежит под + ним. Так работает «зелёный экран» в кино, только цвет выбираем мы. + + Главное в этом окне — не поля, а картинка. Цвет берут щелчком прямо по + кадру: назвать пурпурный числом человек не сможет, а ткнуть в него + мышью — сможет. Выбитое показывается клеткой, как в редакторах + изображений: клетка видна там, где будет видно нижний клип. + + Порог считается тем же способом, что и в ffmpeg: расстояние между + цветом точки и заданным цветом в пространстве RGB, поделённое на + наибольшее возможное. Иначе картинка в окне обещала бы одно, а сборка + давала другое. +} +unit uColorKeyForm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Controls, Forms, Graphics, StdCtrls, Dialogs, ExtCtrls, + ComCtrls, uAppTypes, uProject, uTheme; + +{ Показывает окно. True — человек нажал «Готово», и в AKey лежит + изменённое. + + APath — файл клипа, ATime — время внутри файла, откуда брать кадр для + показа. } +function EditColorKey(var AKey: TColorKey; const APath: string; + const ATime: Double; const ATempFile: string): Boolean; + +implementation + +uses + Math, FPimage, IntfGraphics, uFfmpegCmd, uProcRunner; + +const + { Клетка под выбитым: две краски и размер квадратика. } + ColorCheckA = TColor($4A4A4A); + ColorCheckB = TColor($5E5E5E); + CheckSize = 8; + +type + TColorKeyDialog = class(TComponent) + public + Form: TForm; + pbFrame: TPaintBox; + cbOn: TCheckBox; + BtnColor: TThemedButton; + tbSimilar: TTrackBar; + tbBlend: TTrackBar; + lblSimilar: TLabel; + lblBlend: TLabel; + lblHint: TLabel; + Key: TColorKey; + { Кадр как он есть и кадр с уже выбитым цветом. Первый нужен, чтобы + брать из него цвет по щелчку: во втором выбитое уже заменено + клеткой, и попасть по исходному цвету было бы нельзя. } + Source: TBitmap; + Shown: TBitmap; + procedure AnyChange(Sender: TObject); + procedure ColorClick(Sender: TObject); + procedure FramePaint(Sender: TObject); + procedure FrameMouseDown(Sender: TObject; AButton: TMouseButton; + AShift: TShiftState; AX, AY: Integer); + { Прямоугольник, в который вписан кадр. } + function FrameRect: TRect; + procedure Rebuild; + procedure UpdateLabels; + end; + +{ Насколько точка отличается от заданного цвета: 0 — тот же цвет, 1 — + наибольшее возможное расхождение. Повторяет расчёт фильтра colorkey. } +function ColorDistance(AR, AG, AB: Integer; AKey: TRgb): Double; +var + DR, DG, DB: Integer; +begin + DR := AR - (AKey and $FF); + DG := AG - ((AKey shr 8) and $FF); + DB := AB - ((AKey shr 16) and $FF); + Result := Sqrt((DR * DR + DG * DG + DB * DB) / (255.0 * 255.0 * 3.0)); +end; + +{ Прозрачность точки после ключа: 0 — выбита совсем, 1 — осталась. } +function KeyAlpha(const ADist, ASimilar, ABlend: Double): Double; +begin + if ABlend > 0.0001 then + Result := Max(0, Min(1, (ADist - ASimilar) / ABlend)) + else if ADist > ASimilar then + Result := 1 + else + Result := 0; +end; + +{ Кадр с выбитым цветом: где выбито — клетка, где нет — исходная точка, + а на смягчённом крае они смешаны. + + Точки берутся через промежуточное изображение, а не через Canvas.Pixels: + каждое обращение к Pixels под gtk2 идёт через оконную систему, и на + кадре в четверть миллиона точек окно бы просто встало. } +procedure ApplyKey(ASrc, ADst: TBitmap; const AKey: TColorKey); +var + Img: TLazIntfImage; + X, Y, R, G, B: Integer; + A, Similar, Blend: Double; + C: TFPColor; + Check: TColor; +begin + Similar := AKey.Similarity / 100; + Blend := AKey.Blend / 100; + Img := ASrc.CreateIntfImage; + try + if AKey.Enabled then + for Y := 0 to Img.Height - 1 do + for X := 0 to Img.Width - 1 do + begin + C := Img.Colors[X, Y]; + R := C.Red shr 8; + G := C.Green shr 8; + B := C.Blue shr 8; + A := KeyAlpha(ColorDistance(R, G, B, AKey.Color), Similar, Blend); + if A >= 0.999 then + Continue; + + if ((X div CheckSize) + (Y div CheckSize)) and 1 = 0 then + Check := ColorCheckA + else + Check := ColorCheckB; + C.Red := Round(R * A + (Check and $FF) * (1 - A)) * 257; + C.Green := Round(G * A + ((Check shr 8) and $FF) * (1 - A)) * 257; + C.Blue := Round(B * A + ((Check shr 16) and $FF) * (1 - A)) * 257; + Img.Colors[X, Y] := C; + end; + ADst.LoadFromIntfImage(Img); + finally + Img.Free; + end; +end; + +function TColorKeyDialog.FrameRect: TRect; +var + W, H: Integer; + Scale: Double; +begin + Result := Rect(0, 0, 0, 0); + if (Source = nil) or (Source.Width = 0) or (Source.Height = 0) then + Exit; + Scale := Min(pbFrame.Width / Source.Width, pbFrame.Height / Source.Height); + W := Max(1, Round(Source.Width * Scale)); + H := Max(1, Round(Source.Height * Scale)); + Result := Bounds((pbFrame.Width - W) div 2, (pbFrame.Height - H) div 2, W, H); +end; + +procedure TColorKeyDialog.FramePaint(Sender: TObject); +var + R: TRect; +begin + pbFrame.Canvas.Brush.Color := ThemeSurface; + pbFrame.Canvas.FillRect(0, 0, pbFrame.Width, pbFrame.Height); + if Shown = nil then + begin + pbFrame.Canvas.Font.Color := ThemeText; + pbFrame.Canvas.TextOut(8, 8, 'Кадр получить не удалось'); + Exit; + end; + R := FrameRect; + pbFrame.Canvas.StretchDraw(R, Shown); +end; + +procedure TColorKeyDialog.FrameMouseDown(Sender: TObject; + AButton: TMouseButton; AShift: TShiftState; AX, AY: Integer); +var + R: TRect; + SX, SY: Integer; +begin + if Source = nil then + Exit; + R := FrameRect; + if (AX < R.Left) or (AX >= R.Right) or (AY < R.Top) or (AY >= R.Bottom) then + Exit; + + SX := Round((AX - R.Left) / (R.Right - R.Left) * Source.Width); + SY := Round((AY - R.Top) / (R.Bottom - R.Top) * Source.Height); + SX := Max(0, Min(Source.Width - 1, SX)); + SY := Max(0, Min(Source.Height - 1, SY)); + + Key.Color := TRgb(Source.Canvas.Pixels[SX, SY]); + BtnColor.Swatch := TColor(Key.Color); + { Ткнули в цвет — значит, его и хотят выбить. Требовать после этого + отдельно поставить галку было бы издевательством. } + if not cbOn.Checked then + cbOn.Checked := True; + Rebuild; +end; + +procedure TColorKeyDialog.ColorClick(Sender: TObject); +var + Dlg: TColorDialog; +begin + Dlg := TColorDialog.Create(nil); + try + Dlg.Color := TColor(Key.Color); + if not Dlg.Execute then + Exit; + Key.Color := TRgb(Dlg.Color); + BtnColor.Swatch := Dlg.Color; + Rebuild; + finally + Dlg.Free; + end; +end; + +procedure TColorKeyDialog.UpdateLabels; +begin + lblSimilar.Caption := Format('Допуск: %d%%', [tbSimilar.Position]); + lblBlend.Caption := Format('Смягчение края: %d%%', [tbBlend.Position]); +end; + +procedure TColorKeyDialog.AnyChange(Sender: TObject); +begin + Key.Enabled := cbOn.Checked; + Key.Similarity := tbSimilar.Position; + Key.Blend := tbBlend.Position; + UpdateLabels; + Rebuild; +end; + +procedure TColorKeyDialog.Rebuild; +begin + if Source = nil then + Exit; + if Shown = nil then + Shown := TBitmap.Create; + ApplyKey(Source, Shown, Key); + pbFrame.Invalidate; +end; + +{ Кадр из середины куска. Первый кадр часто чёрный, и выбирать по нему + цвет не по чему. } +function GrabFrame(const APath: string; const ATime: Double; + const ATempFile: string): TBitmap; +var + Res: TProcResult; + Png: TPortableNetworkGraphic; +begin + Result := nil; + if APath = '' then + Exit; + Res := RunProcess(FfmpegExe, + ArgsPreviewFrame(APath, ATempFile, ATime, ''), nil, nil, nil); + if (not Res.Started) or (Res.ExitCode <> 0) or (not FileExists(ATempFile)) then + Exit; + + Png := TPortableNetworkGraphic.Create; + try + try + Png.LoadFromFile(ATempFile); + Result := TBitmap.Create; + { Формат точек не трогаем. Присвоение ему пересоздаёт хранилище + картинки, и только что положенный кадр пропадает — окно + показывало ровный чёрный прямоугольник вместо кадра. } + Result.Assign(Png); + except + FreeAndNil(Result); + end; + finally + Png.Free; + end; + SysUtils.DeleteFile(ATempFile); +end; + +function EditColorKey(var AKey: TColorKey; const APath: string; + const ATime: Double; const ATempFile: string): Boolean; +var + Dlg: TColorKeyDialog; + BtnOk, BtnCancel: TThemedButton; + Lbl: TLabel; +begin + Result := False; + Dlg := TColorKeyDialog.Create(nil); + try + Dlg.Key := AKey; + Dlg.Source := GrabFrame(APath, ATime, ATempFile); + + Dlg.Form := TForm.CreateNew(nil); + Dlg.Form.Caption := 'Цветовой ключ'; + Dlg.Form.Position := poScreenCenter; + Dlg.Form.ClientWidth := 760; + Dlg.Form.ClientHeight := 560; + + Dlg.pbFrame := TPaintBox.Create(Dlg.Form); + Dlg.pbFrame.Parent := Dlg.Form; + Dlg.pbFrame.SetBounds(12, 12, 736, 360); + Dlg.pbFrame.Anchors := [akLeft, akTop, akRight, akBottom]; + Dlg.pbFrame.OnPaint := @Dlg.FramePaint; + Dlg.pbFrame.OnMouseDown := @Dlg.FrameMouseDown; + + Lbl := TLabel.Create(Dlg.Form); + Lbl.Parent := Dlg.Form; + Lbl.SetBounds(12, 380, 736, 20); + Lbl.Anchors := [akLeft, akRight, akBottom]; + Lbl.Caption := 'Щёлкните по кадру, чтобы взять цвет. Клетка — то, ' + + 'что станет прозрачным.'; + + Dlg.cbOn := TCheckBox.Create(Dlg.Form); + Dlg.cbOn.Parent := Dlg.Form; + Dlg.cbOn.SetBounds(12, 408, 220, 22); + Dlg.cbOn.Anchors := [akLeft, akBottom]; + Dlg.cbOn.Caption := 'Выбивать цвет'; + Dlg.cbOn.Checked := AKey.Enabled; + Dlg.cbOn.OnClick := @Dlg.AnyChange; + + Dlg.BtnColor := TThemedButton.Create(Dlg.Form); + Dlg.BtnColor.Parent := Dlg.Form; + Dlg.BtnColor.SetBounds(240, 404, 120, 28); + Dlg.BtnColor.Anchors := [akLeft, akBottom]; + Dlg.BtnColor.Caption := 'Цвет'; + Dlg.BtnColor.Swatch := TColor(AKey.Color); + Dlg.BtnColor.OnClick := @Dlg.ColorClick; + + Dlg.lblSimilar := TLabel.Create(Dlg.Form); + Dlg.lblSimilar.Parent := Dlg.Form; + Dlg.lblSimilar.SetBounds(12, 442, 200, 20); + Dlg.lblSimilar.Anchors := [akLeft, akBottom]; + + Dlg.tbSimilar := TTrackBar.Create(Dlg.Form); + Dlg.tbSimilar.Parent := Dlg.Form; + Dlg.tbSimilar.SetBounds(210, 438, 538, 30); + Dlg.tbSimilar.Anchors := [akLeft, akRight, akBottom]; + Dlg.tbSimilar.Min := 1; + Dlg.tbSimilar.Max := 60; + Dlg.tbSimilar.TickStyle := tsNone; + Dlg.tbSimilar.Position := Max(1, Min(60, AKey.Similarity)); + Dlg.tbSimilar.OnChange := @Dlg.AnyChange; + + Dlg.lblBlend := TLabel.Create(Dlg.Form); + Dlg.lblBlend.Parent := Dlg.Form; + Dlg.lblBlend.SetBounds(12, 478, 200, 20); + Dlg.lblBlend.Anchors := [akLeft, akBottom]; + + Dlg.tbBlend := TTrackBar.Create(Dlg.Form); + Dlg.tbBlend.Parent := Dlg.Form; + Dlg.tbBlend.SetBounds(210, 474, 538, 30); + Dlg.tbBlend.Anchors := [akLeft, akRight, akBottom]; + Dlg.tbBlend.Min := 0; + Dlg.tbBlend.Max := 40; + Dlg.tbBlend.TickStyle := tsNone; + Dlg.tbBlend.Position := Max(0, Min(40, AKey.Blend)); + Dlg.tbBlend.OnChange := @Dlg.AnyChange; + + Dlg.lblHint := TLabel.Create(Dlg.Form); + Dlg.lblHint.Parent := Dlg.Form; + Dlg.lblHint.SetBounds(12, 512, 480, 36); + Dlg.lblHint.Anchors := [akLeft, akRight, akBottom]; + Dlg.lblHint.AutoSize := False; + Dlg.lblHint.WordWrap := True; + Dlg.lblHint.Caption := 'Участки с ключом придётся пересобрать: ' + + 'копированием прозрачность не делается.'; + + BtnOk := TThemedButton.Create(Dlg.Form); + BtnOk.Parent := Dlg.Form; + BtnOk.SetBounds(540, 518, 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(648, 518, 100, 30); + BtnCancel.Anchors := [akRight, akBottom]; + BtnCancel.Caption := 'Отмена'; + BtnCancel.ModalResult := mrCancel; + BtnCancel.Cancel := True; + + ApplyDarkTheme(Dlg.Form); + Dlg.UpdateLabels; + Dlg.Rebuild; + + if Dlg.Form.ShowModal <> mrOk then + Exit; + + AKey := Dlg.Key; + Result := True; + finally + Dlg.Source.Free; + Dlg.Shown.Free; + Dlg.Form.Free; + Dlg.Free; + end; +end; + +end. diff --git a/src/uFfmpegCmd.pas b/src/uFfmpegCmd.pas index 2e9da67..c902428 100644 --- a/src/uFfmpegCmd.pas +++ b/src/uFfmpegCmd.pas @@ -282,7 +282,7 @@ function ArgsRenderLayers(const ALayers: array of TSegmentLayer; const APixFmt, ACodec: string; AIsTs: Boolean): TArgs; var I: Integer; - Graph, Fit: string; + Graph, Fit, Src: string; Crossfade: Boolean; begin Result := ['-hide_banner', '-nostdin', '-loglevel', 'warning', '-y']; @@ -302,30 +302,66 @@ begin Graph := ''; for I := 0 to High(ALayers) do begin - Fit := ALayers[I].Filter; + { Нижний слой — холст, он занимает весь кадр, и поля ему нужны. + Верхнему поля вредны: чёрное поле непрозрачно и закрыло бы холст, + поэтому верхний кладётся на своё место как есть. Переход — случай + особый: xfade смешивает два кадра целиком, и оба должны быть в + размер проекта. } + if (I > 0) and (not Crossfade) and (ALayers[I].FitFilter <> '') then + Fit := ALayers[I].FitFilter + else + Fit := ALayers[I].Filter; if Fit = '' then Fit := Format('scale=%d:%d,setsar=1', [AWidth, AHeight]); + { Цветовой ключ ставится после вписывания и до наложения: он должен + работать по кадру проекта, иначе смягчение края разъедется вместе с + масштабом. Цвет записывается как 0xRRGGBB — порядок обратный тому, + в каком он хранится у нас. } + if ALayers[I].KeyEnabled then + Fit := Fit + Format(',colorkey=0x%.2x%.2x%.2x:%s:%s', + [ALayers[I].KeyColor and $FF, + (ALayers[I].KeyColor shr 8) and $FF, + (ALayers[I].KeyColor shr 16) and $FF, + SecondsToStr(ALayers[I].KeySimilarity / 100), + SecondsToStr(ALayers[I].KeyBlend / 100)]); Graph := Graph + Format('[%d:v]%s,format=yuva420p[v%d];', [I, Fit, I]); end; if Length(ALayers) = 1 then begin + Src := 'v0'; + { Ключ без нижнего слоя: выбитое надо чем-то заполнить, иначе при + переводе в кадр без прозрачности вернётся исходный цвет — тот + самый, который выбивали. Кладём на чёрное поле. } + if ALayers[0].KeyEnabled then + begin + Graph := Graph + Format('color=c=black:s=%dx%d:r=%d/%d:d=%s[bg];' + + '[bg][v0]overlay=0:0[k0];', + [AWidth, AHeight, AFpsNum, AFpsDen, SecondsToStr(ADuration)]); + Src := 'k0'; + end; + if Abs(ALayers[0].FadeTo - ALayers[0].FadeFrom) < 0.001 then + Graph := Graph + Format('[%s]null[out]', [Src]) { Один слой с меняющейся долей — это затухание в чёрное или из него. } - if ALayers[0].FadeTo >= ALayers[0].FadeFrom then - Graph := Graph + Format('[v0]fade=t=in:st=0:d=%s:alpha=0[out]', - [SecondsToStr(ADuration)]) + else if ALayers[0].FadeTo >= ALayers[0].FadeFrom then + Graph := Graph + Format('[%s]fade=t=in:st=0:d=%s:alpha=0[out]', + [Src, SecondsToStr(ADuration)]) else - Graph := Graph + Format('[v0]fade=t=out:st=0:d=%s:alpha=0[out]', - [SecondsToStr(ADuration)]); + Graph := Graph + Format('[%s]fade=t=out:st=0:d=%s:alpha=0[out]', + [Src, SecondsToStr(ADuration)]); end else if Crossfade then Graph := Graph + Format('[v0][v1]xfade=transition=fade:duration=%s:offset=0[out]', [SecondsToStr(ADuration)]) else begin - { Верхний слой приглушается по альфа-каналу и кладётся на нижний. } - Graph := Graph + Format('[v1]colorchannelmixer=aa=%s[t];[v0][t]overlay=0:0[out]', - [SecondsToStr(ALayers[High(ALayers)].Opacity)]); + { Верхний слой приглушается по альфа-каналу и кладётся на нижний — + на своё место в кадре, теми же координатами, по которым его + показывает предпросмотр. } + Graph := Graph + Format('[v1]colorchannelmixer=aa=%s[t];' + + '[v0][t]overlay=%d:%d[out]', + [SecondsToStr(ALayers[High(ALayers)].Opacity), + ALayers[High(ALayers)].X, ALayers[High(ALayers)].Y]); end; { Кодировщик выбирается предпочтительный, а не тот, что ffmpeg возьмёт diff --git a/src/uFlatten.pas b/src/uFlatten.pas index 541d0a3..8386ef6 100644 --- a/src/uFlatten.pas +++ b/src/uFlatten.pas @@ -38,6 +38,25 @@ uses Classes, SysUtils, uAppTypes, uProject, uMediaProbe, uTransform; type + { Клип, который в предпросмотре кладётся поверх основы. + + Место в кадре — то же самое, по чему сборка обкладывает картинку + полями: считается одним кодом (см. OverlayFilter). } + TPreviewOverlay = record + TlStart: Double; + TlEnd: Double; + FilePath: string; + SrcStart: Double; + { Цепочка фильтров для плеера: без полей, только приведение к нужному + размеру и повороту. } + Filter: string; + X: Integer; + Y: Integer; + Width: Integer; + Height: Integer; + end; + TPreviewOverlays = array of TPreviewOverlay; + { Что нужно создать, чтобы кусок стал воспроизводимым файлом. } { gkSilence — вставка тишины без картинки, только для звуковых дорожек. @@ -87,7 +106,8 @@ type Недостающее заполняется чёрным и тишиной. } function FlattenStream(AProject: TProject; AKind: TTrackKind; const AMinLength: Double; - out ASegments: TFlatSegmentArray; out AMissing: TGenRequests): Boolean; + out ASegments: TFlatSegmentArray; out AMissing: TGenRequests; + AHidden: TFPList = nil): Boolean; { Уплощение одной звуковой дорожки — для предпросмотра. @@ -107,6 +127,25 @@ function FlattenProject(AProject: TProject; out AVideo, AAudio: TFlatSegmentArray; out AMissing: TGenRequests): Boolean; +{ То же для предпросмотра, но клипы, которые кладутся поверх, вынесены + отдельно. + + Зачем. Клип с ключом или прозрачностью не сплошной, и в готовом ролике + участок под ним приходится сводить. Оверлей во весь ролик — компас или + карта поверх всего материала — заставил бы сводить весь фильм на каждую + правку, ради картинки, которую всё равно надо перепроверять сборкой. + + Плееру сводить не нужно: он умеет играть две дорожки одна поверх + другой. Поэтому такие клипы здесь не участвуют в отборе победителя — + под ними видно то, что лежит ниже, — а выдаются отдельным списком со + временем и местом в кадре. + + Для сборки ролика это не применяется: там всё сводится по-настоящему. } +function FlattenPreview(AProject: TProject; + out AVideo, AAudio: TFlatSegmentArray; + out AOverlays: TPreviewOverlays; + out AMissing: TGenRequests): Boolean; + { Путь к сгенерированному клипу. Имя выводится из содержимого запроса, поэтому одинаковые запросы дают один и тот же файл, и он делается один раз. } @@ -224,6 +263,12 @@ begin '*' + SecondsToStr(ALayers[I].Opacity) + '>' + SecondsToStr(ALayers[I].FadeFrom) + '<' + SecondsToStr(ALayers[I].FadeTo); + { Ключ входит в имя готового файла: иначе после правки цвета или + допуска подставился бы прежний, сведённый по старым числам. } + if ALayers[I].KeyEnabled then + Result := Result + Format('~%.6x/%d/%d', + [ALayers[I].KeyColor and $FFFFFF, + ALayers[I].KeySimilarity, ALayers[I].KeyBlend]); end; procedure ResolveLayers(AProject: TProject; var ASegments: TFlatSegmentArray; @@ -347,9 +392,13 @@ begin end; end; +{ AHidden — клипы, которых для этого прохода как бы нет. Через них видно + то, что лежит ниже. Нужны предпросмотру: клип, который плеер положит + поверх сам, не должен ничего закрывать в основе. } function FlattenStream(AProject: TProject; AKind: TTrackKind; const AMinLength: Double; - out ASegments: TFlatSegmentArray; out AMissing: TGenRequests): Boolean; + out ASegments: TFlatSegmentArray; out AMissing: TGenRequests; + AHidden: TFPList = nil): Boolean; var Bounds: array of Double; BoundCount: Integer; @@ -372,6 +421,7 @@ var const AFrom, ATo: Double): TSegmentLayer; var It: TMediaItem; + W, H: Integer; begin Result := Default(TSegmentLayer); Result.FadeFrom := AFrom; @@ -382,9 +432,17 @@ var Exit; Result.FilePath := It.EffectivePath; Result.SrcStart := AClip.SrcIn + (AAt - AClip.TlStart); + Result.KeyEnabled := AClip.ColorKey.Enabled; + Result.KeyColor := AClip.ColorKey.Color; + Result.KeySimilarity := AClip.ColorKey.Similarity; + Result.KeyBlend := AClip.ColorKey.Blend; Result.Filter := TransformFilter(AClip.Transform, It.Info.Width, It.Info.Height, AProject.Master.Width, AProject.Master.Height); + Result.FitFilter := OverlayFilter(AClip.Transform, + It.Info.Width, It.Info.Height, + AProject.Master.Width, AProject.Master.Height, + Result.X, Result.Y, W, H); if Result.Filter = '' then Result.Filter := PreviewFitFilter(AProject.Master.Width, AProject.Master.Height); @@ -454,6 +512,26 @@ var ASeg.Layers := nil; end; + function IsHidden(AClip: TClip): Boolean; + begin + Result := (AHidden <> nil) and (AHidden.IndexOf(AClip) >= 0); + end; + + { Клип дорожки в этот момент, не считая спрятанных. } + function VisibleClipAt(ATrack: TTrack; const ATime: Double): TClip; + var + C: Integer; + Cl: TClip; + begin + Result := nil; + for C := 0 to ATrack.Count - 1 do + begin + Cl := ATrack[C]; + if Cl.Covers(ATime) and (not IsHidden(Cl)) then + Exit(Cl); + end; + end; + { Клип, побеждающий в указанный момент: с самой верхней дорожки. } function WinnerAt(const ATime: Double): TClip; var @@ -469,7 +547,7 @@ var то и все несолирующие. } if not AProject.TrackAudible(AProject.Tracks[Ti]) then Continue; - Cl := AProject.Tracks[Ti].ClipAt(ATime); + Cl := VisibleClipAt(AProject.Tracks[Ti], ATime); if Cl <> nil then Exit(Cl); end; @@ -505,7 +583,7 @@ var for C := 0 to Track.Count - 1 do begin Cl := Track[C]; - if (Cl <> AClip) and Cl.Covers(ATime) then + if (Cl <> AClip) and Cl.Covers(ATime) and (not IsHidden(Cl)) then Exit(Cl); end; end; @@ -526,7 +604,7 @@ var Continue; if not AProject.TrackAudible(AProject.Tracks[Ti]) then Continue; - Cl := AProject.Tracks[Ti].ClipAt(ATime); + Cl := VisibleClipAt(AProject.Tracks[Ti], ATime); if Cl <> nil then Exit(Cl); end; @@ -684,13 +762,24 @@ begin Partner := OverlapPartner(Winner, Mid); Under := nil; - if (Partner = nil) and (Winner.Opacity < 0.999) then + { Ключ работает так же, как полупрозрачность: клип перестаёт быть + сплошным, и участок приходится собирать вместе с тем, что под + ним. } + if (Partner = nil) and + ((Winner.Opacity < 0.999) or Winner.ColorKey.Enabled) then Under := BelowAt(Winner, Mid); { Ручное затухание: кусок попал в зону появления или ухода. Слой один, но с меняющейся долей — дальше это обрабатывается тем же путём, что и переход между двумя клипами. } - if (Partner = nil) and (Under = nil) then + if (Partner = nil) and (Under = nil) and Winner.ColorKey.Enabled then + begin + { Ключ есть, а класть не на что — всё равно пересобираем. } + SetLength(Seg.Layers, 1); + Seg.Layers[0] := LayerOf(Winner, SegStart, 1, 1); + Seg.Transcode := True; + end + else if (Partner = nil) and (Under = nil) then begin if (Winner.FadeIn > 0) and (SegEnd <= Winner.TlStart + Winner.FadeIn + 0.0005) then begin @@ -741,12 +830,20 @@ begin Seg.Layers[1] := LayerOf(Partner, SegStart, 0, 1); end; end - else + else if Under <> nil then begin - { Полупрозрачный клип поверх нижнего. } + { Полупрозрачный клип или клип с ключом поверх нижнего. } Seg.Layers[0] := LayerOf(Under, SegStart, 1, 1); Seg.Layers[1] := LayerOf(Winner, SegStart, Winner.Opacity, Winner.Opacity); + end + else + begin + { Под клипом ничего нет, но ключ всё равно надо применить: + вырезанное станет чёрным. } + SetLength(Seg.Layers, 1); + Seg.Layers[0] := LayerOf(Winner, SegStart, + Winner.Opacity, Winner.Opacity); end; { Собрать такой участок копированием нельзя. } Seg.Transcode := True; @@ -926,4 +1023,124 @@ begin end; end; +{ Клип кладётся поверх, а не побеждает целиком, если он не сплошной: + с выбитым цветом или полупрозрачный. } +function IsOverlayClip(AClip: TClip): Boolean; +begin + Result := (AClip <> nil) and (AClip.Kind in [ckVideo, ckImage]) and + (AClip.ColorKey.Enabled or (AClip.Opacity < 0.999)); +end; + +function FlattenPreview(AProject: TProject; + out AVideo, AAudio: TFlatSegmentArray; + out AOverlays: TPreviewOverlays; + out AMissing: TGenRequests): Boolean; +var + Hidden: TFPList; + MissA: TGenRequests; + T, C, I, N: Integer; + Track: TTrack; + Clip: TClip; + Item: TMediaItem; + Total: Double; + Ov: TPreviewOverlay; + + { Занято ли это время другим оверлеем. } + function OverlapsTaken(const AFrom, ATo: Double): Boolean; + var + K: Integer; + begin + Result := False; + for K := 0 to High(AOverlays) do + if (AFrom < AOverlays[K].TlEnd - 0.001) and + (ATo > AOverlays[K].TlStart + 0.001) then + Exit(True); + end; + +begin + AVideo := nil; + AAudio := nil; + AOverlays := nil; + AMissing := nil; + MissA := nil; + Result := False; + if AProject = nil then + Exit; + + Total := Max(AudibleEnd(AProject, tkVideo), AudibleEnd(AProject, tkAudio)); + if Total <= 0 then + Exit; + + Hidden := TFPList.Create; + try + N := 0; + for T := 0 to AProject.TrackCount - 1 do + begin + Track := AProject.Tracks[T]; + if Track.Kind <> tkVideo then + Continue; + if not AProject.TrackAudible(Track) then + Continue; + for C := 0 to Track.Count - 1 do + begin + Clip := Track[C]; + if not IsOverlayClip(Clip) then + Continue; + Item := AProject.FindMedia(Clip.MediaId); + if Item = nil then + Continue; + + { Оверлей играется одной дорожкой поверх основы, а одна дорожка + не может показывать два куска разом. Если такой клип наложился + на уже взятый, он остаётся в основе и сводится по-старому: + потерять его было бы хуже. } + if OverlapsTaken(Clip.TlStart, Clip.TlEnd) then + Continue; + + Hidden.Add(Clip); + + Ov := Default(TPreviewOverlay); + Ov.TlStart := Clip.TlStart; + Ov.TlEnd := Clip.TlEnd; + Ov.FilePath := Item.EffectivePath; + Ov.SrcStart := Clip.SrcIn; + Ov.Filter := OverlayFilter(Clip.Transform, + Item.Info.Width, Item.Info.Height, + AProject.Master.Width, AProject.Master.Height, + Ov.X, Ov.Y, Ov.Width, Ov.Height); + SetLength(AOverlays, N + 1); + AOverlays[N] := Ov; + Inc(N); + end; + end; + + { По времени: список кусков оверлея строится подряд, дырами между + ними. } + for I := 1 to High(AOverlays) do + begin + Ov := AOverlays[I]; + C := I - 1; + while (C >= 0) and (AOverlays[C].TlStart > Ov.TlStart) do + begin + AOverlays[C + 1] := AOverlays[C]; + Dec(C); + end; + AOverlays[C + 1] := Ov; + end; + + Result := FlattenStream(AProject, tkVideo, Total, AVideo, AMissing, Hidden); + if not Result then + Exit; + FlattenStream(AProject, tkAudio, Total, AAudio, MissA); + finally + Hidden.Free; + end; + + for I := 0 to High(MissA) do + begin + SetLength(AMissing, Length(AMissing) + 1); + AMissing[High(AMissing)] := MissA[I]; + end; +end; + end. diff --git a/src/uMainForm.pas b/src/uMainForm.pas index 3075bc6..a4c5be7 100644 --- a/src/uMainForm.pas +++ b/src/uMainForm.pas @@ -29,7 +29,8 @@ uses uRemuxForm, uMismatchForm, uFfmpegJob, uSettings, uThumbs, uTransform, uPanCropForm, uProjectInfoForm, ImgList, uTheme, uLogView, uDepsForm, uWaveform, - uIconData, uSubtitles, uTextMeasure, uTextForm, uExportForm; + uIconData, uSubtitles, uTextMeasure, uTextForm, uExportForm, + uColorKeyForm; const { Номера системных сообщений о перерисовке рамки окна. Берём числами, а @@ -93,6 +94,9 @@ type FUpdatingFromPlayer: Boolean; FLastLoadedEdl: string; FLastLoadedAudioEdl: string; + { Наложение для плеера: список кусков оверлея и окна показа. } + FPreviewOverlayUrl: string; + FPreviewOverlayWindows: TOverlayWindows; { Списки кусков звуковых дорожек для плеера. } FPreviewAudioUrls: array of string; { Звуковые дорожки предпросмотра — их номера в проекте, а не сами @@ -260,6 +264,8 @@ type procedure ApplyPreviewFrame; procedure RebuildPreview; procedure LoadPreviewEdl(const ASegments, AAudio: TFlatSegmentArray); + procedure BuildOverlayPreview(const AOverlays: TPreviewOverlays; + const ATotal: Double); procedure GenerateDone(Sender: TObject); procedure GenerateProgress(Sender: TObject); procedure GenerateLog(Sender: TObject); @@ -289,6 +295,7 @@ type procedure MenuSplit(Sender: TObject); procedure MenuSplitPrecise(Sender: TObject); procedure MenuDelete(Sender: TObject); + procedure MenuColorKey(Sender: TObject); procedure MenuSelectAll(Sender: TObject); procedure MenuRipple(Sender: TObject); procedure MenuToggleRipple(Sender: TObject); @@ -643,6 +650,7 @@ begin @MenuSplitPrecise, ShortCut(VK_S, [ssShift])); AddItem(MEdit, 'Удалить выделенное', @MenuDelete, ShortCut(VK_DELETE, [])); AddItem(MEdit, 'Выделить всё', @MenuSelectAll, ShortCut(VK_A, [ssCtrl])); + AddItem(MEdit, 'Цветовой ключ клипа...', @MenuColorKey); AddSep(MEdit); AddItem(MEdit, 'Схлопнуть дыру под курсором', @MenuRipple, ShortCut(VK_R, [ssCtrl, ssShift])); @@ -1850,6 +1858,7 @@ end; procedure TMainForm.RebuildPreview; var Segments, AudioSegs, TrackSegs: TFlatSegmentArray; + Overlays: TPreviewOverlays; Missing, TrackMissing: TGenRequests; I, J: Integer; TotalLen: Double; @@ -1865,14 +1874,20 @@ begin Exit; end; - if not FlattenProject(FProject, Segments, AudioSegs, Missing) then + { Уплощение для предпросмотра: клипы, которые кладутся поверх, идут + отдельно. Плеер положит их сам, ничего не собирая. } + if not FlattenPreview(FProject, Segments, AudioSegs, Overlays, Missing) then begin FPlayer.Stop; FLastLoadedEdl := ''; + FPreviewOverlayUrl := ''; + FPreviewOverlayWindows := nil; UpdateTimeLabel; Exit; end; + BuildOverlayPreview(Overlays, TotalDuration(Segments)); + { Текст поверх картинки рисует сам плеер: ему отдаётся файл разметки, а не пересобранный кусок. Поэтому правка текста видна сразу. } UpdateSubtitles; @@ -1930,6 +1945,71 @@ begin LoadPreviewEdl(Segments, AudioSegs); end; +{ Список кусков оверлея и окна его показа. + + Список должен покрывать монтаж от начала и без разрывов: плеер + выравнивает дорожки по времени, и дыра сдвинула бы всё, что после неё. + Промежутки заполняются тем же файлом — показывать его там всё равно + никто не будет, за это отвечают окна. } +procedure TMainForm.BuildOverlayPreview(const AOverlays: TPreviewOverlays; + const ATotal: Double); +var + Segs: TFlatSegmentArray; + Win: TOverlayWindow; + I, N: Integer; + At: Double; + + procedure Push(const APath: string; const AStart, ADuration: Double); + begin + if ADuration <= 0.001 then + Exit; + SetLength(Segs, N + 1); + Segs[N] := Default(TFlatSegment); + Segs[N].FilePath := APath; + Segs[N].SrcStart := AStart; + Segs[N].Duration := ADuration; + Inc(N); + end; + +begin + FPreviewOverlayUrl := ''; + FPreviewOverlayWindows := nil; + if Length(AOverlays) = 0 then + Exit; + + N := 0; + At := 0; + for I := 0 to High(AOverlays) do + begin + { Промежуток до этого куска — заполнитель из того же файла. } + if AOverlays[I].TlStart > At + 0.001 then + Push(AOverlays[I].FilePath, 0, AOverlays[I].TlStart - At); + Push(AOverlays[I].FilePath, AOverlays[I].SrcStart, + AOverlays[I].TlEnd - AOverlays[I].TlStart); + At := AOverlays[I].TlEnd; + + Win := Default(TOverlayWindow); + Win.TlStart := AOverlays[I].TlStart; + Win.TlEnd := AOverlays[I].TlEnd; + Win.Filter := AOverlays[I].Filter; + Win.X := AOverlays[I].X; + Win.Y := AOverlays[I].Y; + Win.Width := AOverlays[I].Width; + Win.Height := AOverlays[I].Height; + SetLength(FPreviewOverlayWindows, Length(FPreviewOverlayWindows) + 1); + FPreviewOverlayWindows[High(FPreviewOverlayWindows)] := Win; + end; + + { Хвост после последнего куска не нужен: наложение там выключено, а + плеер спокойно доигрывает основу без второй дорожки. } + if N = 0 then + begin + FPreviewOverlayWindows := nil; + Exit; + end; + FPreviewOverlayUrl := BuildEdlUri(Segs); +end; + procedure TMainForm.LoadPreviewEdl(const ASegments, AAudio: TFlatSegmentArray); var Edl, AudioEdl: string; @@ -1949,6 +2029,15 @@ begin AudioEdl := ''; for I := 0 to High(FPreviewAudioUrls) do AudioEdl := AudioEdl + FPreviewAudioUrls[I] + '|'; + { Наложение входит в сравнение наравне со звуком: сдвинули оверлей — + список кусков основы мог не измениться, а показывать надо иначе. } + AudioEdl := AudioEdl + '#' + FPreviewOverlayUrl; + for I := 0 to High(FPreviewOverlayWindows) do + AudioEdl := AudioEdl + Format('|%s@%d:%d:%s-%s', + [FPreviewOverlayWindows[I].Filter, + FPreviewOverlayWindows[I].X, FPreviewOverlayWindows[I].Y, + SecondsToStr(FPreviewOverlayWindows[I].TlStart), + SecondsToStr(FPreviewOverlayWindows[I].TlEnd)]); { Список кусков запоминаем всегда, даже если строка не изменилась: громкость в неё не входит, а брать её потом неоткуда. } @@ -1970,6 +2059,7 @@ begin правке монтажа слышен и виден кусок не оттуда. } { Внешний звук назначается до загрузки: он часть того, что открывается. } FPlayer.SetAudioSources(FPreviewAudioUrls); + FPlayer.SetVideoOverlay(FPreviewOverlayUrl, FPreviewOverlayWindows); FPlayer.LoadUrl(Edl, Format('start=%s,pause=%s', [SecondsToStr(Pos), BoolToStr(WasPaused, 'yes', 'no')])); FLastLoadedEdl := Edl; @@ -2315,6 +2405,8 @@ procedure TMainForm.TimelineClipTransform(Sender: TObject; AClip: TClip); var Item: TMediaItem; T: TMediaTransform; + Key: TColorKey; + Applied: Boolean; begin if AClip = nil then Exit; @@ -2344,13 +2436,19 @@ begin end; T := AClip.Transform; - if not EditTransform(Self, Item.EffectivePath, Item.Info, + { Ключ отдаётся окну по ссылке: правку он подтверждает сам, и «Отмена» + кадрирования её не отменяет. } + Key := AClip.ColorKey; + Applied := EditTransform(Self, Item.EffectivePath, Item.Info, FProject.Master.Width, FProject.Master.Height, T, - FProject.CacheDir + 'pancrop.png') then + FProject.CacheDir + 'pancrop.png', @Key); + if (not Applied) and SameColorKey(Key, AClip.ColorKey) then Exit; FProject.BeginChange; - AClip.Transform := T; + if Applied then + AClip.Transform := T; + AClip.ColorKey := Key; FTimeline.Invalidate; FLastLoadedEdl := ''; SchedulePreview; @@ -2914,6 +3012,63 @@ begin FTimeline.DeleteSelected; end; +{ Цветовой ключ выделенного клипа. + + Ключ принадлежит клипу, а не файлу: один и тот же кусок может лежать в + монтаже дважды, и выбивать цвет нужно не всегда. + + Клип с ключом перестаёт быть сплошным, и участок под ним собирается + слоями — тем же способом, что и полупрозрачный. Значит, эти секунды + придётся пересчитать; об этом окно предупреждает. } +procedure TMainForm.MenuColorKey(Sender: TObject); +var + T, C: Integer; + Track: TTrack; + Found: TClip; + Item: TMediaItem; + Key: TColorKey; +begin + Found := nil; + for T := 0 to FProject.TrackCount - 1 do + begin + Track := FProject.Tracks[T]; + for C := 0 to Track.Count - 1 do + if Track[C].Selected and (Track[C].Kind in [ckVideo, ckImage]) then + begin + Found := Track[C]; + Break; + end; + if Found <> nil then + Break; + end; + + if Found = nil then + begin + SetStatus('Выделите клип с картинкой: ключ выбивает цвет из неё.'); + Exit; + end; + + Item := FProject.FindMedia(Found.MediaId); + if Item = nil then + Exit; + + Key := Found.ColorKey; + if not EditColorKey(Key, Item.EffectivePath, + Found.SrcIn + Found.Duration / 2, FProject.CacheDir + 'colorkey.png') then + Exit; + + FProject.BeginChange; + Found.ColorKey := Key; + FTimeline.Invalidate; + FLastLoadedEdl := ''; + SchedulePreview; + UpdateCaption; + if Key.Enabled then + SetStatus('Цветовой ключ включён: участок будет пересобран.') + else + SetStatus('Цветовой ключ выключен.'); +end; + procedure TMainForm.MenuSelectAll(Sender: TObject); begin FTimeline.SelectAll; diff --git a/src/uMpvPlayer.pas b/src/uMpvPlayer.pas index 4c3e42e..20ac3b5 100644 --- a/src/uMpvPlayer.pas +++ b/src/uMpvPlayer.pas @@ -59,6 +59,13 @@ type FHwdec: string; FAudioSource: string; FAudioSources: array of string; + { Наложение: список кусков оверлея и окна, когда и куда его класть. } + FOverlayUrl: string; + FOverlayWindows: TOverlayWindows; + { Номера видеодорожек: своя (основа) и подключённая для наложения. + Пусто — наложения нет. } + FBaseVid: string; + FOverlayVid: string; FTrackVolumes: array of Double; { Номера подключённых звуковых дорожек, в порядке подключения. } FAudioIds: array of string; @@ -97,11 +104,16 @@ type усмотрению. Получалось, что звук слышен там, где на монтаже его нет вовсе — он приходил из видеофайла, а не с звуковой дорожки. } procedure SelectExternalAudio; + { Подключает оверлей второй видеодорожкой и запоминает её номер. } + procedure AttachOverlay; + { Часть цепочки, которая кладёт оверлей на основу. Пусто — нечего + класть. } + function OverlayGraph: string; { Цепочка смешивания звуковых дорожек с их громкостями. } { Собственная запись в журнал программы. Идёт тем же путём, что и сообщения самого mpv: у окна для них уже есть обработчик. } procedure Note(const AText: string); - procedure BuildAudioGraph; + procedure BuildGraph; function SetOption(const AName, AValue: string): Integer; public constructor Create(AVideoParent: TWinControl); @@ -167,6 +179,12 @@ type { Несколько звуковых дорожек монтажа разом. Плеер играет только одну, поэтому смесь собирается его же средствами — см. AttachAudio. } procedure SetAudioSources(const AUrls: array of string); + { Что класть поверх картинки. Пустой список кусков — ничего. + + Наложение делает сам плеер, ничего заранее не собирается: две + дорожки играются одна поверх другой. } + procedure SetVideoOverlay(const AUrl: string; + const AWindows: TOverlayWindows); { Громкость каждой звуковой дорожки монтажа. Подставляется в цепочку смешивания: одной общей громкостью тут не обойтись. } @@ -634,6 +652,7 @@ begin Снимать её после загрузки поздно. } FLastGraph := ''; FAudioIds := nil; + FOverlayVid := ''; mpv_set_property_string(FHandle, 'lavfi-complex', ''); Rest := AOptions; @@ -753,6 +772,17 @@ begin FAudioSource := ''; end; +procedure TMpvPlayer.SetVideoOverlay(const AUrl: string; + const AWindows: TOverlayWindows); +var + I: Integer; +begin + FOverlayUrl := AUrl; + SetLength(FOverlayWindows, Length(AWindows)); + for I := 0 to High(AWindows) do + FOverlayWindows[I] := AWindows[I]; +end; + procedure TMpvPlayer.SetTrackVolumes(const AVolumes: array of Double); var I: Integer; @@ -760,7 +790,7 @@ begin SetLength(FTrackVolumes, Length(AVolumes)); for I := 0 to High(AVolumes) do FTrackVolumes[I] := AVolumes[I]; - BuildAudioGraph; + BuildGraph; end; procedure TMpvPlayer.SetHwdec(const AMode: string); @@ -843,29 +873,135 @@ begin end; end; -procedure TMpvPlayer.BuildAudioGraph; +{ Наложение оверлея на основу. + + Оверлей — обычная видеодорожка, подключённая рядом с основной. Класть её + поверх умеет сам плеер, поэтому ничего не собирается заранее: правка + видна сразу, а видеокарта не тратится на пересборку всего ролика. + + Окна с одинаковым размером и местом объединяются в одну ветку: масштаб + во времени не меняется, а вот показывать и прятать можно по времени — + это и делает enable. } +function TMpvPlayer.OverlayGraph: string; +var + I, J, N, Count: Integer; + Filters: array of string; + Xs, Ys: array of Integer; + Enables: array of string; + Src, Prev, Next, Fit: string; + + { Номер ветки для окна: у одинаковых по виду и месту она общая. } + function GroupOf(const AWin: TOverlayWindow): Integer; + var + K: Integer; + begin + for K := 0 to Count - 1 do + if (Filters[K] = AWin.Filter) and (Xs[K] = AWin.X) and + (Ys[K] = AWin.Y) then + Exit(K); + SetLength(Filters, Count + 1); + SetLength(Xs, Count + 1); + SetLength(Ys, Count + 1); + SetLength(Enables, Count + 1); + Filters[Count] := AWin.Filter; + Xs[Count] := AWin.X; + Ys[Count] := AWin.Y; + Enables[Count] := ''; + Result := Count; + Inc(Count); + end; + +begin + Result := ''; + if (FOverlayVid = '') or (FBaseVid = '') or + (Length(FOverlayWindows) = 0) then + Exit; + + Count := 0; + for I := 0 to High(FOverlayWindows) do + begin + J := GroupOf(FOverlayWindows[I]); + if Enables[J] <> '' then + Enables[J] := Enables[J] + '+'; + Enables[J] := Enables[J] + Format('between(t,%s,%s)', + [SecondsToStr(FOverlayWindows[I].TlStart), + SecondsToStr(FOverlayWindows[I].TlEnd)]); + end; + + { Одна ветка берёт оверлей напрямую, несколько — через split. } + if Count = 1 then + Result := Format('[vid%s]', [FOverlayVid]) + else + begin + Result := Format('[vid%s]split=%d', [FOverlayVid, Count]); + for I := 0 to Count - 1 do + Result := Result + Format('[q%d]', [I]); + Result := Result + ';'; + end; + + for I := 0 to Count - 1 do + begin + if Count = 1 then + Src := '' + else + Src := Format('[q%d]', [I]); + Fit := Filters[I]; + if Fit = '' then + Fit := 'null'; + Result := Result + Format('%s%s[ov%d];', [Src, Fit, I]); + end; + + Prev := Format('[vid%s]', [FBaseVid]); + for I := 0 to Count - 1 do + begin + if I = Count - 1 then + Next := '[vo]' + else + Next := Format('[m%d]', [I]); + { eof_action=pass и repeatlast=0: оверлей короче основы — обычное + дело, и после его конца картинка должна идти дальше как ни в чём + не бывало. } + Result := Result + Format('%s[ov%d]overlay=%d:%d:enable=''%s''' + + ':eof_action=pass:repeatlast=0%s;', + [Prev, I, Xs[I], Ys[I], Enables[I], Next]); + Prev := Next; + end; +end; + +procedure TMpvPlayer.BuildGraph; var I: Integer; - Graph, Vol: string; + Graph, Vol, Video: string; + NeedAudioPart: Boolean; begin if FHandle = nil then Exit; + + Video := OverlayGraph; + + { Цепочка отбирает дорожки: всё, что в ней не упомянуто, mpv снимает с + выбора. Поэтому при наложении звук приходится вести через неё же, + даже когда дорожка одна, — иначе он просто пропадёт. } + NeedAudioPart := (Length(FAudioIds) > 1) or + ((Video <> '') and (Length(FAudioIds) > 0)); + if Length(FAudioIds) = 0 then begin - { Дорожек нет — снимаем и цепочку, и приглушение. Иначе они пережили - бы смену монтажа и заглушили следующий. } + { Дорожек нет — снимаем приглушение, иначе оно пережило бы смену + монтажа и заглушило следующий. } SetVolume(100); - if FLastGraph <> '' then + Graph := Video; + if Graph <> FLastGraph then begin - FLastGraph := ''; - mpv_set_property_string(FHandle, 'lavfi-complex', ''); + FLastGraph := Graph; + mpv_set_property_string(FHandle, 'lavfi-complex', PAnsiChar(Graph)); end; Exit; end; - { Одна дорожка играется как есть: цепочка фильтров тут только мешала бы, - да и громкость для неё задаётся обычным способом. } - if Length(FAudioIds) = 1 then + { Одна дорожка без наложения играется как есть: цепочка тут только + мешала бы, да и громкость задаётся обычным способом. } + if not NeedAudioPart then begin Graph := ''; if (Length(FTrackVolumes) > 0) and (Abs(FTrackVolumes[0] - 1) > 0.001) then @@ -873,6 +1009,15 @@ begin else SetVolume(100); end + else if Length(FAudioIds) = 1 then + begin + SetVolume(100); + if Length(FTrackVolumes) > 0 then + Vol := SecondsToStr(FTrackVolumes[0]) + else + Vol := '1'; + Graph := Format('[aid%s]volume=%s[ao];', [FAudioIds[0], Vol]); + end else begin { Общая громкость возвращается на место обязательно. @@ -895,16 +1040,56 @@ begin end; for I := 0 to High(FAudioIds) do Graph := Graph + Format('[t%d]', [I]); - Graph := Graph + Format('amix=inputs=%d:normalize=0[ao]', + Graph := Graph + Format('amix=inputs=%d:normalize=0[ao];', [Length(FAudioIds)]); end; + Graph := Video + Graph; if Graph = FLastGraph then Exit; FLastGraph := Graph; mpv_set_property_string(FHandle, 'lavfi-complex', PAnsiChar(Graph)); end; +{ Оверлей подключается второй видеодорожкой. + + Как и со звуком, через свойство это не делается: нужна команда + video-add. Дорожка добавляется без выбора — выбирать её нельзя, иначе + она заменила бы картинку. Её дело — быть входом цепочки. } +procedure TMpvPlayer.AttachOverlay; +var + Count, I: Integer; + Kind, Ext, Id: string; +begin + if FHandle = nil then + Exit; + + FBaseVid := ''; + FOverlayVid := ''; + + if (FOverlayUrl <> '') and (Length(FOverlayWindows) > 0) then + Command(['video-add', FOverlayUrl, 'auto']); + + Count := StrToIntDef(GetPropString('track-list/count'), 0); + for I := 0 to Count - 1 do + begin + Kind := GetPropString(Format('track-list/%d/type', [I])); + if Kind <> 'video' then + Continue; + Id := GetPropString(Format('track-list/%d/id', [I])); + if Id = '' then + Continue; + Ext := GetPropString(Format('track-list/%d/external', [I])); + if (Ext = 'yes') or (Ext = 'true') then + begin + if FOverlayVid = '' then + FOverlayVid := Id; + end + else if FBaseVid = '' then + FBaseVid := Id; + end; +end; + { Субтитры подключаются двумя путями, и оба нужны. Здесь — когда файл поменялся, а картинка та же: снимаем прежние и @@ -979,7 +1164,7 @@ begin FAudioTrackNote := 'Звук: дорожек монтажа ' + IntToStr(Found) + '.'; { Цепочка строится отдельно: она зависит ещё и от громкостей, а те меняются по ходу воспроизведения. } - BuildAudioGraph; + BuildGraph; Exit; end; @@ -1027,7 +1212,13 @@ begin HandleLogMessage(Pmpv_event_log_message(Ev^.data)); MPV_EVENT_FILE_LOADED: begin + { Оверлей подключается до звука: цепочка строится один раз, и в + ней должно быть сразу всё. } + AttachOverlay; SelectExternalAudio; + { Звуковых дорожек может не оказаться вовсе, а наложение при + этом есть — тогда цепочку никто больше не соберёт. } + BuildGraph; { Загрузка нового списка кусков сбрасывает все внешние дорожки, в том числе субтитры. Подключаем заново. } if FSubtitlePath <> '' then diff --git a/src/uPanCropForm.lfm b/src/uPanCropForm.lfm index 022d3bc..53a6ed6 100644 --- a/src/uPanCropForm.lfm +++ b/src/uPanCropForm.lfm @@ -179,6 +179,15 @@ object PanCropForm: TPanCropForm OnClick = btnCancelClick TabOrder = 9 end + object btnKey: TThemedButton + Left = 12 + Height = 30 + Top = 534 + Width = 356 + Caption = 'Цветовой ключ...' + OnClick = btnKeyClick + TabOrder = 10 + end end object pbSource: TPaintBox Left = 380 diff --git a/src/uPanCropForm.pas b/src/uPanCropForm.pas index 86feeb1..dfce88f 100644 --- a/src/uPanCropForm.pas +++ b/src/uPanCropForm.pas @@ -21,7 +21,7 @@ interface uses Classes, SysUtils, Forms, Controls, Graphics, ExtCtrls, StdCtrls, Spin, - ComCtrls, uTransform, uMediaProbe, uTheme; + ComCtrls, uTransform, uMediaProbe, uProject, uTheme; type @@ -29,6 +29,7 @@ type TPanCropForm = class(TForm) btnCancel: TThemedButton; + btnKey: TThemedButton; btnOk: TThemedButton; btnReset: TThemedButton; cbFit: TComboBox; @@ -49,6 +50,7 @@ type tbOffsetY: TTrackBar; tbZoom: TTrackBar; procedure btnCancelClick(Sender: TObject); + procedure btnKeyClick(Sender: TObject); procedure btnOkClick(Sender: TObject); procedure btnResetClick(Sender: TObject); procedure ControlChanged(Sender: TObject); @@ -64,6 +66,11 @@ type private FTransform: TMediaTransform; FSourcePath: string; + { Цветовой ключ правится тут же, но принадлежит не окну, а клипу: + окно лишь показывает его хозяину. Пусто — правит нечего (так бывает + у заготовки для файла, у которой клипа ещё нет), и кнопки не + будет. } + FKey: PColorKey; FSourceInfo: TMediaInfo; FDstWidth: Integer; FDstHeight: Integer; @@ -103,21 +110,28 @@ type { Готовит окно. ADstWidth и ADstHeight — кадр проекта. } procedure Setup(const APath: string; const AInfo: TMediaInfo; ADstWidth, ADstHeight: Integer; const ATransform: TMediaTransform; - const APreviewFile: string); + const APreviewFile: string; AKey: PColorKey = nil); property Transform: TMediaTransform read FTransform; end; { Показывает окно и возвращает True, если настройки приняты. } +{ AKey — цветовой ключ клипа. Нужен, чтобы правку ключа можно было + открыть отсюда: человек ищет её там же, где кадрирование, — обе + настройки про картинку одного клипа. Правка ключа сама себя + подтверждает и «Отменой» этого окна не отменяется. + + nil — ключа у этой настройки нет, кнопка не показывается. } function EditTransform(AOwner: TComponent; const APath: string; const AInfo: TMediaInfo; ADstWidth, ADstHeight: Integer; - var ATransform: TMediaTransform; const APreviewFile: string): Boolean; + var ATransform: TMediaTransform; const APreviewFile: string; + AKey: PColorKey = nil): Boolean; implementation {$R *.lfm} uses - Math, Types, LCLIntf, uAppTypes, uFfmpegCmd, uProcRunner; + Math, Types, LCLIntf, uAppTypes, uFfmpegCmd, uProcRunner, uColorKeyForm; const { Ширина показываемого кадра. Больше незачем: тут важны пропорции и то, @@ -197,8 +211,10 @@ end; procedure TPanCropForm.Setup(const APath: string; const AInfo: TMediaInfo; ADstWidth, ADstHeight: Integer; const ATransform: TMediaTransform; - const APreviewFile: string); + const APreviewFile: string; AKey: PColorKey); begin + FKey := AKey; + btnKey.Visible := AKey <> nil; FSourcePath := APath; FSourceInfo := AInfo; FDstWidth := ADstWidth; @@ -295,6 +311,23 @@ begin ScheduleRefresh; end; +{ Правка цветового ключа того же клипа. + + Кадр для выбора цвета окно ключа достаёт само — тот же, что и здесь: + первый кадр часто чёрный, и тыкать в него не во что. } +procedure TPanCropForm.btnKeyClick(Sender: TObject); +var + AtTime: Double; +begin + if FKey = nil then + Exit; + if FSourceInfo.Kind = mkImage then + AtTime := 0 + else + AtTime := Min(5, Max(0, FSourceInfo.Duration * 0.1)); + EditColorKey(FKey^, FSourcePath, AtTime, FPreviewFile + '.key.png'); +end; + procedure TPanCropForm.ScheduleRefresh; begin { Вызов может прийти во время сборки окна, когда таймера ещё нет. } @@ -446,8 +479,15 @@ begin SH := FRotH * K; CW := Min(SW, FDstWidth); CH := Min(SH, FDstHeight); - FTransform.OffsetX := (FSel.Left * K - (SW - CW) / 2) / FDstWidth; - FTransform.OffsetY := (FSel.Top * K - (SH - CH) / 2) / FDstHeight; + { Смещение пересчитывается по рамке только там, где рамка его и + задаёт, — то есть где картинка шире или выше кадра. Где она меньше, + рамка охватывает её целиком и о смещении ничего не знает; посчитанный + по ней ноль вернул бы картинку на середину и отменил бы то, что + выставлено ползунком. } + if SW > FDstWidth then + FTransform.OffsetX := (FSel.Left * K - (SW - CW) / 2) / FDstWidth; + if SH > FDstHeight then + FTransform.OffsetY := (FSel.Top * K - (SH - CH) / 2) / FDstHeight; end; procedure TPanCropForm.ClampTransform; @@ -679,13 +719,15 @@ end; function EditTransform(AOwner: TComponent; const APath: string; const AInfo: TMediaInfo; ADstWidth, ADstHeight: Integer; - var ATransform: TMediaTransform; const APreviewFile: string): Boolean; + var ATransform: TMediaTransform; const APreviewFile: string; + AKey: PColorKey): Boolean; var Form: TPanCropForm; begin Form := TPanCropForm.Create(AOwner); try - Form.Setup(APath, AInfo, ADstWidth, ADstHeight, ATransform, APreviewFile); + Form.Setup(APath, AInfo, ADstWidth, ADstHeight, ATransform, APreviewFile, + AKey); Result := Form.ShowModal = mrOK; if Result then ATransform := Form.Transform; diff --git a/src/uProject.pas b/src/uProject.pas index 0fc4640..26ddd5e 100644 --- a/src/uProject.pas +++ b/src/uProject.pas @@ -48,6 +48,25 @@ type tpTopLeft = 7, tpTopCenter = 8, tpTopRight = 9 ); + { Цветовой ключ: цвет, который у клипа становится прозрачным. + + Нужен для накладок — плиток, значков, рамок, снятых на однотонном + фоне. Пурпурный берут потому, что в природе он почти не встречается: + ошибиться и вырезать кусок картинки труднее, чем с зелёным. + + Клип с ключом собрать копированием нельзя: участок пересобирается + вместе с тем, что под ним, как и полупрозрачный. } + TColorKey = record + Enabled: Boolean; + Color: TRgb; + { Насколько далеко от указанного цвета считать «тем же цветом», в + процентах. Ноль — только точное совпадение. } + Similarity: Integer; + { Смягчение края, в процентах. Ноль — резкая граница. } + Blend: Integer; + end; + PColorKey = ^TColorKey; + { Оформление текстового клипа. Цвета хранятся как TColor, а в ASS переводятся: там свой порядок @@ -121,6 +140,7 @@ type FFadeOut: Double; FText: string; FTextStyle: TTextStyle; + FColorKey: TColorKey; public constructor Create; function TlEnd: Double; @@ -163,6 +183,8 @@ type удаляются вместе. По умолчанию так связаны картинка и её звук; Ctrl+G связывает и развязывает что угодно. } property GroupId: string read FGroupId write FGroupId; + { Цветовой ключ клипа. Выключен — клип обычный. } + property ColorKey: TColorKey read FColorKey write FColorKey; { Текст и его оформление. Имеют смысл только у клипа вида ckText; у остальных лежат пустыми и в файл проекта не пишутся. } property Text: string read FText write FText; @@ -336,6 +358,14 @@ const { Сколько длится картинка, пока её не растянули. } DefaultImageDuration = 5.0; +{ Цветовой ключ по умолчанию. } +function DefaultColorKey: TColorKey; + +{ Одинаковы ли два ключа. Записи в Паскале сравнивать оператором нельзя, + а знать, изменилось ли что-нибудь, нужно: иначе в истории отмены + появится пустой шаг. } +function SameColorKey(const A, B: TColorKey): Boolean; + { Оформление текста по умолчанию: белые буквы с тёмной обводкой внизу по центру — то, что читается на любой картинке. } function DefaultTextStyle: TTextStyle; @@ -380,6 +410,7 @@ begin FOpacity := 1; FTransform := DefaultTransform; FTextStyle := DefaultTextStyle; + FColorKey := DefaultColorKey; end; function TClip.TlEnd: Double; @@ -1114,6 +1145,23 @@ begin Result := edSnap; end; +function SameColorKey(const A, B: TColorKey): Boolean; +begin + Result := (A.Enabled = B.Enabled) and (A.Color = B.Color) and + (A.Similarity = B.Similarity) and (A.Blend = B.Blend); +end; + +{ Цветовой ключ по умолчанию: выключен, пурпурный, с небольшим запасом по + сходству — сжатие видео размывает чистый цвет, и точное совпадение + оставило бы кайму. } +function DefaultColorKey: TColorKey; +begin + Result.Enabled := False; + Result.Color := TRgb($FF00FF); + Result.Similarity := 15; + Result.Blend := 5; +end; + { Оформление текста по умолчанию: белые буквы с тёмной обводкой внизу по центру — то, что читается на любой картинке. } function DefaultTextStyle: TTextStyle; @@ -1131,6 +1179,17 @@ begin Result.Italic := False; end; +function JsonToColorKey(AObj: TJSONObject): TColorKey; +begin + Result := DefaultColorKey; + if AObj = nil then + Exit; + Result.Enabled := AObj.Get('enabled', Result.Enabled); + Result.Color := TRgb(AObj.Get('color', Integer(Result.Color))); + Result.Similarity := AObj.Get('similarity', Result.Similarity); + Result.Blend := AObj.Get('blend', Result.Blend); +end; + function JsonToTextStyle(AObj: TJSONObject): TTextStyle; begin Result := DefaultTextStyle; @@ -1346,6 +1405,12 @@ begin ]), { Оформление пишется только у текстовых клипов: у остальных оно пустое, и таскать его в файле незачем. } + 'color_key', TJSONObject.Create([ + 'enabled', Clip.ColorKey.Enabled, + 'color', Integer(Clip.ColorKey.Color), + 'similarity', Clip.ColorKey.Similarity, + 'blend', Clip.ColorKey.Blend + ]), 'text', Clip.Text, 'text_style', TJSONObject.Create([ 'font', Clip.TextStyle.FontName, @@ -1474,6 +1539,8 @@ begin if Media <> nil then Clip.Transform := Media.Transform; end; + Clip.ColorKey := JsonToColorKey( + ClipObj.Get('color_key', TJSONObject(nil))); Clip.Text := ClipObj.Get('text', ''); Clip.TextStyle := JsonToTextStyle( ClipObj.Get('text_style', TJSONObject(nil))); diff --git a/src/uTimelineCtrl.pas b/src/uTimelineCtrl.pas index 4b69769..0f0dd63 100644 --- a/src/uTimelineCtrl.pas +++ b/src/uTimelineCtrl.pas @@ -805,6 +805,18 @@ begin SecondsToStr(AClip.Duration) + ' с'); end; + { Метка цветового ключа: сам выбиваемый цвет квадратиком в нижнем левом + углу. Иначе клип с ключом ничем не отличается от обычного, а разница + у них большая — участок под ним будет пересобран. } + if AClip.ColorKey.Enabled and (W > 20) then + begin + ACanvas.Brush.Style := bsSolid; + ACanvas.Brush.Color := TColor(AClip.ColorKey.Color); + ACanvas.Pen.Color := ColorClipText; + ACanvas.Rectangle(Body.Left + 6, Body.Bottom - 15, + Body.Left + 18, Body.Bottom - 3); + end; + ACanvas.Brush.Style := bsSolid; end; diff --git a/src/uTransform.pas b/src/uTransform.pas index 87b01e5..0c8b91a 100644 --- a/src/uTransform.pas +++ b/src/uTransform.pas @@ -69,6 +69,19 @@ function TransformFilter(const AT: TMediaTransform; Отсюда честное ограничение: предпросмотр показывает кадр проекта верно, но собственную настройку кадрирования файла не учитывает. Её видно в окне кадрирования и в готовом ролике. } +{ То же самое, но для наложения в плеере: цепочка без обкладывания + полями и отдельно точка, куда встанет получившаяся картинка. + + Поля и наложение — две записи одного и того же. Сборка обкладывает + картинку полями до кадра проекта, потому что кусок должен быть + самостоятельным файлом. Плееру поля не нужны и вредны: чёрное поле + закрыло бы нижнее видео. Ему нужны те же самые координаты, но как место + наложения. Считаются они одним и тем же кодом — иначе окно показывало + бы одно, а сборка давала другое. } +function OverlayFilter(const AT: TMediaTransform; + ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer; + out AX, AY, AWidth, AHeight: Integer): string; + function PreviewFitFilter(ADstWidth, ADstHeight: Integer): string; function FitModeToStr(AMode: TFitMode): string; @@ -160,8 +173,11 @@ begin Result := 2; end; -function TransformFilter(const AT: TMediaTransform; - ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer): string; +{ Общая часть: цепочка до обкладывания полями и место, куда встанет + получившаяся картинка в кадре проекта. } +function BuildTransform(const AT: TMediaTransform; + ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer; + out AX, AY, AWidth, AHeight: Integer): string; var Chain: string; K, KFit, KFill: Double; @@ -269,17 +285,50 @@ begin Add(Format('scale=%d:%d', [PW, PH])); end; - if (PW < ADstWidth) or (PH < ADstHeight) then - begin - PX := Max(0, (ADstWidth - PW) div 2); - PY := Max(0, (ADstHeight - PH) div 2); - Add(Format('pad=%d:%d:%d:%d', [ADstWidth, ADstHeight, PX, PY])); - end; + { Смещение двигает картинку и там, где её не обрезали. Когда картинка + больше кадра, двигать можно лишь окно, через которое на неё смотрят, + — это делает crop выше. Когда она меньше, двигать надо её саму по + полю, иначе уменьшенный кадр навсегда прибит к середине и в угол его + не отправить. Обе стороны считают смещение в долях кадра проекта, так + что число значит одно и то же. } + PX := (ADstWidth - PW) div 2 + Round(AT.OffsetX * ADstWidth); + PY := (ADstHeight - PH) div 2 + Round(AT.OffsetY * ADstHeight); + PX := Max(0, Min(Max(0, ADstWidth - PW), PX)); + PY := Max(0, Min(Max(0, ADstHeight - PH), PY)); - { Пиксель считаем квадратным: иначе плеер растянет кадр по своему - разумению, и результат разойдётся с тем, что видно в предпросмотре. } - Add('setsar=1'); + AX := PX; + AY := PY; + AWidth := PW; + AHeight := PH; Result := Chain; end; +function TransformFilter(const AT: TMediaTransform; + ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer): string; +var + X, Y, W, H: Integer; +begin + Result := BuildTransform(AT, ASrcWidth, ASrcHeight, ADstWidth, ADstHeight, + X, Y, W, H); + if Result = '' then + Exit; + + if (W < ADstWidth) or (H < ADstHeight) then + Result := Result + Format(',pad=%d:%d:%d:%d', [ADstWidth, ADstHeight, X, Y]); + + { Пиксель считаем квадратным: иначе плеер растянет кадр по своему + разумению, и результат разойдётся с тем, что видно в предпросмотре. } + Result := Result + ',setsar=1'; +end; + +function OverlayFilter(const AT: TMediaTransform; + ASrcWidth, ASrcHeight, ADstWidth, ADstHeight: Integer; + out AX, AY, AWidth, AHeight: Integer): string; +begin + Result := BuildTransform(AT, ASrcWidth, ASrcHeight, ADstWidth, ADstHeight, + AX, AY, AWidth, AHeight); + if Result <> '' then + Result := Result + ',setsar=1'; +end; + end. diff --git a/tests/lfmcheck/lfmcheck.lpr b/tests/lfmcheck/lfmcheck.lpr index f9bb203..156fd7e 100644 --- a/tests/lfmcheck/lfmcheck.lpr +++ b/tests/lfmcheck/lfmcheck.lpr @@ -12,9 +12,11 @@ program lfmcheck; {$mode objfpc}{$H+} uses - { Interfaces нужен только для сборки: без него не связывается вся LCL. - Окно при этом не создаётся — Application.Initialize мы не зовём. } - Interfaces, SysUtils, TypInfo, uTheme; + { Interfaces нужен, чтобы связалась вся LCL и заработала загрузка + файлов форм. } + Interfaces, Forms, Classes, SysUtils, TypInfo, uTheme, + uPanCropForm, uDepsForm, uMismatchForm, uProgressForm, uProjectInfoForm, + uRemuxForm; var Failed: Integer = 0; @@ -41,6 +43,35 @@ begin end; end; +{ Создаёт окно и тут же убирает. + + Смысл в самом создании: файл формы разбирается именно тогда. Элемент, + который есть в файле формы и которого нет в классе, или обработчик с + опечаткой в имени — всё это здесь и вскрывается, а иначе вскрылось бы у + человека при открытии окна. + + Главное окно не проверяется: оно при создании читает настройки, строит + меню и заводит плеер — это уже не проверка формы, а запуск программы. } +procedure CheckForm(AClass: TFormClass); +var + F: TForm; +begin + try + F := AClass.Create(nil); + try + WriteLn(' ok ', AClass.ClassName, ' — форма загружена'); + finally + F.Free; + end; + except + on E: Exception do + begin + WriteLn(' ПЛОХО ', AClass.ClassName, ': ', E.Message); + Inc(Failed); + end; + end; +end; + begin WriteLn('Свойства из файлов форм'); WriteLn; @@ -56,6 +87,17 @@ begin CheckEnum(TypeInfo(TThemedIcon), 'tiLog'); CheckEnum(TypeInfo(TThemedIcon), 'tiNone'); + WriteLn; + WriteLn('Загрузка файлов форм'); + WriteLn; + Application.Initialize; + CheckForm(TPanCropForm); + CheckForm(TDepsForm); + CheckForm(TMismatchForm); + CheckForm(TProgressForm); + CheckForm(TProjectInfoForm); + CheckForm(TRemuxForm); + WriteLn; if Failed = 0 then WriteLn('ВЕРДИКТ: все проверки пройдены') diff --git a/tests/nlvetool.lpr b/tests/nlvetool.lpr index 1bc68c1..cb79d12 100644 --- a/tests/nlvetool.lpr +++ b/tests/nlvetool.lpr @@ -47,7 +47,7 @@ uses {$ENDIF} Classes, SysUtils, DateUtils, Math, StrUtils, uAppTypes, uEdl, uKeyframeIndex, uFfmpegCmd, uExport, uRemuxQueue, - uMediaProbe, uProject, uFlatten, uGenerate, uSubtitles; + uMediaProbe, uProject, uFlatten, uGenerate, uSubtitles, uTransform; procedure PrintUsage; begin @@ -561,8 +561,12 @@ procedure CmdFlatTest; var Proj: TProject; Media: TMediaItem; - Segs: TFlatSegmentArray; + Segs, AudioSegs: TFlatSegmentArray; + Overlays: TPreviewOverlays; Missing: TGenRequests; + Clip: TClip; + Key: TColorKey; + Tr: TMediaTransform; TempFile, Err: string; begin WriteLn('Проверка уплощения монтажа'); @@ -730,6 +734,53 @@ begin DeleteFile(TempFile); WriteLn; + { --- 8. Оверлей в предпросмотре не закрывает нижний клип --- } + WriteLn(' 8. Клип с ключом поверх: основа и оверлей врозь'); + Proj := MakeProject(2, Media); + try + Proj.Master := Media.Info; + { Нижняя дорожка — обычный кусок, верхняя — тот же файл с выбитым + цветом во всю длину. Так выглядит компас или карта поверх ролика. } + Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 0); + Clip := Proj.AddClip(Proj.Tracks[0], Media, 100, 10, 0); + Key := DefaultColorKey; + Key.Enabled := True; + Clip.ColorKey := Key; + Tr := Clip.Transform; + Tr.Zoom := 0.5; + Clip.Transform := Tr; + + { Обычное уплощение: побеждает верхний, нижнего не видно. } + FlattenStream(Proj, tkVideo, 0, Segs, Missing); + Check(Length(Segs) = 1, 'при сборке кусок один'); + if Length(Segs) = 1 then + Check(Abs(Segs[0].SrcStart - 100) < 0.001, 'и это верхний клип'); + + { Уплощение для предпросмотра: верхний ушёл в оверлей. } + Check(FlattenPreview(Proj, Segs, AudioSegs, Overlays, Missing), + 'уплощение для предпросмотра прошло'); + DumpSegments(Segs); + Check(Length(Segs) = 1, 'основа из одного куска'); + if Length(Segs) = 1 then + Check(Abs(Segs[0].SrcStart - 0) < 0.001, 'в основе виден нижний клип'); + Check(Length(Overlays) = 1, 'оверлей один'); + if Length(Overlays) = 1 then + begin + Check(Abs(Overlays[0].TlStart) < 0.001, 'оверлей с начала'); + Check(Abs(Overlays[0].TlEnd - 10) < 0.001, 'и до конца'); + Check(Abs(Overlays[0].SrcStart - 100) < 0.001, 'берётся с 100 с'); + Check((Overlays[0].Width = 960) and (Overlays[0].Height = 540), + 'уменьшен вдвое: ' + IntToStr(Overlays[0].Width) + 'x' + + IntToStr(Overlays[0].Height)); + Check((Overlays[0].X = 480) and (Overlays[0].Y = 270), + 'и стоит в середине кадра: ' + IntToStr(Overlays[0].X) + ':' + + IntToStr(Overlays[0].Y)); + end; + finally + Proj.Free; + end; + WriteLn; + WriteLn; if FailCount = 0 then begin @@ -797,6 +848,58 @@ begin end; end; +{ Проект для проверки цветового ключа: нижний клип во всю длину и + верхний с выбитым пурпурным поверх него. Собранное потом смотрим по + точкам кадра: где был пурпурный, должно быть видно нижний клип. } +procedure CmdKeyTest; +var + Proj: TProject; + Info: TMediaInfo; + Bottom, Top: TMediaItem; + Clip: TClip; + Key: TColorKey; + Err: string; +begin + Proj := TProject.Create; + try + Proj.Clear; + Proj.AddTrack('V1'); + Proj.AddTrack('V2'); + Proj.EnsureAudioTracks; + + if not ProbeMedia(ExpandFileName(ParamStr(3)), Info, Err) then + begin + WriteLn('Не удалось прочитать нижнее видео: ', Err); + Halt(1); + end; + Bottom := Proj.AddMedia(ExpandFileName(ParamStr(3)), Info); + WriteLn('низ: ', DescribeMedia(Info)); + Proj.AddClipPair(Proj.Tracks[1], Bottom, 0, 3, 0); + + if not ProbeMedia(ExpandFileName(ParamStr(4)), Info, Err) then + begin + WriteLn('Не удалось прочитать верхнее видео: ', Err); + Halt(1); + end; + Top := Proj.AddMedia(ExpandFileName(ParamStr(4)), Info); + WriteLn('верх: ', DescribeMedia(Info)); + Clip := Proj.AddClip(Proj.Tracks[0], Top, 0, 3, 0); + + Key := DefaultColorKey; + Key.Enabled := True; + Clip.ColorKey := Key; + + if not Proj.SaveToFile(ExpandFileName(ParamStr(2)), Err) then + begin + WriteLn('Не удалось записать проект: ', Err); + Halt(1); + end; + WriteLn('проект записан: ', Proj.FileName); + finally + Proj.Free; + end; +end; + procedure CmdBuildCut; var Proj: TProject; @@ -1203,6 +1306,8 @@ begin CmdFlatTest else if (Cmd = 'build') and (ParamCount >= 3) then CmdBuild + else if (Cmd = 'keytest') and (ParamCount >= 4) then + CmdKeyTest else if (Cmd = 'buildcut') and (ParamCount >= 3) then CmdBuildCut else if (Cmd = 'subs') and (ParamCount >= 2) then