Начну с лирического отступления.
Когда-то у меня был компьютер БК-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.
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;
И:
Вы мне скажете - "наличие контрольных точек "зашумляет" систему и она ведёт себя не так как при их отсутствии". И вы будете АБСОЛЮТНО правы. Тут бы вспомнить про принцип неопределённости Гейзенберга. Я с вами на 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.
Когда-то у меня был компьютер БК-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.
Комментариев нет:
Отправить комментарий