paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 22:38:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

Tests: test for PageControl, workaround QT and GTK do extra paint

Browse Source 
git-svn-id: trunk@42693 -
This commit is contained in:
martin 2013-09-09 08:34:03 +00:00
parent 93b81bdd04
commit 426e526f9b
1 changed files with 8 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
test/lcltests/testpagecontrol.pas
View File

@ -296,12 +296,20 @@ procedure TTestPageControl.CheckPaint(AName: String; APaintedPage: TTestSheet);
var
i: Integer;
begin
{$IfDef LCLQT}
if APaintedPage <> nil then begin
AssertTrue(AName + ' Paint was called', APaintedPage.DidPaint >= 1);
end;
{$Else}
if APaintedPage <> nil then begin
AssertEquals(AName + ' Paint was called', 1, APaintedPage.DidPaint);
end;
{$IfNDef LCLGTK2}
for i := 0 to PageControl.ControlCount - 1 do
if (PageControl.Controls[i] <> APaintedPage) and (PageControl.Controls[i] is TTestSheet) then
AssertEquals(AName + 'NO paint for other page', 0, (PageControl.Controls[i] as TTestSheet).DidPaint);
{$EndIf}
{$EndIf}
end;
procedure TTestPageControl.TestPageCreation;