4aiman
aba9bd57e4
Две беды у всех кнопок нижней полосы. Всплывающая подсказка появлялась прямо поверх кнопки, о которой рассказывает, и перехватывала щелчок: нажать кнопку было нельзя. Подсказка переехала в строку состояния — она в той же полосе, ничего не закрывает и меняется сразу после щелчка, не дожидаясь нового наведения. Строка состояния теперь занимает всё свободное место справа, пока рядом не показан ход работы, а самые длинные подсказки укорочены: раньше их обрезало на полуслове. Второй щелчок подряд виджетсет отдавал как двойной, и кнопка его не видела: быстрая очередь щелчков срабатывала через раз. У кнопки убран csDoubleClicks, а на случай, если двойной всё же дойдёт, он считается за обычный. Проверено: tests/lfmcheck, раздел «Кнопки нижней панели», и tests/buttonclicks.sh мышью на невидимом экране — по всем шести переключателям очереди из 1-5 щелчков отрабатываются полностью.
858 lines
32 KiB
ObjectPascal
858 lines
32 KiB
ObjectPascal
{
|
||
Проверка того, что свойства, записанные в файле формы, у наших
|
||
элементов действительно есть.
|
||
|
||
Зачем отдельно. Файл формы разбирается при запуске, а не при сборке:
|
||
опечатка в имени свойства или в значении перечисления даёт не ошибку
|
||
компиляции, а падение окна на старте. Здесь то же самое проверяется без
|
||
окна — по сведениям о типах.
|
||
}
|
||
program lfmcheck;
|
||
|
||
{$mode objfpc}{$H+}
|
||
|
||
uses
|
||
{ Interfaces нужен, чтобы связалась вся LCL и заработала загрузка
|
||
файлов форм. }
|
||
Interfaces, Forms, Controls, 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);
|
||
|
||
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;
|
||
|
||
{ Общая заготовка: проект с одним файлом и заданной сеткой кадров. }
|
||
function TestInfo: TMediaInfo;
|
||
begin
|
||
Result := Default(TMediaInfo);
|
||
Result.Valid := True;
|
||
Result.Kind := mkVideo;
|
||
Result.Duration := 600;
|
||
Result.HasVideo := True;
|
||
Result.VideoCodec := 'hevc';
|
||
Result.Width := 1920;
|
||
Result.Height := 1080;
|
||
Result.FpsNum := 30;
|
||
Result.FpsDen := 1;
|
||
Result.PixFmt := 'yuv420p';
|
||
end;
|
||
|
||
{ Выделение областью.
|
||
|
||
Проверяется расчётом, а не мышью: сама протяжка проверена на невидимом
|
||
экране, а вот что попадает в рамку — числами, иначе первая же правка
|
||
захвата пройдёт незамеченной. }
|
||
procedure CheckRubberBand;
|
||
var
|
||
Proj: TProject;
|
||
Info: TMediaInfo;
|
||
Media: TMediaItem;
|
||
Timeline: TTimelineControl;
|
||
begin
|
||
WriteLn;
|
||
WriteLn('Выделение областью');
|
||
WriteLn;
|
||
|
||
Info := TestInfo;
|
||
Proj := TProject.Create;
|
||
Timeline := TTimelineControl.Create(nil);
|
||
try
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
Proj.AddTrack('V2');
|
||
Proj.AddTrack('V3');
|
||
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
|
||
Proj.Master := Info;
|
||
{ V1: клип 0..5 и клип 20..25. V2: длинный клип 0..30.
|
||
V3: клип 0..5 — дорожка вне рамки. }
|
||
Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 100, 5, 20);
|
||
Proj.AddClip(Proj.Tracks[1], Media, 0, 30, 0);
|
||
Proj.AddClip(Proj.Tracks[2], Media, 0, 5, 0);
|
||
|
||
Timeline.Project := Proj;
|
||
Timeline.PixelsPerSecond := 100;
|
||
|
||
{ Рамка по дорожкам 0 и 1, время 2..10. }
|
||
Timeline.SelectInRange(2, 10, 0, 1, False);
|
||
CheckTrue('задетый клип выделен', Proj.Tracks[0][0].Selected);
|
||
CheckTrue('клип за рамкой не выделен', not Proj.Tracks[0][1].Selected);
|
||
CheckTrue('длинный клип задет и выделен', Proj.Tracks[1][0].Selected);
|
||
CheckTrue('чужая дорожка не тронута', not Proj.Tracks[2][0].Selected);
|
||
|
||
{ Рамку тянут и справа налево — это та же рамка. }
|
||
Timeline.SelectInRange(25, 18, 0, 0, False);
|
||
CheckTrue('обратная протяжка выделила второй клип',
|
||
Proj.Tracks[0][1].Selected);
|
||
CheckTrue('прежнее выделение снято', not Proj.Tracks[0][0].Selected);
|
||
|
||
{ С Ctrl прежнее выделение остаётся. }
|
||
Timeline.SelectInRange(2, 4, 0, 0, True);
|
||
CheckTrue('добавление сохранило прежнее', Proj.Tracks[0][1].Selected);
|
||
CheckTrue('добавление выделило новое', Proj.Tracks[0][0].Selected);
|
||
|
||
{ Рамка, не задевшая ничего, просто снимает выделение. }
|
||
Timeline.SelectInRange(6, 8, 0, 0, False);
|
||
CheckTrue('пустая рамка ничего не выделила',
|
||
Proj.SelectedCount = 0);
|
||
finally
|
||
Timeline.Free;
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
{ Рез по курсору режет все дорожки.
|
||
|
||
Раньше резалась только дорожка под указателем мыши, и стоило указателю
|
||
оказаться над пустым местом, как клавиша S молча не делала ничего. }
|
||
procedure CheckSplitAllTracks;
|
||
var
|
||
Proj: TProject;
|
||
Info: TMediaInfo;
|
||
Media: TMediaItem;
|
||
Timeline: TTimelineControl;
|
||
begin
|
||
WriteLn;
|
||
WriteLn('Рез по курсору на всех дорожках');
|
||
WriteLn;
|
||
|
||
Info := TestInfo;
|
||
Proj := TProject.Create;
|
||
Timeline := TTimelineControl.Create(nil);
|
||
try
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
Proj.AddTrack('V2');
|
||
Proj.AddTrack('A1');
|
||
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
|
||
Proj.Master := Info;
|
||
{ Клипы 0..10 на первой и третьей дорожках, на второй — 20..30:
|
||
под курсором её нет, и резать там нечего. }
|
||
Proj.AddClip(Proj.Tracks[0], Media, 0, 10, 0);
|
||
Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 20);
|
||
Proj.AddClip(Proj.Tracks[2], Media, 0, 10, 0);
|
||
|
||
Timeline.Project := Proj;
|
||
Timeline.PixelsPerSecond := 100;
|
||
Timeline.ActiveTrack := 1;
|
||
Timeline.Playhead := 4;
|
||
|
||
CheckTrue('разрезаны обе задетые дорожки',
|
||
Timeline.SplitAtPlayhead(False) = 2);
|
||
CheckTrue('на первой дорожке два клипа', Proj.Tracks[0].Count = 2);
|
||
CheckTrue('на звуковой дорожке два клипа', Proj.Tracks[2].Count = 2);
|
||
CheckTrue('нетронутая дорожка осталась с одним клипом',
|
||
Proj.Tracks[1].Count = 1);
|
||
|
||
{ Курсор ровно на стыке — резать нечего, и клипов нулевой длины
|
||
появиться не должно. }
|
||
CheckTrue('на стыке рез отвечает нулём',
|
||
Timeline.SplitAtPlayhead(False) = 0);
|
||
CheckTrue('лишних клипов не появилось',
|
||
(Proj.Tracks[0].Count = 2) and (Proj.Tracks[2].Count = 2));
|
||
finally
|
||
Timeline.Free;
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
{ Схлопывание дыры не требует попадать в тайминг.
|
||
|
||
Курсор может стоять не точно на краю дыры: во время воспроизведения он
|
||
останавливается там, где успел, а после перезагрузки предпросмотра —
|
||
где оказался плеер. Раньше дыра при этом не находилась. }
|
||
procedure CheckGapTolerance;
|
||
var
|
||
Proj: TProject;
|
||
Info: TMediaInfo;
|
||
Media: TMediaItem;
|
||
Timeline: TTimelineControl;
|
||
begin
|
||
WriteLn;
|
||
WriteLn('Схлопывание дыры с допуском');
|
||
WriteLn;
|
||
|
||
Info := TestInfo;
|
||
Proj := TProject.Create;
|
||
Timeline := TTimelineControl.Create(nil);
|
||
try
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
Proj.AddTrack('A1');
|
||
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);
|
||
Proj.AddClip(Proj.Tracks[1], Media, 0, 17, 0);
|
||
|
||
Timeline.Project := Proj;
|
||
Timeline.PixelsPerSecond := 100;
|
||
{ Указатель и выбранная дорожка — звуковая, дыры на ней нет. }
|
||
Timeline.ActiveTrack := 1;
|
||
{ Курсор не в дыре, а на четыре сотых раньше её начала. }
|
||
Timeline.Playhead := 4.96;
|
||
|
||
CheckTrue('дыра найдена, хотя курсор чуть раньше края',
|
||
Timeline.RippleCloseGap);
|
||
CheckTrue('названа дорожка, где схлопнули',
|
||
Timeline.LastGapTrack = 'V1');
|
||
CheckTrue('клип придвинут вплотную',
|
||
Abs(Proj.Tracks[0][1].TlStart - 5) < 0.001);
|
||
|
||
{ Курсор далеко от дыры — ничего не двигаем. }
|
||
Proj.Tracks[0][1].TlStart := 12;
|
||
Timeline.Playhead := 2;
|
||
CheckTrue('далеко от дыры — не схлопываем',
|
||
not Timeline.RippleCloseGap);
|
||
finally
|
||
Timeline.Free;
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
{ Починка проекта: клипы на кадровую сетку.
|
||
|
||
Между кадрами времени нет, и монтаж не должен хранить доли кадра:
|
||
картинка выйдет целым числом кадров, звук наберётся до отсчёта, и
|
||
округление разведёт их. Правка двигает клип не больше чем на полкадра,
|
||
но сама сетка обязана получиться ровной. }
|
||
procedure CheckFrameGridRepair;
|
||
var
|
||
Proj: TProject;
|
||
Info: TMediaInfo;
|
||
Media: TMediaItem;
|
||
Step: Double;
|
||
I: Integer;
|
||
Clip: TClip;
|
||
OnGrid: Boolean;
|
||
begin
|
||
WriteLn;
|
||
WriteLn('Починка: клипы на кадровую сетку');
|
||
WriteLn;
|
||
|
||
Info := TestInfo;
|
||
{ 59.94 к/с — та самая сетка, на которой доли кадра особенно заметны. }
|
||
Info.FpsNum := 60000;
|
||
Info.FpsDen := 1001;
|
||
|
||
Proj := TProject.Create;
|
||
try
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
|
||
Proj.Master := Info;
|
||
Step := Info.FpsDen / Info.FpsNum;
|
||
|
||
{ Времена как в настоящем проекте: ни одно не попадает на кадр. }
|
||
Proj.AddClip(Proj.Tracks[0], Media, 48.558521, 2.457599, 0);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 56.054198, 1.469934, 2.457599);
|
||
{ И клип короче кадра: его нельзя схлопнуть в ничто. }
|
||
Proj.AddClip(Proj.Tracks[0], Media, 62.710196, 0.004, 3.927533);
|
||
|
||
CheckTrue('все три клипа мимо сетки', Proj.OffGridClipCount = 3);
|
||
CheckTrue('починка подвинула три клипа', Proj.SnapClipsToFrameGrid = 3);
|
||
CheckTrue('мимо сетки не осталось', Proj.OffGridClipCount = 0);
|
||
|
||
OnGrid := True;
|
||
for I := 0 to Proj.Tracks[0].Count - 1 do
|
||
begin
|
||
Clip := Proj.Tracks[0][I];
|
||
if Abs(Clip.TlStart / Step - Round(Clip.TlStart / Step)) > 0.001 then
|
||
OnGrid := False;
|
||
if Abs(Clip.Duration / Step - Round(Clip.Duration / Step)) > 0.001 then
|
||
OnGrid := False;
|
||
if Abs(Clip.SrcIn / Step - Round(Clip.SrcIn / Step)) > 0.001 then
|
||
OnGrid := False;
|
||
end;
|
||
CheckTrue('начала, длины и точки входа — целые кадры', OnGrid);
|
||
|
||
CheckTrue('короткий клип остался длиной в кадр',
|
||
Abs(Proj.Tracks[0][2].Duration - Step) < 0.0001);
|
||
CheckTrue('клипы не разъехались больше чем на полкадра',
|
||
Abs(Proj.Tracks[0][0].TlStart - 0) < Step);
|
||
CheckTrue('повторная починка ничего не двигает',
|
||
Proj.SnapClipsToFrameGrid = 0);
|
||
finally
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
{ Рез и курсор: где режет S и куда после этого встаёт курсор.
|
||
|
||
Раньше курсор оставался там, где был, а рез мог попасть на долю кадра.
|
||
Теперь рез кладётся на кадровую сетку, а курсор встаёт ровно на место
|
||
реза — с ним и работают дальше. }
|
||
procedure CheckSplitAndPlayhead;
|
||
var
|
||
Proj: TProject;
|
||
Info: TMediaInfo;
|
||
Media: TMediaItem;
|
||
Timeline: TTimelineControl;
|
||
Step: Double;
|
||
I, N: Integer;
|
||
begin
|
||
WriteLn;
|
||
WriteLn('Рез, промежуток и курсор');
|
||
WriteLn;
|
||
|
||
Info := TestInfo;
|
||
Info.FpsNum := 60000;
|
||
Info.FpsDen := 1001;
|
||
Step := Info.FpsDen / Info.FpsNum;
|
||
|
||
Proj := TProject.Create;
|
||
Timeline := TTimelineControl.Create(nil);
|
||
try
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
Proj.AddTrack('A1');
|
||
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
|
||
Proj.Master := Info;
|
||
{ По два клипа на каждой дорожке, встык: 0..10 и 10..20. }
|
||
Proj.AddClip(Proj.Tracks[0], Media, 0, 10, 0);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 20, 10, 10);
|
||
Proj.AddClip(Proj.Tracks[1], Media, 0, 10, 0);
|
||
Proj.AddClip(Proj.Tracks[1], Media, 20, 10, 10);
|
||
|
||
Timeline.Project := Proj;
|
||
Timeline.PixelsPerSecond := 100;
|
||
|
||
{ Рез по курсору: место кладётся на кадр, курсор встаёт на него. }
|
||
Timeline.Playhead := 3.3177;
|
||
CheckTrue('разрезаны обе дорожки', Timeline.SplitAtPlayhead(False) = 2);
|
||
CheckTrue('курсор встал на место реза',
|
||
Abs(Timeline.Playhead - Round(3.3177 / Step) * Step) < 0.0001);
|
||
CheckTrue('курсор на кадровой сетке',
|
||
Abs(Timeline.Playhead / Step - Round(Timeline.Playhead / Step)) < 0.001);
|
||
N := 0;
|
||
for I := 0 to Proj.Tracks[0].Count - 1 do
|
||
if Abs(Proj.Tracks[0][I].TlStart - Timeline.Playhead) < 0.0001 then
|
||
Inc(N);
|
||
CheckTrue('рез пришёлся ровно туда, где курсор', N = 1);
|
||
|
||
{ Промежуток по времени: рез по обоим краям, курсор — на начало. }
|
||
Timeline.SelectionMode := smRange;
|
||
Timeline.SetSelectionRange(12.13, 16.77);
|
||
CheckTrue('промежуток отмечен', Timeline.HasSelectionRange);
|
||
CheckTrue('разрезано по два клипа на дорожке',
|
||
Timeline.SplitAtPlayhead(False) = 4);
|
||
CheckTrue('курсор — на начале промежутка',
|
||
Abs(Timeline.Playhead - Timeline.RangeFrom) < 0.0001);
|
||
|
||
N := 0;
|
||
for I := 0 to Proj.Tracks[1].Count - 1 do
|
||
if (Abs(Proj.Tracks[1][I].TlStart - Timeline.RangeFrom) < 0.0001) or
|
||
(Abs(Proj.Tracks[1][I].TlStart - Timeline.RangeTo) < 0.0001) then
|
||
Inc(N);
|
||
CheckTrue('на звуковой дорожке резы по обоим краям', N = 2);
|
||
|
||
{ После реза выделена середина — то, что между краями: следующим
|
||
действием её обычно удаляют. }
|
||
N := 0;
|
||
for I := 0 to Proj.Tracks[0].Count - 1 do
|
||
if Proj.Tracks[0][I].Selected then
|
||
begin
|
||
Inc(N);
|
||
CheckTrue('выделенное лежит внутри промежутка',
|
||
(Proj.Tracks[0][I].TlStart >= Timeline.RangeFrom - 0.0001) and
|
||
(Proj.Tracks[0][I].TlEnd <= Timeline.RangeTo + 0.0001));
|
||
end;
|
||
CheckTrue('на дорожке картинки выделена одна середина', N = 1);
|
||
|
||
{ Смена режима снимает промежуток: резать по невидимой метке нельзя. }
|
||
Timeline.SelectionMode := smClips;
|
||
CheckTrue('смена режима сняла промежуток',
|
||
not Timeline.HasSelectionRange);
|
||
|
||
{ Удаление со схлопыванием: курсор встаёт на место стыка. }
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
|
||
Proj.Master := Info;
|
||
Proj.RippleEnabled := True;
|
||
Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 10, 5, 5);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 20, 5, 10);
|
||
Timeline.Playhead := 0;
|
||
Proj.Tracks[0][1].Selected := True;
|
||
Timeline.DeleteSelected;
|
||
CheckTrue('после удаления клипов стало два', Proj.Tracks[0].Count = 2);
|
||
CheckTrue('курсор — на месте вырезанного куска',
|
||
Abs(Timeline.Playhead - 5) < 0.0001);
|
||
CheckTrue('хвост придвинут к стыку',
|
||
Abs(Proj.Tracks[0][1].TlStart - 5) < 0.0001);
|
||
|
||
{ Схлопывание дыры с клавиатуры: курсор тоже на стык. }
|
||
Proj.Clear;
|
||
Proj.AddTrack('V1');
|
||
Media := Proj.AddMedia('/несуществующий/видео.mp4', Info);
|
||
Proj.Master := Info;
|
||
Proj.AddClip(Proj.Tracks[0], Media, 0, 5, 0);
|
||
Proj.AddClip(Proj.Tracks[0], Media, 20, 5, 12);
|
||
Timeline.ActiveTrack := 0;
|
||
Timeline.Playhead := 8;
|
||
CheckTrue('дыра схлопнута', Timeline.RippleCloseGap);
|
||
CheckTrue('курсор — на стыке', Abs(Timeline.Playhead - 5) < 0.0001);
|
||
finally
|
||
Timeline.Free;
|
||
Proj.Free;
|
||
end;
|
||
end;
|
||
|
||
{ Кнопка нижней панели и быстрые щелчки.
|
||
|
||
Второй щелчок подряд оконная библиотека отдаёт не как щелчок, а как
|
||
двойной — и обработчик кнопки его не видел. Человек нажимал кнопку
|
||
дважды, а срабатывало один раз.
|
||
|
||
Проверяется двумя способами: у кнопки нет csDoubleClicks (тогда
|
||
двойных щелчков к ней вообще не приходит), и даже если двойной
|
||
придёт, он считается за щелчок. }
|
||
type
|
||
TButtonProbe = class(TThemedButton)
|
||
public
|
||
procedure Twice;
|
||
end;
|
||
|
||
procedure TButtonProbe.Twice;
|
||
begin
|
||
DblClick;
|
||
end;
|
||
|
||
var
|
||
ClickCount: Integer = 0;
|
||
|
||
type
|
||
TClickCounter = class
|
||
procedure Clicked(Sender: TObject);
|
||
end;
|
||
|
||
procedure TClickCounter.Clicked(Sender: TObject);
|
||
begin
|
||
Inc(ClickCount);
|
||
end;
|
||
|
||
procedure CheckButtonClicks;
|
||
var
|
||
Btn: TButtonProbe;
|
||
Counter: TClickCounter;
|
||
begin
|
||
WriteLn;
|
||
WriteLn('Кнопки нижней панели');
|
||
WriteLn;
|
||
|
||
Counter := TClickCounter.Create;
|
||
Btn := TButtonProbe.Create(nil);
|
||
try
|
||
Btn.OnClick := @Counter.Clicked;
|
||
CheckTrue('двойные щелчки кнопке не приходят',
|
||
not (csDoubleClicks in Btn.ControlStyle));
|
||
ClickCount := 0;
|
||
Btn.Twice;
|
||
CheckTrue('двойной щелчок считается за щелчок', ClickCount = 1);
|
||
finally
|
||
Btn.Free;
|
||
Counter.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;
|
||
CheckRubberBand;
|
||
CheckFrameGridRepair;
|
||
CheckSplitAndPlayhead;
|
||
CheckSplitAllTracks;
|
||
CheckGapTolerance;
|
||
CheckButtonClicks;
|
||
|
||
WriteLn;
|
||
if Failed = 0 then
|
||
WriteLn('ВЕРДИКТ: все проверки пройдены')
|
||
else
|
||
begin
|
||
WriteLn('ВЕРДИКТ: не пройдено проверок: ', Failed);
|
||
Halt(1);
|
||
end;
|
||
end.
|