nlve/tests/lfmcheck/lfmcheck.lpr

{
  Проверка того, что свойства, записанные в файле формы, у наших
  элементов действительно есть.

  Зачем отдельно. Файл формы разбирается при запуске, а не при сборке:
  опечатка в имени свойства или в значении перечисления даёт не ошибку
  компиляции, а падение окна на старте. Здесь то же самое проверяется без
  окна — по сведениям о типах.
}
program lfmcheck;

{$mode objfpc}{$H+}

uses
  { Interfaces нужен, чтобы связалась вся LCL и заработала загрузка
    файлов форм. }
  Interfaces, Forms, Classes, SysUtils, Math, TypInfo, uTheme,
  uMediaProbe, uProject, 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;

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;

  WriteLn;
  if Failed = 0 then
    WriteLn('ВЕРДИКТ: все проверки пройдены')
  else
  begin
    WriteLn('ВЕРДИКТ: не пройдено проверок: ', Failed);
    Halt(1);
  end;
end.