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

Цветовой ключ и живое наложение в предпросмотре

Browse source 
Клипу задаётся цвет, который при сборке становится прозрачным. Окно
ключа показывает кадр: цвет берётся щелчком по нему, выбитое показано
клеткой, допуск и смягчение края — ползунками. Открывается из окна
кадрирования и из меню «Правка», на монтаже клип помечен квадратиком
выбиваемого цвета.

Предпросмотр перестал сводить такие участки в файлы. Плеер играет две
дорожки одна поверх другой: оверлей во весь ролик больше не заставляет
пересобирать весь фильм после каждой правки. Замерено: наложение стоит
0.4 с на 10 с материала 2688x1512, вчетверо быстрее реального времени.

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

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

Проверки форм теперь создают каждое окно из файла формы: элемент,
забытый в классе, вскрывается на сборке, а не при открытии окна.
This commit is contained in:
4aiman 2026-08-31 00:10:28 +03:00
commit acb921d5f7
15 changed files with 1449 additions and 66 deletions
Download patch file Download diff file Expand all files Collapse all files

28
BACKLOG.md
View file

@ -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 с каждый на шестигигабайтном файле) и

4
build.sh
View file

@ -177,6 +177,10 @@ run_tests() {
else
status=1
fi
# Окно зависимостей при создании записывает рядом с собой список
# пакетов по умолчанию. Проверке это не мешает, а в дереве исходников
# такому файлу не место.
rm -f "$HERE/tests/lfmcheck/deps-linux.json"
else
echo "не собралось" >&2
status=1

35
src/uAppTypes.pas
View file

@ -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;

397
src/uColorKeyForm.pas Normal file
View file

@ -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.

56
src/uFfmpegCmd.pas
View file

@ -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 возьмёт

235
src/uFlatten.pas
View file

@ -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.

165
src/uMainForm.pas
View file

@ -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;

219
src/uMpvPlayer.pas
View file

@ -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

9
src/uPanCropForm.lfm
View file

@ -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

60
src/uPanCropForm.pas
View file

@ -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;

67
src/uProject.pas
View file

@ -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)));

12
src/uTimelineCtrl.pas
View file

@ -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;

71
src/uTransform.pas
View file

@ -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.

48
tests/lfmcheck/lfmcheck.lpr
View file

@ -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('ВЕРДИКТ: все проверки пройдены')

109
tests/nlvetool.lpr
View file

@ -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