4aiman
ab719dfd1e
Отбивку или текстовый блок проще размножить копией, чем заводить заново через меню и настраивать оформление с нуля. Копируются выделенные клипы, вставляются по курсору. Связанные берутся вместе с парой — у картинки со звуком иначе уехала бы половина, — но связка у копий своя: копия и подлинник не должны ездить вместе. Взаимное расположение сохраняется, набор сдвигается к курсору. Дорожка выбирается сама: сначала та, откуда копировали, если это время на ней свободно; потом любая подходящая по виду; в крайнем случае заводится новая. Наложить копию на соседа по дорожке нельзя — это означало бы переход, которого никто не заказывал. В модели появился TClip.CopyAllFrom: полная копия, кроме места на монтаже. Проверка в lfmcheck перебирает перенесённые свойства и отдельно убеждается, что место и связка не переносятся.
416 lines
14 KiB
ObjectPascal
416 lines
14 KiB
ObjectPascal
{
|
||
Проверка того, что свойства, записанные в файле формы, у наших
|
||
элементов действительно есть.
|
||
|
||
Зачем отдельно. Файл формы разбирается при запуске, а не при сборке:
|
||
опечатка в имени свойства или в значении перечисления даёт не ошибку
|
||
компиляции, а падение окна на старте. Здесь то же самое проверяется без
|
||
окна — по сведениям о типах.
|
||
}
|
||
program lfmcheck;
|
||
|
||
{$mode objfpc}{$H+}
|
||
|
||
uses
|
||
{ Interfaces нужен, чтобы связалась вся LCL и заработала загрузка
|
||
файлов форм. }
|
||
Interfaces, Forms, Classes, SysUtils, Math, TypInfo, uTheme,
|
||
uMediaProbe, uProject, uTransform, uTimelineCtrl,
|
||
uPanCropForm, uDepsForm, uMismatchForm, uProgressForm, uProjectInfoForm,
|
||
uRemuxForm;
|
||
|
||
var
|
||
Failed: Integer = 0;
|
||
|
||
procedure CheckProp(AClass: TClass; const AName: string);
|
||
begin
|
||
if GetPropInfo(AClass, AName) <> nil then
|
||
WriteLn(' ok ', AClass.ClassName, '.', AName)
|
||
else
|
||
begin
|
||
WriteLn(' ПЛОХО ', AClass.ClassName, '.', AName, ' — свойства нет');
|
||
Inc(Failed);
|
||
end;
|
||
end;
|
||
|
||
procedure CheckEnum(ATypeInfo: PTypeInfo; const AName: string);
|
||
begin
|
||
if GetEnumValue(ATypeInfo, AName) >= 0 then
|
||
WriteLn(' ok значение ', AName)
|
||
else
|
||
begin
|
||
WriteLn(' ПЛОХО значение ', AName, ' — такого нет');
|
||
Inc(Failed);
|
||
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;
|
||
|
||
procedure CheckTrue(const AName: string; AValue: Boolean);
|
||
begin
|
||
if AValue then
|
||
WriteLn(' ok ', AName)
|
||
else
|
||
begin
|
||
WriteLn(' ПЛОХО ', AName);
|
||
Inc(Failed);
|
||
end;
|
||
end;
|
||
|
||
{ Прилипание курсора воспроизведения к границам клипов.
|
||
|
||
Проверяется числами, а не мышью: расчёт открыт наружу именно ради
|
||
этого. Мышью пришлось бы поднимать окно, а окно в проверках — это уже
|
||
не проверка расчёта, а проверка окружения. }
|
||
procedure CheckPlayheadSnap;
|
||
var
|
||
Proj: TProject;
|
||
Info: TMediaInfo;
|
||
Media: TMediaItem;
|
||
Timeline: TTimelineControl;
|
||
begin
|
||
WriteLn;
|
||
WriteLn('Прилипание курсора к границам клипов');
|
||
WriteLn;
|
||
|
||
Info := Default(TMediaInfo);
|
||
Info.Valid := True;
|
||
Info.Kind := mkVideo;
|
||
Info.Duration := 600;
|
||
Info.HasVideo := True;
|
||
Info.VideoCodec := 'hevc';
|
||
Info.Width := 1920;
|
||
Info.Height := 1080;
|
||
Info.FpsNum := 30;
|
||
Info.FpsDen := 1;
|
||
Info.PixFmt := 'yuv420p';
|
||
|
||
Proj := TProject.Create;
|
||
Timeline := TTimelineControl.Create(nil);
|
||
try
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
|
||
{ Два куска встык: границы на 0, 1.5 и 3. }
|
||
Proj.AddClip(Proj.Tracks[0], Media, 0, 1.5, 0);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 10, 1.5, 1.5);
|
||
|
||
Timeline.Project := Proj;
|
||
{ Сто точек в секунду: порог прилипания в восемь точек — это 0.08 с. }
|
||
Timeline.PixelsPerSecond := 100;
|
||
Timeline.PlayheadSnap := True;
|
||
|
||
CheckTrue('стык рядом — притянуло',
|
||
Abs(Timeline.SnapPlayhead(1.53) - 1.5) < 0.0001);
|
||
CheckTrue('с другой стороны — тоже',
|
||
Abs(Timeline.SnapPlayhead(1.47) - 1.5) < 0.0001);
|
||
CheckTrue('далеко от границ — не тронуло',
|
||
Abs(Timeline.SnapPlayhead(0.7) - 0.7) < 0.0001);
|
||
CheckTrue('начало монтажа притягивает',
|
||
Abs(Timeline.SnapPlayhead(0.05)) < 0.0001);
|
||
CheckTrue('конец последнего клипа притягивает',
|
||
Abs(Timeline.SnapPlayhead(2.96) - 3) < 0.0001);
|
||
|
||
{ На мелком масштабе порог в точках даёт больший запас по времени. }
|
||
Timeline.PixelsPerSecond := 10;
|
||
CheckTrue('масштаб мельче — притягивает дальше',
|
||
Abs(Timeline.SnapPlayhead(1.7) - 1.5) < 0.0001);
|
||
|
||
Timeline.PixelsPerSecond := 100;
|
||
Timeline.PlayheadSnap := False;
|
||
CheckTrue('выключено — не притягивает',
|
||
Abs(Timeline.SnapPlayhead(1.53) - 1.53) < 0.0001);
|
||
finally
|
||
Timeline.Free;
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
{ Рез не должен терять настройки клипа.
|
||
|
||
Половина клипа после реза — тот же клип, и цветовой ключ, кадрирование,
|
||
прозрачность, громкость и текст должны остаться при обеих половинах.
|
||
Однажды не остались: у хвоста пропадал ключ, клип переставал быть
|
||
наложением и закрывал собой всё, что под ним. }
|
||
procedure CheckSplitKeepsSettings;
|
||
var
|
||
Proj: TProject;
|
||
Info: TMediaInfo;
|
||
Media: TMediaItem;
|
||
Timeline: TTimelineControl;
|
||
Head, Tail, Cl: TClip;
|
||
Key: TColorKey;
|
||
Tr: TMediaTransform;
|
||
I: Integer;
|
||
begin
|
||
WriteLn;
|
||
WriteLn('Рез сохраняет настройки клипа');
|
||
WriteLn;
|
||
|
||
Info := Default(TMediaInfo);
|
||
Info.Valid := True;
|
||
Info.Kind := mkVideo;
|
||
Info.Duration := 600;
|
||
Info.HasVideo := True;
|
||
Info.VideoCodec := 'hevc';
|
||
Info.Width := 1920;
|
||
Info.Height := 1080;
|
||
Info.FpsNum := 30;
|
||
Info.FpsDen := 1;
|
||
Info.PixFmt := 'yuv420p';
|
||
|
||
Proj := TProject.Create;
|
||
Timeline := TTimelineControl.Create(nil);
|
||
try
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
|
||
Cl := Proj.AddClip(Proj.Tracks[0], Media, 0, 10, 0);
|
||
|
||
Key := DefaultColorKey;
|
||
Key.Enabled := True;
|
||
Key.Similarity := 22;
|
||
Cl.ColorKey := Key;
|
||
Cl.Opacity := 0.5;
|
||
Cl.Volume := 0.3;
|
||
Tr := Cl.Transform;
|
||
Tr.Zoom := 0.4;
|
||
Tr.OffsetX := 0.7;
|
||
Cl.Transform := Tr;
|
||
Cl.GroupId := 'g1';
|
||
|
||
Timeline.Project := Proj;
|
||
Timeline.PixelsPerSecond := 100;
|
||
Timeline.Playhead := 4;
|
||
Timeline.SplitAtPlayhead(False, False);
|
||
|
||
CheckTrue('клипов стало два', Proj.Tracks[0].Count = 2);
|
||
if Proj.Tracks[0].Count <> 2 then
|
||
Exit;
|
||
|
||
Head := nil;
|
||
Tail := nil;
|
||
for I := 0 to Proj.Tracks[0].Count - 1 do
|
||
if Proj.Tracks[0][I].TlStart < 0.001 then
|
||
Head := Proj.Tracks[0][I]
|
||
else
|
||
Tail := Proj.Tracks[0][I];
|
||
CheckTrue('обе половины нашлись', (Head <> nil) and (Tail <> nil));
|
||
if (Head = nil) or (Tail = nil) then
|
||
Exit;
|
||
|
||
CheckTrue('ключ остался у хвоста', Tail.ColorKey.Enabled);
|
||
CheckTrue('и с тем же цветом', Tail.ColorKey.Color = Key.Color);
|
||
CheckTrue('и с тем же допуском', Tail.ColorKey.Similarity = 22);
|
||
CheckTrue('прозрачность осталась', Abs(Tail.Opacity - 0.5) < 0.001);
|
||
CheckTrue('громкость осталась', Abs(Tail.Volume - 0.3) < 0.001);
|
||
CheckTrue('кадрирование осталось',
|
||
(Abs(Tail.Transform.Zoom - 0.4) < 0.001) and
|
||
(Abs(Tail.Transform.OffsetX - 0.7) < 0.001));
|
||
CheckTrue('ключ остался и у головы', Head.ColorKey.Enabled);
|
||
{ Связки разные, и обе не пустые: иначе удаление одной половины
|
||
уносило бы вторую. }
|
||
CheckTrue('связка у половин разная и не пустая',
|
||
(Head.GroupId <> Tail.GroupId) and (Head.GroupId <> '') and
|
||
(Tail.GroupId <> ''));
|
||
CheckTrue('появление у хвоста снято', Abs(Tail.FadeIn) < 0.001);
|
||
finally
|
||
Timeline.Free;
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
{ Схлопывание дыры без мыши.
|
||
|
||
Ctrl+Shift+R искал дыру только на дорожке под указателем мыши, а руки в
|
||
этот момент на клавиатуре. Со стороны выглядело как «горячая клавиша не
|
||
работает»: команда молча ничего не делала. }
|
||
procedure CheckRippleWithoutMouse;
|
||
var
|
||
Proj: TProject;
|
||
Info: TMediaInfo;
|
||
Media: TMediaItem;
|
||
Timeline: TTimelineControl;
|
||
begin
|
||
WriteLn;
|
||
WriteLn('Схлопывание дыры с клавиатуры');
|
||
WriteLn;
|
||
|
||
Info := Default(TMediaInfo);
|
||
Info.Valid := True;
|
||
Info.Kind := mkVideo;
|
||
Info.Duration := 600;
|
||
Info.HasVideo := True;
|
||
Info.VideoCodec := 'hevc';
|
||
Info.Width := 1920;
|
||
Info.Height := 1080;
|
||
Info.FpsNum := 30;
|
||
Info.FpsDen := 1;
|
||
Info.PixFmt := 'yuv420p';
|
||
|
||
Proj := TProject.Create;
|
||
Timeline := TTimelineControl.Create(nil);
|
||
try
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
|
||
Proj.Master := Info;
|
||
{ Дыра с 5 по 12 секунду. }
|
||
Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 20, 5, 12);
|
||
|
||
Timeline.Project := Proj;
|
||
Timeline.PixelsPerSecond := 100;
|
||
Timeline.ActiveTrack := 0;
|
||
Timeline.Playhead := 8;
|
||
|
||
{ Мышь не над дорожками: так и бывает, когда жмут сочетание клавиш. }
|
||
CheckTrue('дыра схлопнута без мыши', Timeline.RippleCloseGap);
|
||
CheckTrue('второй клип придвинут к первому',
|
||
Abs(Proj.Tracks[0][1].TlStart - 5) < 0.001);
|
||
{ Второй раз схлопывать нечего — и об этом надо сказать, а не молчать. }
|
||
CheckTrue('повторный вызов честно отвечает «нечего»',
|
||
not Timeline.RippleCloseGap);
|
||
finally
|
||
Timeline.Free;
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
{ Копирование клипа: модель должна переносить всё, кроме места.
|
||
|
||
Само сочетание клавиш проверяется руками, а вот перенос свойств —
|
||
числами: именно из-за него копия отбивки или текстового блока была бы
|
||
бесполезной. }
|
||
procedure CheckClipCopy;
|
||
var
|
||
Proj: TProject;
|
||
Info: TMediaInfo;
|
||
Media: TMediaItem;
|
||
Src, Dst: TClip;
|
||
Key: TColorKey;
|
||
begin
|
||
WriteLn;
|
||
WriteLn('Копия клипа');
|
||
WriteLn;
|
||
|
||
Info := Default(TMediaInfo);
|
||
Info.Valid := True;
|
||
Info.Kind := mkVideo;
|
||
Info.Duration := 600;
|
||
Info.HasVideo := True;
|
||
Info.VideoCodec := 'hevc';
|
||
Info.Width := 1920;
|
||
Info.Height := 1080;
|
||
Info.FpsNum := 30;
|
||
Info.FpsDen := 1;
|
||
Info.PixFmt := 'yuv420p';
|
||
|
||
Proj := TProject.Create;
|
||
try
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
|
||
Src := Proj.AddClip(Proj.Tracks[0], Media, 30, 7, 5);
|
||
Src.Kind := ckText;
|
||
Src.Text := 'Отбивка';
|
||
Src.Volume := 0.4;
|
||
Src.Opacity := 0.6;
|
||
Key := DefaultColorKey;
|
||
Key.Enabled := True;
|
||
Src.ColorKey := Key;
|
||
Src.FadeIn := 1.25;
|
||
Src.EdgeOut := edPrecise;
|
||
Src.GroupId := 'g7';
|
||
|
||
Dst := TClip.Create;
|
||
try
|
||
Dst.CopyAllFrom(Src);
|
||
CheckTrue('вид клипа перенесён', Dst.Kind = ckText);
|
||
CheckTrue('текст перенесён', Dst.Text = 'Отбивка');
|
||
CheckTrue('файл и кусок исходника перенесены',
|
||
(Dst.MediaId = Src.MediaId) and (Abs(Dst.SrcIn - 30) < 0.001) and
|
||
(Abs(Dst.Duration - 7) < 0.001));
|
||
CheckTrue('края перенесены', Dst.EdgeOut = edPrecise);
|
||
CheckTrue('громкость и прозрачность перенесены',
|
||
(Abs(Dst.Volume - 0.4) < 0.001) and (Abs(Dst.Opacity - 0.6) < 0.001));
|
||
CheckTrue('ключ перенесён', Dst.ColorKey.Enabled);
|
||
CheckTrue('затухание перенесено', Abs(Dst.FadeIn - 1.25) < 0.001);
|
||
{ Место и связка — дело того, кто вставляет. }
|
||
CheckTrue('место не перенесено', Abs(Dst.TlStart) < 0.001);
|
||
CheckTrue('связка не перенесена', Dst.GroupId = '');
|
||
finally
|
||
Dst.Free;
|
||
end;
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
WriteLn('Свойства из файлов форм');
|
||
WriteLn;
|
||
|
||
CheckProp(TThemedButton, 'Icon');
|
||
CheckProp(TThemedButton, 'Down');
|
||
CheckProp(TThemedButton, 'Arrow');
|
||
CheckProp(TThemedButton, 'Caption');
|
||
CheckProp(TThemedButton, 'ShowHint');
|
||
|
||
CheckEnum(TypeInfo(TThemedIcon), 'tiSnap');
|
||
CheckEnum(TypeInfo(TThemedIcon), 'tiRipple');
|
||
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);
|
||
|
||
CheckPlayheadSnap;
|
||
CheckSplitKeepsSettings;
|
||
CheckRippleWithoutMouse;
|
||
CheckClipCopy;
|
||
|
||
WriteLn;
|
||
if Failed = 0 then
|
||
WriteLn('ВЕРДИКТ: все проверки пройдены')
|
||
else
|
||
begin
|
||
WriteLn('ВЕРДИКТ: не пройдено проверок: ', Failed);
|
||
Halt(1);
|
||
end;
|
||
end.
|