вторник, 16 апреля 2013 г.

О тестах и специально оборудованных "контрольных точках"

Начну с лирического отступления.

Когда-то у меня был компьютер БК-0010.01. Купленный за бешеные 500 рублей.

Но он не подключался к моему телевизору. У телевизора не было низкочастотного входа. "Для видеомагнитофонов".

Мы с папой решали эту проблему. И под чутким руководством папы я узнал, что в любой радио-телевизионной технике есть "контрольные точки". Это такие "штырьки" на плате к которым подключаются либо датчики (например осциллограф) либо источники сигнала (например генератор частоты).

Нужная контрольная точка была найдена. Она находилась после каскада преобразования высокой частоты в низкую. И называлась "как сейчас помню" КТ-26.

Мы с папой припаяли к ней разьём и подключили компьютер.

И я вступил в счастливый мир "домашних компьютеров". И я смог на практике ознакомиться с архитектурой PDP-11.

Позже, освоив описанную технику, я проделал несколько раз этот "трюк" самостоятельно, без папы, с компьютерами и телевизорами моих друзей. И все были счастливы. Главное было взять схему от телевизора и найти на ней контрольную точку с нужными параметрами. Так сказать - "подобрать нужный разъём к нужному ИНТЕРФЕЙСУ".

Теперь к делу.

Когда я "всерьёз" занялся "unit"-тестированием, то я вспомнил, про эту технику и решил применить её на практике. Благо она казалась очень удобной.

Теперь постараюсь привести пример.

