4aiman
86c28a3308
Рамка выделения: протяжка по пустому месту дорожек обтягивает клипы, Delete убирает всё, что она задела. Щелчок без движения по-прежнему ставит курсор. Рез по курсору (S) режет все дорожки, а не ту, что под указателем мыши: стоило указателю оказаться над пустой дорожкой, и клавиша молча не делала ничего. Теперь рез отвечает числом разрезанных клипов. Курсор после правки монтажа улетал в конец: при перезагрузке списка кусков mpv сбрасывает отсчёт времени, программа ждала перемотки, не дожидалась и подтягивала курсор к плееру. На паузе курсор теперь остаётся там, куда его поставил человек. Это и делало Ctrl+Shift+R неудобным: после каждого схлопывания приходилось целиться заново. Схлопывание дыры ищет её с допуском и по всем дорожкам, а не только под мышью, и называет дорожку в строке состояния. Ответ на команду держится в строке состояния несколько секунд: раньше его через долю секунды затирало сообщение о пересборке предпросмотра. Проверки: рамка, рез всех дорожек, допуск при схлопывании (lfmcheck).
609 lines
22 KiB
ObjectPascal
609 lines
22 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);
|
||
|
||
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;
|
||
|
||
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;
|
||
CheckSplitAllTracks;
|
||
CheckGapTolerance;
|
||
|
||
WriteLn;
|
||
if Failed = 0 then
|
||
WriteLn('ВЕРДИКТ: все проверки пройдены')
|
||
else
|
||
begin
|
||
WriteLn('ВЕРДИКТ: не пройдено проверок: ', Failed);
|
||
Halt(1);
|
||
end;
|
||
end.
|