К сожалению - он некомпилируемый. Ибо весь код я раскрыть не могу (по названным ниже причинам - http://18delphi.blogspot.com/2013/04/disclaimer.html). Но я надеюсь, что идея станет понятной. Из того отрывка кода, который я приведу. Он - не простой. Не на три строчки. Но очень по-моему показательный.

Итак.

Вернёмся к первому моему посту - http://18delphi.blogspot.com/2013/03/blog-post.html

Там я в красках рассказывал, что мой "первый тест" в технологии DUnit был тест на проверку "предварительного просмотра печати". Это - почти правда.

Теперь давайте посмотрим как он выглядит:

Собственно тест:

unit PreviewTestBefore;

// Generated from UML model, root element: <<TestCase::Class>> Shared Delphi Operations For Tests::TestFormsTest::Everest::TPreviewTestBefore235875079
//
// Тест построения Preview

interface

uses
  afwInterfaces,
  TextEditorVisitor,
  evHAFPainterEx,
  nevShapesPaintedSpy,
  afwPreviewPageSpy,
  l3Interfaces,
  PrimTextLoad_Form,
  nevTools,
  afwPreviewPage
  ;

type
 TPreviewTest = {abstract} class(TTextEditorVisitor, IafwPreviewPanel, InevShapesLogger, IafwPagesLogger)
  {* Тест построения Preview }
 private
 // private fields
   f_Done : Boolean;
   f_Now : Cardinal;
    {* Время начала теста}
 protected
 // realized methods
   procedure SetCurrentPage(aValue: Integer);
   procedure Invalidate;
   procedure Done;
   procedure pm_SetPreviewCanvas(const aValue: IafwPreviewCanvas);
   function pm_GetPainted: Boolean;
   procedure DoVisit(aForm: TPrimTextLoadForm); override;
     {* Обработать текст }
   function OpenLog(const aView: InevView): AnsiString;
   procedure CloseLog(const aLogName: AnsiString);
   function LogScreen(const aView: InevView): Boolean;
   procedure LogPage(aPage: TafwPreviewPage;
     aCounter: Boolean);
   function ShouldStop: Boolean;
 protected
 // overridden protected methods
   procedure InitFields; override;
   function FileForOutput: AnsiString; override;
     {* Стандартный файл для вывода, для текущего теста }
   function GetNormalFontSize: Integer; override;
     {* Возвращает размер шрифта стиля "Нормальный". 0 - по-умолчанию }
   function GetFolder: AnsiString; override;
     {* Папка в которую входит тест }
   function RaiseIfEtalonCreated: Boolean; override;
 protected
 // protected fields
   f_LogNumber : Integer;
   f_CurrentOutput : AnsiString;
 protected
 // protected methods
   function PageFileName(aNumber: Integer;
     aWidthNumber: Integer;
     aCounter: Boolean;
     anEtalon: Boolean): AnsiString;
     {* Имя файла для сохранения страницы }
   procedure ReadColontituls(var theColontituls: TevColontituls); virtual;
   function GetHAFFontSize: Integer; virtual;
     {* Размер колонтитулов. 0 - по-умолчанию }
 end;//TPreviewTest

implementation

uses
  Windows,
  evStyleInterface,
  evdStyles,
  SysUtils,
  vtPreviewPanel,
  Controls,
  Forms,
  l3String,
  l3Stream,
  l3Types,
  imageenio,
  l3FileUtils,
  Graphics,
  Classes,
  KTestRunner,
  evPreviewForTestsTuning,
  l3Defaults,
  l3CanvasPrim,
  TestFrameWork
  ;

// start class TPreviewTestBefore

function TPreviewTest.PageFileName(aNumber: Integer;
  aWidthNumber: Integer;
  aCounter: Boolean;
  anEtalon: Boolean): AnsiString;
var
 l_Et : String;
 l_C  : String;
 l_WN : String;
begin
 if aCounter then
  l_C := 'C_'
 else
  l_C := '';
 if (aWidthNumber = 0) then
  l_WN := ''
 else
  l_WN := '.' + l3LeftPadChar(IntToStr(aWidthNumber), 2, '0');
 if anEtalon then
  l_Et := EtalonSuffix
 else
  l_Et := ''; 
 Result := Format('%s%s.%s%s%s%s.png',
                  [OutputPath,
                   KPage,
                   l_C,
                   l3LeftPadChar(IntToStr(aNumber), 4, '0'),
                   l_WN,
                   l_Et
                  ]);
end;//TPreviewTest.PageFileName

procedure TPreviewTest.ReadColontituls(var theColontituls: TevColontituls);
begin
 // - ничего не делаем, всё по-умолчанию
end;//TPreviewTest.ReadColontituls

function TPreviewTest.GetHAFFontSize: Integer;
begin
 Result := 0; 
end;//TPreviewTest.GetHAFFontSize

procedure TPreviewTest.SetCurrentPage(aValue: Integer);
begin
 // - ничего не делаем
end;//TPreviewTest.SetCurrentPage

procedure TPreview.Invalidate;
begin
 // - ничего не делаем
 CheckTimeout(f_Now, 120 * 60 * 1000)
 // - проверяем, что зациклились
end;//TPreviewTest.Invalidate

procedure TPreviewTest.Done;
begin
 f_Done := true;
end;//TPreviewTest.Done

procedure TPreviewTest.pm_SetPreviewCanvas(const aValue: IafwPreviewCanvas);
begin
 // - ничего не делаем
end;//TPreviewTest.pm_SetPreviewCanvas

function TPreviewTest.pm_GetPainted: Boolean;
begin
 Result := false;
end;//TPreviewTest.pm_GetPainted

procedure TPreviewTest.DoVisit(aForm: TPrimTextLoadForm);
var 
 PP : TvtPreviewPanel;
 l_OnReadColontituls : TevReadColontitulsEvent;
 l_SI : TevStyleInterface;
 l_Size : Integer;
 l_NewSize : Integer;
begin
   TafwPreviewPageSpy.Instance.SetLogger(Self);
   try
    TnevShapesPaintedSpy.Instance.SetLogger(Self);
    try
     l_SI := TevStyleInterface.Make;
     try
      l_SI.SelectStyle(ev_saHFRight);
      l_NewSize := GetHAFFontSize;
      l_Size := l_SI.Font.Size;
      try
       if (l_NewSize > 0) then
       begin
        l_SI.SelectStyle(ev_saHFLeft);
        l_SI.Font.Size := l_NewSize;
        l_SI.SelectStyle(ev_saHFRight);
        l_SI.Font.Size := l_NewSize;
       end;//l_NewSize > 0
       l_OnReadColontituls := g_OnReadColontituls;
       try
        g_OnReadColontituls := Self.ReadColontituls;
        // --------------
        // Тут идёт код, который надо раскомментировать если хочется посмотреть
        // на результаты построения preview
    (*    try
         PP := TvtPreviewPanel.Create(aForm);
         PP.Align := alClient;
         PP.Parent := aForm;
         PP.Preview := aForm.Text.Preview;
         PP.ZoomToPage(1,1,true);
        except
        end;//try..except
        repeat
         try
          Application.ProcessMessages;
         except
         end;//try..except
        until Application.Terminated;
        Exit;*)
        // --------------
        StartTimer;
        try
         f_Now := GetTickCount;
         aForm.Text.Preview.Update(Self);
        finally
         StopTimer('Preview.Update');
        end;//try..finally
       finally
        g_OnReadColontituls := l_OnReadColontituls;
       end;//try..finally
       Check(f_Done);
      finally
       l_SI.SelectStyle(ev_saHFLeft);
       l_SI.Font.Size := l_Size;
       l_SI.SelectStyle(ev_saHFRight);
       l_SI.Font.Size := l_Size;
      end;//try..finally
     finally
      FreeAndNil(l_SI);
     end;//try..finally
    finally
     TnevShapesPaintedSpy.Instance.RemoveLogger(Self);
    end;//try..finally
   finally
    TafwPreviewPageSpy.Instance.RemoveLogger(Self);
   end;//try..finally
end;//TPreviewTest.DoVisit

function TPreviewTest.OpenLog(const aView: InevView): AnsiString;
var
 l_Cnv : InevInfoCanvas;
 l_C : String;
 l_WN : String;
 l_Page : Integer;

 procedure MakeName;
 begin//MakeName
  Result := Format('%s%s.%s%s%s.shapes',
                   [OutputPath,
                    KPage,
                    l_C,
                    l3LeftPadChar(IntToStr(l_Page), 4, '0'),
                    l_WN
                   ]);
 end;//MakeName

begin
 //Inc(f_LogNumber);
 l_Cnv := aView.Metrics.InfoCanvas;
 if l_Cnv.IsPagesCounter then
  l_C := 'C_'
 else
  l_C := '';
 if (f_LogNumber = 0) then
  l_WN := ''
 else
  l_WN := '.' + l3LeftPadChar(IntToStr(f_LogNumber), 2, '0');
 f_LogNumber := l_Cnv.PageWidthNumber;
 l_Page := l_Cnv.PageNumber;
 if (l_Page > 1) then
  Dec(l_Page)
 else
  Assert(l_Page = 1);
 MakeName;
 //Result := OutputPath + KPage + '.' + l3LeftPadChar(IntToStr(f_LogNumber), 4, '0') + '.shapes';
 if (Result = f_CurrentOutput) then
 begin
  Inc(l_Page);
  MakeName;
 end;//Result = f_CurrentOutput
 f_CurrentOutput := Result;
end;//TPreviewTest.OpenLog

procedure TPreviewTest.CloseLog(const aLogName: AnsiString);
var
 l_N : String;
 l_Extra : String;
 l_Counter : Boolean;
begin
 l_N := ExtractFileName(aLogName);
 l_Counter := (Pos('.C_', l_N) > 0);
 if l_Counter then
  l_Extra := ''
 else
  l_Extra := ChangeFileExt(l_N, '.png');
 CheckOutputWithInput(ChangeFileExt(l_N, EtalonSuffix + '.shapes'),
                      #0,
                      l_Extra,
                      not l_Counter);
end;//TPreviewTest.CloseLog

function TPreviewTest.LogScreen(const aView: InevView): Boolean;
begin
 with aView.Metrics.InfoCanvas do
  Result := Printing AND not IsVirtual;
end;//TPreviewTest.LogScreen

procedure TPreviewTest.LogPage(aPage: TafwPreviewPage;
  aCounter: Boolean);
var
 l_EN  : String;
 l_N   : String;
 l_IO : TImageEnIO;
 l_B  : Graphics.TBitmap;
 l_CVSPath : String;
 l_CVS : String;
begin
 if aCounter then
  Exit;
 if (aPage.PageNumber <= 0) then
  Exit; 
 l_EN := PageFileName(aPage.PageNumber, aPage.PageWidthNumber, aCounter, true);
 l_N := PageFileName(aPage.PageNumber, aPage.PageWidthNumber, aCounter, false);
 l_IO := TImageEnIO.Create(nil);
 try
  l_B := Graphics.TBitmap.Create;
  try
   l_B.PixelFormat := pf24bit;
   l_B.Width := Trunc(IafwPreviewPage(aPage).GetMMWidth * 0.01 * 96 / 25.4);
   l_B.Height := Trunc(IafwPreviewPage(aPage).GetMMHeight * 0.01 * 96 / 25.4);
   IafwPreviewPage(aPage).DrawTo(Rect(0, 0, l_B.Width, l_B.Height), l_B);
   l_IO.Bitmap := l_B;
   l_IO.Params.BitsPerSample := 8;
   l_IO.Params.SamplesPerPixel := 1;
   l_IO.SaveToFilePNG(l_N);
  finally
   FreeAndNil(l_B);
  end;//try..finally
 finally
  FreeAndNil(l_IO);
 end;//try..finally
 if not IsWritingToK then
 begin
  if not FileExists(l_EN) then
   CopyFile(l_N, l_EN);
  if not IsFakeCVS then
  begin
   l_CVSPath := g_CVSPath + '\' + TestSetFolderName + '\';
   if DirectoryExists(l_CVSPath) then
   begin
    l_CVS := l_CVSPath + ExtractFileName(l_EN);
    if not FileExists(l_CVS) then
    begin
     CopyFile(l_N, l_CVS);
     ToLog(Format('Сделан эталон для помещения в CVS - "%s"', [l_CVS]));
    end;//not FileExists(l_CVS)
   end;//DirectoryExists(l_CVSPath)
  end;//not IsFakeCVS
 end;//not IsWritingToK
end;//TPreviewTest.LogPage

procedure TPreviewTest.InitFields;
begin
 inherited;
 f_LogNumber := 0;
 f_CurrentOutput := '';
end;//TPreviewTest.InitFields

function TPreviewTest.FileForOutput: AnsiString;
begin
 Assert(f_CurrentOutput <> '');
 Result := f_CurrentOutput;
end;//TPreviewTest.FileForOutput

function TPreviewTest.GetNormalFontSize: Integer;
begin
 Result := 12;
end;//TPreviewTest.GetNormalFontSize

function TPreviewTest.RaiseIfEtalonCreated: Boolean;
begin
 Result := false;
end;//TPreviewTest.RaiseIfEtalonCreated

end.

Тест реализует интерфейсы IafwPreviewPanel, InevShapesLogger, IafwPagesLogger и подключается к "разьёму" (контрольной точке) TnevShapesPaintedSpy и разъёму TafwPreviewPageSpy.

Интерфейсы выглядят так:
 IafwPreviewPanel = interface(IafwBase)
  {* Панель Print-preview. }
   ['{2DF654AF-58CD-4D9D-8F24-E3696D42EB3A}']
   procedure pm_SetPreviewCanvas(const aValue: IafwPreviewCanvas);
   function pm_GetPainted: Boolean;
   procedure SetCurrentPage(aValue: Integer);
   procedure Invalidate;
   procedure Done;
   property PreviewCanvas: IafwPreviewCanvas
     write pm_SetPreviewCanvas;
   property Painted: Boolean
     read pm_GetPainted;
 end;//IafwPreviewPanel

 InevShapesLogger = interface(IUnknown)
  {* Лог отрисованных объектов }
   ['{D33CDAF3-2F4B-422C-879E-56B02F0686F9}']
   function OpenLog(const aView: InevView): AnsiString;
   procedure CloseLog(const aLogName: AnsiString);
   function LogScreen(const aView: InevView): Boolean;
 end;//InevShapesLogger



 IafwPagesLogger = interface(IUnknown)
   ['{19361554-2DE2-4E58-B896-503677BDD13B}']
   procedure LogPage(aPage: TafwPreviewPage;
    aCounter: Boolean);
 end;//IafwPagesLogger


Теперь как выглядит разьём TnevShapesPaintedSpy:

unit nevShapesPaintedSpy;

// Generated from UML model, root element: <<SimpleClass::Class>> Shared Delphi::Everest::Views::TnevShapesPaintedSpy
//
// Следилка за отрисованными объектами. {RequestLink:235864309}

interface

uses
  l3Filer,
  nevTools,
  nevShapesPainted,
  l3ProtoObject
  ;

type
 InevShapesLogger = interface(IUnknown)
  {* Лог отрисованных объектов }
   ['{D33CDAF3-2F4B-422C-879E-56B02F0686F9}']
   function OpenLog(const aView: InevView): AnsiString;
   procedure CloseLog(const aLogName: AnsiString);
   function LogScreen(const aView: InevView): Boolean;
 end;//InevShapesLogger

 TnevShapesPaintedSpy = class(Tl3ProtoObject)
  {* Следилка за отрисованными объектами. [RequestLink:235864309] }
 private
 // private fields
   f_Logger : InevShapesLogger;
   f_Filer : Tl3CustomFiler;
 protected
 // overridden protected methods
   procedure Cleanup; override;
     {* Функция очистки полей объекта. }
   procedure ClearFields; override;
 public
 // public methods
   procedure LogShapes(const aView: InevView;
     aShapes: TnevBaseTopShape);
     {* Логирует отрисованные объекты }
   procedure SetLogger(const aLogger: InevShapesLogger);
   procedure RemoveLogger(const aLogger: InevShapesLogger);
   class function Exists: Boolean;
   function LogScreen(const aView: InevView): Boolean;
 public
 // singleton factory method
   class function Instance: TnevShapesPaintedSpy;
    {- возвращает экземпляр синглетона. }
 end;//TnevShapesPaintedSpy

implementation

uses
  l3Base {a},
  SysUtils,
  l3Types,
  k2Tags,
  l3String,
  evParaTools,
  nevBase,
  l3MinMax
  ;

// start class TnevShapesPaintedSpy

var g_TnevShapesPaintedSpy : TnevShapesPaintedSpy = nil;

procedure TnevShapesPaintedSpyFree;
begin
 FreeAndNil(g_TnevShapesPaintedSpy);
end;

class function TnevShapesPaintedSpy.Instance: TnevShapesPaintedSpy;
begin
 if (g_TnevShapesPaintedSpy = nil) then
 begin
  l3System.AddExitProc(TnevShapesPaintedSpyFree);
  g_TnevShapesPaintedSpy := Create;
 end;
 Result := g_TnevShapesPaintedSpy;
end;

procedure TnevShapesPaintedSpy.LogShapes(const aView: InevView;
  aShapes: TnevBaseTopShape);

 procedure LogShape(aShape : TnevShape);

  function MangleCoord(aValue : Integer): Integer;
  // - тут СОЗНАТЕЛЬНО загрубляем координаты, чтобы тесты проходили на большем числе тестовых машин

   function EpsilonIt(aValue : Integer): Integer;
   begin//EpsilonIt
    if (aValue > 0) then
     Result := Max(0, aValue - 20)
    else
    if (aValue < 0) then
     Result := Min(0, aValue + 20)
    else
     Result := aValue;
   end;//EpsilonIt

  begin//MangleCoord
   Result := (EpsilonIt(aValue) div 100) * 100;
  end;//MangleCoord

 var
  l_Index     : Integer;
  l_ImageInfo : PnevControlImageInfo;
 begin//LogShape
  if (aShape <> nil) then
  begin
   f_Filer.WriteLn('----');

   with aShape.__Obj do
   begin
    f_Filer.WriteLn(Format('Obj type = %s', [TagType.AsString]));
    if HasSubAtom(k2_tiText) then
     f_Filer.WriteLn(Format('Text = ''%s''', [l3ReplaceNonReadable(StrA[k2_tiText])]));
   end;//with aShape.__Obj
   if (aShape.Count <> 0) then
    f_Filer.WriteLn(Format('Count = %d', [aShape.Count]));
   with aShape.Bounds do
    f_Filer.WriteLn(Format('Rect = (%d, %d, %d, %d)', [MangleCoord(Top),
                                                       MangleCoord(Left),
                                                       MangleCoord(Bottom),
                                                       MangleCoord(Right)]));
   Assert(aShape.__FI <> nil);
   with aShape.__FI do
   begin
    if (Width <> 0) OR (Height <> 0) then
     f_Filer.WriteLn(Format('Dim = (%d, %d)', [MangleCoord(Width),
                                               MangleCoord(Height)]));
    if Hidden then
     f_Filer.WriteLn(Format('Hidden = %d', [Ord(Hidden)]));
    if (MaxLinesCount <> 0) then
     f_Filer.WriteLn(Format('MaxLinesCount = %d', [MaxLinesCount]));
    if (DeltaHeight <> 0) then
     f_Filer.WriteLn(Format('DeltaHeight = %d', [MangleCoord(DeltaHeight)]));
    if (Zoom <> 100) then
     f_Filer.WriteLn(Format('Zoom = %d', [Zoom]));
    if (Lines <> nil) then
     if (Lines.Count <> 1) then
      f_Filer.WriteLn(Format('LinesCount = %d', [Lines.Count]));
   end;//with aShape.__FI
   if LogScreen(aView) and evHasOwnStyle(aShape.__Obj) then
   begin
    l_ImageInfo := aShape.__FI.ImageInfo;
    if (l_ImageInfo.rFirstIndex > -1) or (l_ImageInfo.rLastIndex > -1) then
    begin
     f_Filer.WriteLn('----');
     f_Filer.WriteLn(Format('ImageInfo FirstIndex = %d, LastIndex = %d', [l_ImageInfo.rFirstIndex, l_ImageInfo.rLastIndex]));
    end; // if EvHasOwnStyle(aShape.__Obj) then
   end; // if EvHasOwnStyle(aShape.__Obj) then
   for l_Index := 0 to Pred(aShape.Count) do
    LogShape(aShape.Items[l_Index]);
  end;//aShape <> nil
 end;//LogShape

var
 l_LogName : String;
begin
 if (f_Logger <> nil) then
 begin
  l_LogName := f_Logger.OpenLog(aView);
  try
   f_Filer := Tl3CustomDOSFiler.Make(l_LogName, l3_fmWrite);
   try
    f_Filer.Open;
    try
     LogShape(aShapes);
    finally
     f_Filer.Close;
    end;//try..finally
   finally
    FreeAndNil(f_Filer);
   end;//try..finally
  finally
   f_Logger.CloseLog(l_LogName);
  end;//try..finally
 end;//f_Logger <> nil
end;//TnevShapesPaintedSpy.LogShapes

procedure TnevShapesPaintedSpy.SetLogger(const aLogger: InevShapesLogger);
begin
 Assert(f_Logger = nil);
 f_Logger := aLogger;
end;//TnevShapesPaintedSpy.SetLogger

procedure TnevShapesPaintedSpy.RemoveLogger(const aLogger: InevShapesLogger);
begin
 Assert(f_Logger = aLogger);
 f_Logger := nil;
end;//TnevShapesPaintedSpy.RemoveLogger

class function TnevShapesPaintedSpy.Exists: Boolean;
begin
 Result := (g_TnevShapesPaintedSpy <> nil);
end;//TnevShapesPaintedSpy.Exists

function TnevShapesPaintedSpy.LogScreen(const aView: InevView): Boolean;
begin
 Result := (f_Logger <> nil) AND f_Logger.LogScreen(aView);
end;//TnevShapesPaintedSpy.LogScreen

procedure TnevShapesPaintedSpy.Cleanup;
begin
 FreeAndNil(f_Filer);
 inherited;
end;//TnevShapesPaintedSpy.Cleanup

procedure TnevShapesPaintedSpy.ClearFields;
 {-}
begin
 f_Logger := nil;
 inherited;
end;//TnevShapesPaintedSpy.ClearFields

end.

Разъём TafwPreviewPageSpy выглядит так:


unit afwPreviewPageSpy;

// Generated from UML model, root element: <<SimpleClass::Class>> Shared Delphi::AFW::Draw::TafwPreviewPageSpy
//
// Следилка за TafwPreviewPage, для {RequestLink:235873282}
//

interface

uses
  afwPreviewPage,
  l3ProtoObject
  ;

type
 IafwPagesLogger = interface(IUnknown)
   ['{19361554-2DE2-4E58-B896-503677BDD13B}']
   procedure LogPage(aPage: TafwPreviewPage;
    aCounter: Boolean);
 end;//IafwPagesLogger

 TafwPreviewPageSpy = class(Tl3ProtoObject)
  {* Следилка за TafwPreviewPage, для [RequestLink:235873282] }
 private
 // private fields
   f_Logger : IafwPagesLogger;
 protected
 // overridden protected methods
   procedure ClearFields; override;
 public
 // public methods
   class function Exists: Boolean;
   procedure SetLogger(const aLogger: IafwPagesLogger);
   procedure RemoveLogger(const aLogger: IafwPagesLogger);
   procedure LogPage(aPage: TafwPreviewPage;
     aCounter: Boolean);
 public
 // singleton factory method
   class function Instance: TafwPreviewPageSpy;
    {- возвращает экземпляр синглетона. }
 end;//TafwPreviewPageSpy

implementation

uses
  l3Base {a}
  ;

// start class TafwPreviewPageSpy

var g_TafwPreviewPageSpy : TafwPreviewPageSpy = nil;

procedure TafwPreviewPageSpyFree;
begin
 FreeAndNil(g_TafwPreviewPageSpy);
end;

class function TafwPreviewPageSpy.Instance: TafwPreviewPageSpy;
begin
 if (g_TafwPreviewPageSpy = nil) then
 begin
  l3System.AddExitProc(TafwPreviewPageSpyFree);
  g_TafwPreviewPageSpy := Create;
 end;
 Result := g_TafwPreviewPageSpy;
end;

class function TafwPreviewPageSpy.Exists: Boolean;
begin
 Result := (g_TafwPreviewPageSpy <> nil);
end;//TafwPreviewPageSpy.Exists

procedure TafwPreviewPageSpy.SetLogger(const aLogger: IafwPagesLogger);
begin
 Assert(f_Logger = nil);
 f_Logger := aLogger;
end;//TafwPreviewPageSpy.SetLogger

procedure TafwPreviewPageSpy.RemoveLogger(const aLogger: IafwPagesLogger);
begin
 Assert(f_Logger = aLogger);
 f_Logger := nil;
end;//TafwPreviewPageSpy.RemoveLogger

procedure TafwPreviewPageSpy.LogPage(aPage: TafwPreviewPage;
  aCounter: Boolean);
begin
 if (f_Logger <> nil) then
  f_Logger.LogPage(aPage, aCounter);
end;//TafwPreviewPageSpy.LogPage

procedure TafwPreviewPageSpy.ClearFields;
 {-}
begin
 f_Logger := nil;
 inherited;
end;//TafwPreviewPageSpy.ClearFields

end.



Теперь где эти разъёмы вызываются:


procedure TnevShapesPainted.Clear;
 {* - Очищает список. }
begin
 try
  if (f_Shapes <> nil) then
  begin
   if (f_View <> nil) then
   begin
    if TnevShapesPaintedSpy.Exists then
     if TnevShapesPaintedSpy.Instance.LogScreen(InevView(f_View)) then
      TnevShapesPaintedSpy.Instance.LogShapes(InevView(f_View), f_Shapes);
   end;//f_View <> nil
  end;//f_Shapes <> nil
 finally
  FreeAndNil(f_Current);
  FreeAndNil(f_Shapes);
  inherited;
 end;//try..finally
end;

И:
procedure TafwPreviewPage.Drop(aCounter: Boolean);
var
 l_Stream : IStream;
 l_Index  : Integer;
begin
 if (f_MetaFile <> nil) then
 begin
  if aCounter then
   FreeAndNil(f_MetaFile)
  else
  if (f_DropStream = nil) then
  begin
   if TafwPreviewPageSpy.Exists then
    TafwPreviewPageSpy.Instance.LogPage(Self, aCounter);
   f_DropStream := TevDataCache.CreateTempStream;
   try
    l_Stream := f_DropStream.MakeForWrite;
    try
     MetaFile.SaveToIStream(l_Stream);
    finally
     l_Stream := nil;
    end;//try..finally
    FreeAndNil(f_MetaFile);
   except
    f_DropStream := nil;
    raise;
   end;//try..except
  end//f_DropStream = nil
  else
   FreeAndNil(f_MetaFile);
 end;//f_MetaFile <> nil
 for l_Index := 1 to Pred(WidthCount) do
  WidthPage(l_Index).Drop(aCounter);
end;//TafwPreviewPage.Drop

Ну в общем - как-то так. Я предупреждал - пример - непростой. Но и тестируемый код сложен. Предварительный просмотр печати и печать я отлаживал года два. И то не довёл до идеала. Но зато я теперь вижу - "завтра же" - где и что отвалилось.

Сами конечные (а не абстрактные) выглядят примерно так:
unit K182157315;

// Generated from UML model, root element: <<TestCase::Class>> Shared Delphi Tests::DailyTest::7.7::K182157315
//
// {RequestLink:182157315}
//

interface

uses
  Classes
  ,
  PreviewTest
  ;
type
 TK182157315 = class(TPreviewTest)
  {* [RequestLink:182157315] }
 end;//TK182157315

implementation

uses
  TestFrameWork
  ;

// start class TK182157315

initialization
 TestFramework.RegisterTest(TK182157315.Suite);

end.

Или так:


unit K219124975;



// Generated from UML model, root element: <<TestCase::Class>> Shared Delphi Tests::DailyTest::7.5::K219124975

//

// {RequestLink:219124975}
//

interface

uses
  Classes
  ,
  PreviewTest
  ,
  evHAFPainterEx
  ;

type
 TK219124975 = class(TPreviewTest)
  {* [RequestLink:219124975] }
 protected
 // overridden protected methods
   function TreatExceptionAsSuccess: Boolean; override;
   function GetNormalFontSize: Integer; override;
     {* Возвращает размер шрифта стиля "Нормальный". 0 - по-умолчанию }
   procedure ReadColontituls(var theColontituls: TevColontituls); override;
   function GetHAFFontSize: Integer; override;
     {* Размер колонтитулов. 0 - по-умолчанию }
   function GetFolder: AnsiString; override;
     {* Папка в которую входит тест }
   function GetModelElementGUID: AnsiString; override;
     {* Идентификатор элемента модели, который описывает тест }
 end;//TK219124975

implementation

uses
  evTypes,
  l3Base,
  TestFrameWork
  ;

// start class TK219124975

function TK219124975.TreatExceptionAsSuccess: Boolean;
begin
 Result := true;
end;//TK219124975.TreatExceptionAsSuccess

function TK219124975.GetNormalFontSize: Integer;
begin
 Result := 39;
end;//TK219124975.GetNormalFontSize

procedure TK219124975.ReadColontituls(var theColontituls: TevColontituls);
begin
 inherited;
 theColontituls[pcUpRightFirst] := l3CStr('%DocFullName%'#10'%DocRedactionDate%');
 theColontituls[pcUpRight] := theColontituls[pcUpRightFirst];
 theColontituls[pcDownRightFirst] := l3CStr(''{'%DocCurrentPage% / %DocPagesCount%'});
 theColontituls[pcDownRight] := theColontituls[pcDownRightFirst];
end;//TK219124975.ReadColontituls

function TK219124975.GetHAFFontSize: Integer;
begin
 Result := 28;
end;//TK219124975.GetHAFFontSize

initialization
 TestFramework.RegisterTest(TK219124975.Suite);

end.

А имя файла для проверки вычисляется из имени тестового класса (через ClassName и ClassType), а сам файл с таким именем лежит в тестовом репозитарии.

Вы мне скажете - "наличие контрольных точек "зашумляет" систему и она ведёт себя не так как при их отсутствии". И вы будете АБСОЛЮТНО правы. Тут бы вспомнить про принцип неопределённости Гейзенберга. Я с вами на 100% согласен. Мне даже тестировщики это говорят. Хотя им вроде бы "не полагается" знать внутреннее устройство системы. И они - ТОЖЕ ПРАВЫ. Да. На 100% эта практика не работает, но она - чертовски (!) удобна. И позволяет решать очень много задач тестирования. Это не "серебряная пуля". Это всего лишь одна из работающих практик, позволяющая решать конкретные задачи тестирования КОНКРЕТНОГО кода. Не "сферический конь". Но - работает.

Лучше - что-то, чем НИЧЕГО. Лучше кривой и косой ОДИН тест, что полное отсутствие СТА идеальных.

Попробуйте. Может быть и вам понравится.

P.S. Да ещё недостающие классы:


unit TextEditorVisitor;

// Библиотека "TestFormsTest"
// Generated from UML model, root element: <<TestCase::Class>> Shared Delphi Operations For Tests::TestFormsTest::Everest::TTextEditorVisitor
//
// Тест, работающий с текстом документа через редактор, но не изменяющий его
//

interface

uses
  TextEditorVisitorPrim
  ;

type
 TTextEditorVisitor = {abstract} class(TTextEditorVisitorPrim)
  {* Тест, работающий с текстом документа через редактор, но не изменяющий его }
 protected
 // protected methods
   function GetNormalFontSize: Integer; virtual;
     {* Возвращает размер шрифта стиля "Нормальный". 0 - по-умолчанию }
   function MaxHeight: Integer; virtual;
     {* Если возвращается не 0, то будет организован цикл подбора высоты от FormExtent.Y до MaxHeight }
 published
 // published methods
   procedure DoIt;
     {* Собственно тело теста }
 end;//TTextEditorVisitor

implementation

uses
  SysUtils,
  evStyleInterface,
  TestFrameWork
  ;

// start class TTextEditorVisitor

procedure TTextEditorVisitor.DoIt;
var
 l_SI : TevStyleInterface;
 l_Size : Integer;
 l_NewSize : Integer;
 l_MaxHeight : Integer;
begin
 l_SI := TevStyleInterface.Make;
 try
  l_NewSize := GetNormalFontSize;
  l_Size := l_SI.Font.Size;
  try
   if (l_NewSize > 0) then
    l_SI.Font.Size := l_NewSize;
   l_MaxHeight := MaxHeight;
   if (l_MaxHeight > 0) then
   begin
    f_FixedHeight := 0;
    f_FixedHeight := FormExtent.Y;
    if (f_FixedHeight < 0) then
     f_FixedHeight := 300;
    while (f_FixedHeight < l_MaxHeight) do
    begin
     try
      VisitText;
     except
      ToLog('Form height = ' + IntToStr(f_FixedHeight));
      raise;
     end;//try..except
     Inc(f_FixedHeight);
    end;//f_FixedHeight < l_MaxHeight
   end//l_MaxHeight > 0
   else
    VisitText;
  finally
   l_SI.Font.Size := l_Size;
  end;//try..finally
 finally
  FreeAndNil(l_SI);
 end;//try..finally
end;//TTextEditorVisitor.DoIt

function TTextEditorVisitor.GetNormalFontSize: Integer;
begin
 Result := 0;
end;//TTextEditorVisitor.GetNormalFontSize

function TTextEditorVisitor.MaxHeight: Integer;
begin
 Result := 0;
end;//TTextEditorVisitor.MaxHeight

end.
-----------------------------------------

unit TextEditorVisitorPrim;

//
// Библиотека "TestFormsTest"
// Generated from UML model, root element: <<TestCase::Class>> Shared Delphi Operations For Tests::TestFormsTest::Everest::TTextEditorVisitorPrim
//
// Тест, работающий с текстом документа через редактор, но не изменяющий его
//

interface

uses
  TextViaEditorProcessorPrim,
  PrimTextLoad_Form
  ;

type
 TTextEditorVisitorPrim = {abstract} class(TTextViaEditorProcessorPrim)
  {* Тест, работающий с текстом документа через редактор, но не изменяющий его }
 protected
 // protected methods
   procedure VisitText(const aStr: AnsiString = 'Load');
     {* Собственно процедура обработки текста }
   procedure DoVisit(aForm: TPrimTextLoadForm); virtual; abstract;
     {* Обработать текст }
   function TreatExceptionAsSuccess: Boolean; virtual;
 end;//TTextEditorVisitorPrim

implementation

uses
  l3Base,
  k2OperationContainer,
  TestFrameWork
  ;

// start class TTextEditorVisitorPrim

procedure TTextEditorVisitorPrim.VisitText(const aStr: AnsiString = 'Load');
var
 l_F : _FormClass_;
 l_Raise : Boolean;
 l_DisableLog : Boolean; 
begin
 l_F := MakeForm;
 try
  l_F.Show;
  l_Raise := TreatExceptionAsSuccess;
  l_DisableLog := l_Raise;
  if l_DisableLog then
   l3System.DisableExceptionToLog;
  try
   Load(l_F, KPage + '.evd', aStr);
   try
    try
     DoVisit(l_F);
    finally
     Check(not Tk2OperationContainer.CheckWasExceptionInFreeInOwner);
    end;//try..finally
   except
    if l_Raise then
     {l_Raise := false}
     Exit
     // - чтобы не пропустить ситуацию, когда тест вдруг стал проходить
    else
     raise;
   end;//try..except
  finally
   if l_DisableLog then
    l3System.EnableExceptionToLog;
  end;//try..finally
  Check(not l_Raise, 'Тест проходить не должен, т.к. текст не влезает в бумагу');
 finally
  l_F.Free;
 end;//try..finally
end;//TTextEditorVisitorPrim.VisitText

function TTextEditorVisitorPrim.TreatExceptionAsSuccess: Boolean;
begin
 Result := false;
end;//TTextEditorVisitorPrim.TreatExceptionAsSuccess

end.
--------------------------------

unit TextViaEditorProcessorPrim;

//
// Библиотека "TestFormsTest"
// Generated from UML model, root element: <<TestCase::Class>> Shared Delphi Operations For Tests::TestFormsTest::Everest::TTextViaEditorProcessorPrim
//
// Обработчик текста через редактор
//

interface

uses
  nevTools
  ,
  VCMBaseTest
  ,
  PrimTextLoad_Form,
  Types
  ;

type
 _FormClass_ = TPrimTextLoadForm;
 _FormProducer_Parent_ = TVCMBaseTest;
 {$Include FormProducer.imp.pas}
 TTextViaEditorProcessorPrim = {abstract} class(_FormProducer_)
  {* Обработчик текста через редактор }
 private
 // private fields
   f_ScrollCount : Integer;
    {* Поле для свойства ScrollCount}
 protected
 // overridden protected methods
   procedure FormMade(const aForm: _FormClass_); override;
   function MakeFormClass: FormClassRef; override;
 protected
 // protected methods
   procedure Load(aForm: TPrimTextLoadForm;
     const aFileName: AnsiString;
     const aStr: AnsiString = 'Load');
     {* Загружает документ в редактор указанной формы }
   procedure Save(aForm: TPrimTextLoadForm); virtual;
     {* Сохраняет текст из редактора в стандартный выходной файл }
   procedure Scroll(aForm: TPrimTextLoadForm;
     const aSubName: AnsiString);
   procedure ScrollBack(aForm: TPrimTextLoadForm;
     const aSubName: AnsiString);
     {* Скроллирует текст в обратном направлении }
   procedure ScrollByWeel(aForm: TPrimTextLoadForm;
     aCount: Integer;
     aGoTop: Boolean = True);
     {* Прокрутить заданное число раз с помощью колеса мыши }
   procedure ScrollByLine(aForm: TPrimTextLoadForm;
     aCount: Integer;
     aUp: Boolean;
     aFromBottom: Boolean);
     {* Прокручивать построчно заданное число раз вверх или вниз }
   procedure GotoDocumentBottom(aForm: TPrimTextLoadForm);
     {* Перейти в конец документа }
   procedure PageUp(aForm: TPrimTextLoadForm);
     {* Перейти на страницу вверх }
   procedure PageDown(aForm: TPrimTextLoadForm);
   function ScrollByPage: Boolean; virtual;
   function WebStyle: Boolean; virtual;
   function SendKey: Boolean; virtual;
     {* Управлять ли окном реактора посредсвом посылки клавиш, а не вызова методов редактора }
   procedure CheckTopAnchor(const aView: InevInputView); virtual;
     {* проверить якорь начала отрисовки после окончания прокрутки }
   function F1Like: Boolean; virtual;
   function QFLike: Boolean; virtual;
     {* Создать форму-редактор для работы с КЗ. }
   procedure DoBeforeLoad(aForm: TPrimTextLoadForm); virtual;
     {* Операции предшествующие загрузке документа }
   function AllowMultiSelect: Boolean; virtual;
     {* Разершить мультивыделение. }
   function WithBaseSearch: Boolean; virtual;
     {* Форма со строкой базового поиска. }
 public
 // public properties
   property ScrollCount: Integer
     read f_ScrollCount;
     {* Количество прокруток до конца документа }
 end;//TTextViaEditorProcessorPrim

implementation

uses
  Document_Const,
  k2OperationContainer,
  evdNativeWriter,
  l3Filer,
  SysUtils,
  evOp,
  l3InternalInterfaces,
  Forms,
  Windows,
  evCustomEditorWindow,
  Messages,
  TextLoad_Form,
  evdSchema,
  F1LikeTextLoad_Form,
  QFLikeTextLoad_Form,
  F1LikeFormWithBS_Form,
  TestFrameWork,
  vcmBase,
  l3Base
  ;

{$Include FormProducer.imp.pas}

// start class TTextViaEditorProcessorPrim

procedure TTextViaEditorProcessorPrim.Load(aForm: TPrimTextLoadForm;
  const aFileName: AnsiString;
  const aStr: AnsiString = 'Load');
begin
 with aForm do
 begin
  DoBeforeLoad(aForm);
  LoadManager.FileName := FileFromCurrent(aFileName);
  StartTimer;
  try
   LoadManager.Load(TextSource, k2_idDocument);
  finally
   StopTimer(aStr);
  end;//try..finally
 end;//with aForm
 Check(not Tk2OperationContainer.CheckWasExceptionInFreeInOwner);
end;//TTextViaEditorProcessorPrim.Load

procedure TTextViaEditorProcessorPrim.Save(aForm: TPrimTextLoadForm);
var
 l_Writer : TevdNativeWriter;
 l_Filer  : Tl3CustomFiler;
begin
 l_Writer := TevdNativeWriter.Create;
 try
  l_Writer.Binary := false;
  l_Filer := FilerForOutput;
  try
   l_Writer.Filer := l_Filer;
  finally
   FreeAndNil(l_Filer);
  end;//try..finally
  aForm.TextSource.Save(l_Writer);
 finally
  FreeAndNil(l_Writer);
 end;//try..finally
end;//TTextViaEditorProcessorPrim.Save

procedure TTextViaEditorProcessorPrim.Scroll(aForm: TPrimTextLoadForm;
  const aSubName: AnsiString);
var
 l_Now : Cardinal;
begin
 with aForm do
 begin
  if (Text.View <> nil) then
  begin
   Il3CommandTarget(Text).ProcessCommand(ev_ocTopLeft, true, 1);
   l_Now := StartTimer;
   try
    try
     f_ScrollCount := 0;
     while not Text.View.IsDocumentTailVisible do
     begin
      if ScrollByPage then
      begin
       if SendKey then
       begin
        PostMessage(Text.Handle, $100, $22, $1510001); //Зажали PgDown
        Inc(f_ScrollCount);
       end
       else
       if Il3CommandTarget(Text).ProcessCommand(ev_ocPageDown, true, 1) then
        Inc(f_ScrollCount)
       else
        break;
      end//ScrollByPage
      else
       Text.Perform(WM_VScroll, SB_WheelDown, 0);
      Application.ProcessMessages;
      CheckTimeout(l_Now, 20 * 60 * 1000);
      if ShouldStop then Break;
     end;//while not Text.View.IsDocumentTailVisible
    finally
     if ScrollByPage then
      if SendKey then
       PostMessage(Text.Handle, $101, $22, $1510001); //Отжали PgDown
    end;//try..finally
    Application.ProcessMessages;
   finally
    StopTimer('Scroll', aSubName);
   end;//try..finally
  end;//Text.View <> nil
 end;//with aForm
end;//TTextViaEditorProcessorPrim.Scroll

procedure TTextViaEditorProcessorPrim.ScrollBack(aForm: TPrimTextLoadForm;
  const aSubName: AnsiString);
var
 l_Now : Cardinal;
begin
 with aForm do
 begin
  if (Text.View <> nil) then
  begin
   GotoDocumentBottom(aForm);
   l_Now := StartTimer;
   try
    while not Text.View.TopAnchor.AtStart{.IsDocumentTailVisible} do
    begin
//     PostMessage(Text.Handle, $100, $22, $1510001); //Зажали PgDown
     if ScrollByPage then
     begin
      if not Il3CommandTarget(Text).ProcessCommand(ev_ocPageUp, true, 1) then
       break;
     end//ScrollByPage
     else
      Text.Perform(WM_VScroll, SB_WheelUp, 0);
     Application.ProcessMessages;
     CheckTimeout(l_Now, 20 * 60 * 1000);
     if ShouldStop then Break;
    end;//while not Text.View.IsDocumentTailVisible
//    PostMessage(Text.Handle, $101, $22, $1510001); //Отжали PgDown
    Application.ProcessMessages;
   finally
    StopTimer('ScrollBack', aSubName);
   end;//try..finally
  end;//Text.View <> nil
 end;//with aForm
end;//TTextViaEditorProcessorPrim.ScrollBack

procedure TTextViaEditorProcessorPrim.ScrollByWeel(aForm: TPrimTextLoadForm;
  aCount: Integer;
  aGoTop: Boolean = True);
var
 i: Integer;
begin
 with aForm do
 begin
  if aGoTop then
   Il3CommandTarget(Text).ProcessCommand(ev_ocTopLeft, true, 1);
  for i := 0 to aCount - 1 do
  begin
   Text.Perform(WM_VScroll, SB_WheelDown, 0);
   Application.ProcessMessages;
   if ShouldStop then Break;
  end;
 end; // with aForm do
end;//TTextViaEditorProcessorPrim.ScrollByWeel

procedure TTextViaEditorProcessorPrim.ScrollByLine(aForm: TPrimTextLoadForm;
  aCount: Integer;
  aUp: Boolean;
  aFromBottom: Boolean);
var
 i: Integer;
begin
 with aForm do
 begin
  if aFromBottom and aUp then
   GotoDocumentBottom(aForm);
  if aCount > 0 then
   if aUp then
    for i := 0 to aCount - 1 do
    begin
     aForm.Text.View.Scroller[True].LineUp(1);
     Application.ProcessMessages;
     if ShouldStop then Break;
    end // for i := 0 to aCount - 1 do
   else
    for i := 0 to aCount - 1 do
    begin
     aForm.Text.View.Scroller[True].LineDown(1);
     Application.ProcessMessages;
     if ShouldStop then Break;
    end // for i := 0 to aCount - 1 do
  else
   if aCount < 0 then
    if aUp then
     while not Text.View.TopAnchor.AtStart do
     begin
      aForm.Text.View.Scroller[True].LineUp(1);
      Application.ProcessMessages;
      CheckTopAnchor(aForm.Text.View);
      if ShouldStop then Break;
     end
    else
     while not Text.View.IsDocumentTailVisible do
     begin
      aForm.Text.View.Scroller[True].LineDown(1);
      Application.ProcessMessages;
      CheckTopAnchor(aForm.Text.View);
      if ShouldStop then Break;
     end;
 end; // with aForm do
end;//TTextViaEditorProcessorPrim.ScrollByLine

procedure TTextViaEditorProcessorPrim.GotoDocumentBottom(aForm: TPrimTextLoadForm);
begin
 if QFLike then
 // - иначе редактор КЗ это как-то по-своему обрабатывает
  aForm.Text.View.Caret.Bottom
 else
  Il3CommandTarget(aForm.Text).ProcessCommand(ev_ocBottomRight, true, 1);
end;//TTextViaEditorProcessorPrim.GotoDocumentBottom

procedure TTextViaEditorProcessorPrim.PageUp(aForm: TPrimTextLoadForm);
begin
 Il3CommandTarget(aForm.Text).ProcessCommand(ev_ocPageUp, true, 1);
end;//TTextViaEditorProcessorPrim.PageUp

procedure TTextViaEditorProcessorPrim.PageDown(aForm: TPrimTextLoadForm);
begin
 Il3CommandTarget(aForm.Text).ProcessCommand(ev_ocPageDown, true, 1);
end;//TTextViaEditorProcessorPrim.PageDown

function TTextViaEditorProcessorPrim.ScrollByPage: Boolean;
begin
 Result := true;
end;//TTextViaEditorProcessorPrim.ScrollByPage

function TTextViaEditorProcessorPrim.WebStyle: Boolean;
begin
 Result := true;
end;//TTextViaEditorProcessorPrim.WebStyle

function TTextViaEditorProcessorPrim.SendKey: Boolean;
begin
 Result := false;
end;//TTextViaEditorProcessorPrim.SendKey

procedure TTextViaEditorProcessorPrim.CheckTopAnchor(const aView: InevInputView);
begin
end;//TTextViaEditorProcessorPrim.CheckTopAnchor

function TTextViaEditorProcessorPrim.F1Like: Boolean;
begin
 Result := false;
end;//TTextViaEditorProcessorPrim.F1Like

function TTextViaEditorProcessorPrim.QFLike: Boolean;
begin
 Result := false;
end;//TTextViaEditorProcessorPrim.QFLike

procedure TTextViaEditorProcessorPrim.DoBeforeLoad(aForm: TPrimTextLoadForm);
begin
end;//TTextViaEditorProcessorPrim.DoBeforeLoad

function TTextViaEditorProcessorPrim.AllowMultiSelect: Boolean;
begin
 Result := True;
end;//TTextViaEditorProcessorPrim.AllowMultiSelect

function TTextViaEditorProcessorPrim.WithBaseSearch: Boolean;
begin
 Result := False;
end;//TTextViaEditorProcessorPrim.WithBaseSearch

procedure TTextViaEditorProcessorPrim.FormMade(const aForm: _FormClass_);
begin
 inherited;
 aForm.Text.WebStyle := WebStyle;
 aForm.Text.AllowMultiSelect := AllowMultiSelect;
end;//TTextViaEditorProcessorPrim.FormMade

function TTextViaEditorProcessorPrim.MakeFormClass: FormClassRef;
begin
 if WithBaseSearch then
  Result := TF1LikeFormWithBSForm
 else
 if QFLike then
  Result := TQFLikeTextLoadForm
 else
 if F1Like then
  Result := TF1LikeTextLoadForm
 else
  Result := TTextLoadForm;
end;//TTextViaEditorProcessorPrim.MakeFormClass

end.


Комментариев нет:

Отправить комментарий