mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-31 18:20:42 +02:00
Tests: more test for PageControl
git-svn-id: trunk@42687 -
This commit is contained in:
martin
parent
612b486281
commit
361be30481
@ -5,9 +5,9 @@ unit testpagecontrol;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit,
|
||||
Interfaces, LCLType, LCLIntf, Forms, ComCtrls, Controls, StdCtrls, LMessages,
|
||||
testglobals;
|
||||
Classes, SysUtils, types, math, fpcunit, Interfaces, LCLType, LCLIntf, Forms, ComCtrls,
|
||||
Controls, StdCtrls, LMessages, LCLProc, WSComCtrls, testglobals, MouseInputIntf,
|
||||
MouseAndKeyInput;
|
||||
|
||||
type
|
||||
|
||||
@ -50,6 +50,9 @@ type
|
||||
TTestPage=class(TPageControl)
|
||||
protected
|
||||
function GetPageClass: TCustomPageClass; override;
|
||||
public
|
||||
function TestGetTabBarHeight: Integer;
|
||||
function TestGetTabBarWidth: Integer;
|
||||
end;
|
||||
|
||||
TCreatePageFlag = (
|
||||
@ -83,9 +86,16 @@ type
|
||||
procedure CreatePageControl;
|
||||
function CreatePage(ACaption: String; AIndex: Integer; AFlags: TCreatePageFlags = []): TTestSheet;
|
||||
procedure ResetCounts;
|
||||
procedure ResetPaintCounts;
|
||||
|
||||
procedure CheckPaint(AName: String; APaintedPage: TTestSheet);
|
||||
published
|
||||
procedure TestCreation;
|
||||
procedure TestPageCreation;
|
||||
procedure TestMovePages;
|
||||
procedure TestTabAndClientRect;
|
||||
procedure TestSwitchTabByClick;
|
||||
procedure TestPageDestruction;
|
||||
//procedure TestCreationAndHiddenTabs;
|
||||
//procedure TestMovePagesAndHiddenTabs;
|
||||
end;
|
||||
|
||||
@ -162,6 +172,16 @@ begin
|
||||
Result := TTestSheet;
|
||||
end;
|
||||
|
||||
function TTestPage.TestGetTabBarHeight: Integer;
|
||||
begin
|
||||
Result := TWSCustomTabControlClass(WidgetSetClass).GetNotebookMinTabHeight(Self);
|
||||
end;
|
||||
|
||||
function TTestPage.TestGetTabBarWidth: Integer;
|
||||
begin
|
||||
Result := TWSCustomTabControlClass(WidgetSetClass).GetNotebookMinTabWidth(Self);
|
||||
end;
|
||||
|
||||
{ TTestPageControl }
|
||||
|
||||
procedure TTestPageControl.DoPageCtrlChanged(Sender: TObject);
|
||||
@ -261,12 +281,33 @@ begin
|
||||
FOnChangesList.Clear;
|
||||
end;
|
||||
|
||||
procedure TTestPageControl.TestCreation;
|
||||
procedure TTestPageControl.ResetPaintCounts;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to PageControl.ControlCount - 1 do
|
||||
if (PageControl.Controls[i] is TTestSheet) then
|
||||
(PageControl.Controls[i] as TTestSheet).DidPaint;
|
||||
end;
|
||||
|
||||
procedure TTestPageControl.CheckPaint(AName: String; APaintedPage: TTestSheet);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if APaintedPage <> nil then begin
|
||||
AssertEquals(AName + ' Paint was called', 1, APaintedPage.DidPaint);
|
||||
end;
|
||||
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);
|
||||
end;
|
||||
|
||||
procedure TTestPageControl.TestPageCreation;
|
||||
var
|
||||
s1, s2, s3, s4, s5, s6, s7: TTestSheet;
|
||||
Name, Name2: String;
|
||||
begin
|
||||
{%region Pages, with children}
|
||||
{%region NON Setting PagControl.PageIndex}
|
||||
RecreateForm(True);
|
||||
Name := 'Pages, with children: ';
|
||||
|
||||
@ -276,7 +317,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 1 TabIndex is 0', 0, s1.TabIndex);
|
||||
AssertEquals(Name+Name2+'No OnChanging', 0, FOnChangingCalled);
|
||||
//AssertEquals(Name+Name2+'No OnChange', 0, FOnChangeCalled);
|
||||
AssertEquals(Name+Name2+'Did Paint Page 1', 1, s1.DidPaint);
|
||||
CheckPaint(Name+Name2+'paint', s1);
|
||||
|
||||
s2 := CreatePage('p2', 1, [fResetCounts]);
|
||||
Name2 := 'Inserted 2nd page at 1 (no index change forced): ';
|
||||
@ -285,8 +326,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 2 TabIndex is 1', 1, s2.TabIndex);
|
||||
AssertEquals(Name+Name2+'No OnChanging', 0, FOnChangingCalled);
|
||||
//AssertEquals(Name+Name2+'No OnChange', 0, FOnChangeCalled);
|
||||
AssertEquals(Name+Name2+'Did not RE-Paint Page 1', 0, s1.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 2', 0, s2.DidPaint);
|
||||
CheckPaint(Name+Name2+'no (re-)paint', nil);
|
||||
|
||||
|
||||
s3 := CreatePage('p3', 2, [fResetCounts]);
|
||||
@ -297,9 +337,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 3 TabIndex is 2', 2, s3.TabIndex);
|
||||
AssertEquals(Name+Name2+'No OnChanging', 0, FOnChangingCalled);
|
||||
//AssertEquals(Name+Name2+'No OnChange', 0, FOnChangeCalled);
|
||||
AssertEquals(Name+Name2+'Did not RE-Paint Page 1', 0, s1.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 2', 0, s2.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 3', 0, s3.DidPaint);
|
||||
CheckPaint(Name+Name2+'no (re-)paint', nil);
|
||||
|
||||
// insert in front
|
||||
s4 := CreatePage('p4', 0, [fResetCounts]);
|
||||
@ -310,15 +348,10 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 3 TabIndex is 3', 3, s3.TabIndex);
|
||||
AssertEquals(Name+Name2+'Page 4 TabIndex is 0', 0, s4.TabIndex);
|
||||
// TODO: an event is triggered (maybe by gages move)
|
||||
// MOVEDF pages...
|
||||
//AssertEquals(Name+Name2+'No OnChanging', 1, FOnChangingCalled);
|
||||
//AssertEquals(Name+Name2+'No OnChanged', 2, FOnChangeCalled); /// XXXXX 2 times
|
||||
//AssertEquals(Name+Name2+'No OnChanging', 0, FOnChangingCalled);
|
||||
AssertEquals(Name+Name2+'No OnChanging', 0, FOnChangingCalled);
|
||||
//AssertEquals(Name+Name2+'No OnChange', 0, FOnChangeCalled);
|
||||
AssertEquals(Name+Name2+'Did not RE-Paint Page 1', 0, s1.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 2', 0, s2.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 3', 0, s3.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 4', 0, s4.DidPaint);
|
||||
CheckPaint(Name+Name2+'no (re-)paint', nil);
|
||||
|
||||
// insert in middle
|
||||
s5 := CreatePage('p5', 2, [fResetCounts]);
|
||||
@ -330,15 +363,10 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 TabIndex is 0', 0, s4.TabIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 TabIndex is 0', 2, s5.TabIndex);
|
||||
// TODO: an event is triggered (maybe by gages move)
|
||||
// MOVEDF pages...
|
||||
//AssertEquals(Name+Name2+'No OnChanged', 1, FOnChangeCalled);
|
||||
AssertEquals(Name+Name2+'No OnChanging', 0, FOnChangingCalled);
|
||||
//AssertEquals(Name+Name2+'No OnChange', 0, FOnChangeCalled);
|
||||
AssertEquals(Name+Name2+'Did not RE-Paint Page 1', 0, s1.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 2', 0, s2.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 3', 0, s3.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 4', 0, s4.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 5', 0, s5.DidPaint);
|
||||
CheckPaint(Name+Name2+'no (re-)paint', nil);
|
||||
|
||||
// insert WITHOUT setting TabIndex
|
||||
s6 := CreatePage('p6', -1, [fSkipIndex, fResetCounts]);
|
||||
@ -353,21 +381,44 @@ begin
|
||||
// TODO: an event is triggered (maybe by gages move)
|
||||
AssertEquals(Name+Name2+'No OnChanging', 0, FOnChangingCalled);
|
||||
AssertEquals(Name+Name2+'No OnChange', 0, FOnChangeCalled);
|
||||
AssertEquals(Name+Name2+'Did not RE-Paint Page 1', 0, s1.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 2', 0, s2.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 3', 0, s3.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 4', 0, s4.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 5', 0, s5.DidPaint);
|
||||
AssertEquals(Name+Name2+'Did NOT Paint Page 6', 0, s6.DidPaint);
|
||||
CheckPaint(Name+Name2+'no (re-)paint', nil);
|
||||
|
||||
// TODO: change PageIndex to display new page.
|
||||
|
||||
{%endregion Pages, with children}
|
||||
{%endregion }
|
||||
|
||||
|
||||
{%region Pages, WITHOUT children}
|
||||
//RecreateForm(True);
|
||||
//Name := 'Pages, WITHOUT children';
|
||||
{%region Setting PagControl.PageIndex}
|
||||
RecreateForm(True);
|
||||
Name := 'Pages, with children: ';
|
||||
|
||||
s1 := CreatePage('p1', 0, [fChangeIndex, fResetCounts]);
|
||||
Name2 := 'Inserted 1st page at 0 (index change forced): ';
|
||||
AssertEquals(Name+Name2+'PageIndex is 1', 0, PageControl.ActivePageIndex);
|
||||
AssertEquals(Name+Name2+'Page 1 TabIndex is 0', 0, s1.TabIndex);
|
||||
AssertEquals(Name+Name2+'No OnChanging', 0, FOnChangingCalled);
|
||||
//AssertEquals(Name+Name2+'No OnChange', 0, FOnChangeCalled);
|
||||
CheckPaint(Name+Name2+'paint', s1);
|
||||
|
||||
s2 := CreatePage('p2', 0, [fChangeIndex, fResetCounts]);
|
||||
Name2 := 'Inserted 2nd page at 0 (index change forced): ';
|
||||
AssertEquals(Name+Name2+'PageIndex set 0', 0, PageControl.ActivePageIndex);
|
||||
AssertEquals(Name+Name2+'Page 1 TabIndex is 1', 1, s1.TabIndex);
|
||||
AssertEquals(Name+Name2+'Page 2 TabIndex is 0', 0, s2.TabIndex);
|
||||
//AssertEquals(Name+Name2+'No OnChanging', 0, FOnChangingCalled);
|
||||
//AssertEquals(Name+Name2+'No OnChange', 0, FOnChangeCalled);
|
||||
CheckPaint(Name+Name2+'paint', s2);
|
||||
|
||||
s3 := CreatePage('p3', 1, [fChangeIndex, fResetCounts]);
|
||||
Name2 := 'Inserted 3rd page at 1 (index change forced): ';
|
||||
AssertEquals(Name+Name2+'PageIndex set 1', 1, PageControl.ActivePageIndex);
|
||||
AssertEquals(Name+Name2+'Page 1 TabIndex is 1', 2, s1.TabIndex);
|
||||
AssertEquals(Name+Name2+'Page 2 TabIndex is 0', 0, s2.TabIndex);
|
||||
AssertEquals(Name+Name2+'Page 3 TabIndex is 0', 1, s3.TabIndex);
|
||||
//AssertEquals(Name+Name2+'No OnChanging', 0, FOnChangingCalled);
|
||||
//AssertEquals(Name+Name2+'No OnChange', 0, FOnChangeCalled);
|
||||
CheckPaint(Name+Name2+'paint', s3);
|
||||
|
||||
{%endregion Pages, WITHOUT children}
|
||||
|
||||
|
||||
@ -389,7 +440,9 @@ var
|
||||
s5 := CreatePage('p5', 5, []);
|
||||
s6 := CreatePage('p6', 6, []);
|
||||
PageControl.ActivePageIndex := AIndex;
|
||||
Application.ProcessMessages;
|
||||
ResetCounts;
|
||||
ResetPaintCounts;
|
||||
|
||||
Name := 'SelfTest';
|
||||
Name2 := '';
|
||||
@ -402,8 +455,9 @@ var
|
||||
AssertEquals(Name+Name2+'Page 5 TabIndex is 5', 5, s5.TabIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 TabIndex is 6', 6, s6.TabIndex);
|
||||
end;
|
||||
|
||||
begin
|
||||
// TODO: check paint and events
|
||||
// TODO: check events
|
||||
// TODO: temp select tabs before move / create handles
|
||||
// TODO: Move to last / move to first (range check tests
|
||||
|
||||
@ -419,6 +473,9 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
AssertEquals(Name+Name2+'No OnChanging', 0, FOnChangingCalled);
|
||||
//AssertEquals(Name+Name2+'No OnChange', 0, FOnChangeCalled);
|
||||
|
||||
InternalSetup(0);
|
||||
Name2 := 'Move Tab idx=2 to 3 (SWAP) (Selected 0): ';
|
||||
@ -431,6 +488,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
InternalSetup(0);
|
||||
Name2 := 'Move Tab idx=3 to 1 (Selected 0): ';
|
||||
@ -443,6 +501,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
InternalSetup(0);
|
||||
Name2 := 'Move Tab idx=3 to 2 (SWAP backward) (Selected 0): ';
|
||||
@ -455,6 +514,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
|
||||
|
||||
@ -470,6 +530,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
InternalSetup(5);
|
||||
Name2 := 'Move Tab idx=2 to 3 (SWAP) (Selected 5): ';
|
||||
@ -482,6 +543,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
InternalSetup(5);
|
||||
Name2 := 'Move Tab idx=3 to 1 (Selected 5): ';
|
||||
@ -494,6 +556,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
InternalSetup(5);
|
||||
Name2 := 'Move Tab idx=3 to 2 (SWAP backward) (Selected 5): ';
|
||||
@ -506,6 +569,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
|
||||
|
||||
@ -521,6 +585,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
// Not possible to SWAP as single move, with active needed in the middle
|
||||
//Name2 := 'Move Tab idx=2 to 3 (SWAP) (Selected 0): ';
|
||||
@ -536,6 +601,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
|
||||
|
||||
@ -551,6 +617,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
InternalSetup(2);
|
||||
Name2 := 'Move Tab idx=2 to 3 (SWAP) (Selected 2): ';
|
||||
@ -563,6 +630,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
InternalSetup(3);
|
||||
Name2 := 'Move Tab idx=3 to 1 (Selected 3): ';
|
||||
@ -575,6 +643,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
InternalSetup(3);
|
||||
Name2 := 'Move Tab idx=3 to 2 (SWAP backward) (Selected 3): ';
|
||||
@ -587,6 +656,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
|
||||
|
||||
@ -603,6 +673,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
InternalSetup(3);
|
||||
Name2 := 'Move Tab idx=2 to 3 (SWAP) (Selected 3): ';
|
||||
@ -615,6 +686,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
InternalSetup(1);
|
||||
Name2 := 'Move Tab idx=3 to 1 (Selected 1): ';
|
||||
@ -627,6 +699,7 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
InternalSetup(2);
|
||||
Name2 := 'Move Tab idx=3 to 2 (SWAP backward) (Selected 2): ';
|
||||
@ -639,9 +712,161 @@ begin
|
||||
AssertEquals(Name+Name2+'Page 4 PageIndex is 4', 4, s4.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 5 PageIndex is 5', 5, s5.PageIndex);
|
||||
AssertEquals(Name+Name2+'Page 6 PageIndex is 6', 6, s6.PageIndex);
|
||||
CheckPaint(Name+Name2+' no painting', nil);
|
||||
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestPageControl.TestTabAndClientRect;
|
||||
var
|
||||
s0, s1, s2, s3: TTestSheet;
|
||||
Name, Name2: String;
|
||||
PgRect, PgRectScr: TRect;
|
||||
TsRect, TsRectScr: TRect;
|
||||
T0Rect, T0RectScr: TRect;
|
||||
T1Rect, T1RectScr: TRect;
|
||||
T2Rect, T2RectScr: TRect;
|
||||
T2Recta, T2RectaScr: TRect;
|
||||
T3Rect, T3RectScr: TRect;
|
||||
begin
|
||||
RecreateForm(True);
|
||||
s0 := CreatePage('abc', 0, []);
|
||||
s1 := CreatePage('a', 1, []);
|
||||
s2 := CreatePage('foo bar 123 ...', 2, []);
|
||||
PageControl.ActivePageIndex := 0;
|
||||
ResetCounts;
|
||||
ResetPaintCounts;
|
||||
Application.ProcessMessages;
|
||||
|
||||
PgRect := PageControl.ClientRect;
|
||||
PgRectScr.TopLeft := PageControl.ClientToScreen(PgRect.TopLeft);
|
||||
PgRectScr.BottomRight := PageControl.ClientToScreen(PgRect.BottomRight);
|
||||
|
||||
TsRect := s0.ClientRect;
|
||||
TsRectScr.TopLeft := s0.ClientToScreen(TsRect.TopLeft);
|
||||
TsRectScr.BottomRight := s0.ClientToScreen(TsRect.BottomRight);
|
||||
|
||||
T0Rect := PageControl.TabRect(0);
|
||||
T1Rect := PageControl.TabRect(1);
|
||||
T2Rect := PageControl.TabRect(2);
|
||||
T0RectScr.TopLeft := PageControl.ClientToScreen(T0Rect.TopLeft);
|
||||
T1RectScr.TopLeft := PageControl.ClientToScreen(T1Rect.TopLeft);
|
||||
T2RectScr.TopLeft := PageControl.ClientToScreen(T2Rect.TopLeft);
|
||||
T0RectScr.BottomRight := PageControl.ClientToScreen(T0Rect.BottomRight);
|
||||
T1RectScr.BottomRight := PageControl.ClientToScreen(T1Rect.BottomRight);
|
||||
T2RectScr.BottomRight := PageControl.ClientToScreen(T2Rect.BottomRight);
|
||||
|
||||
|
||||
//DebugLn([PageControl.TestGetTabBarHeight, ' /// ',
|
||||
// dbgs(PgRect),' / ', dbgs(PgRectScr),' / ',
|
||||
// dbgs(TsRect),' / ', dbgs(TsRectScr),' / ',
|
||||
// dbgs(T0Rect),' / ', dbgs(T0RectScr),' / ',
|
||||
// dbgs(T1Rect),' / ', dbgs(T1RectScr),' / ',
|
||||
// dbgs(T2Rect),' / ', dbgs(T2RectScr),' / ' ]);
|
||||
// just approx sanity checks
|
||||
// comparing absolute values
|
||||
|
||||
AssertTrue('Page in Container : Top', TsRectScr.Top >= PgRectScr.Top);
|
||||
AssertTrue('Page in Container : Left', TsRectScr.Left >= PgRectScr.Left);
|
||||
AssertTrue('Page in Container : Bottom', TsRectScr.Bottom <= PgRectScr.Bottom);
|
||||
AssertTrue('Page in Container : Right', TsRectScr.Right <= PgRectScr.Right);
|
||||
|
||||
// Allow a tiny overlap, in case
|
||||
AssertTrue('Tab1 above Container:', T0RectScr.Bottom -5 <= TsRectScr.Top);
|
||||
AssertTrue('Tab2 above Container:', T1RectScr.Bottom -5 <= TsRectScr.Top);
|
||||
AssertTrue('Tab3 above Container:', T2RectScr.Bottom -5 <= TsRectScr.Top);
|
||||
|
||||
AssertTrue('Tab1 at left side:', Abs(T0RectScr.Left - PgRectScr.Left) <= 15);
|
||||
|
||||
AssertTrue('Tab1 left of tab2 a:', T0RectScr.Left < T1RectScr.Left);
|
||||
AssertTrue('Tab1 left of tab2 b:', Abs(T0RectScr.Right - T1RectScr.Left) <=
|
||||
min(20, (T0Rect.Right-T0Rect.Left) div 2 )
|
||||
);
|
||||
AssertTrue('Tab2 left of tab3 a:', T1RectScr.Left < T2RectScr.Left);
|
||||
AssertTrue('Tab2 left of tab3 b:', Abs(T1RectScr.Right - T2RectScr.Left) <=
|
||||
Min(20, (T1Rect.Right-T1Rect.Left) div 2 )
|
||||
);
|
||||
|
||||
AssertTrue('TestGetTabBarHeight', Abs(PageControl.TestGetTabBarHeight-(T0Rect.Bottom-T0Rect.Top)) <= 20 );
|
||||
// Todo Width
|
||||
|
||||
(*
|
||||
* Hidden Tabs and Rect
|
||||
*)
|
||||
|
||||
s3 := CreatePage('p3', 2, []); // insert 2nd last
|
||||
|
||||
T2Recta := PageControl.TabRect(3);
|
||||
T3Rect := PageControl.TabRect(2);
|
||||
T2RectaScr.TopLeft := PageControl.ClientToScreen(T2Recta.TopLeft);
|
||||
T3RectScr.TopLeft := PageControl.ClientToScreen(T3Rect.TopLeft);
|
||||
T2RectaScr.BottomRight := PageControl.ClientToScreen(T2Recta.BottomRight);
|
||||
T3RectScr.BottomRight := PageControl.ClientToScreen(T3Rect.BottomRight);
|
||||
|
||||
AssertTrue('Tab4 at ex-tab3 left:', Abs(T3RectScr.Left - T2RectScr.Left) <= 5);
|
||||
AssertTrue('Tab3 went right:', T2RectaScr.Left > T2RectScr.Left);
|
||||
|
||||
s3.TabVisible := False;
|
||||
Application.ProcessMessages;
|
||||
|
||||
// TabRect takes an indek into VISBLE-only tabs
|
||||
T2Recta := PageControl.TabRect(2); // the old tab 2, since tab3 is hidden
|
||||
T2RectaScr.TopLeft := PageControl.ClientToScreen(T2Recta.TopLeft);
|
||||
T2RectaScr.BottomRight := PageControl.ClientToScreen(T2Recta.BottomRight);
|
||||
|
||||
AssertEquals('old and new tab2', T2Recta.Top, T2Rect.Top);
|
||||
AssertEquals('old and new tab2', T2Recta.Left, T2Rect.Left);
|
||||
AssertEquals('old and new tab2', T2Recta.Bottom, T2Rect.Bottom);
|
||||
AssertEquals('old and new tab2', T2Recta.Right, T2Rect.Right);
|
||||
end;
|
||||
|
||||
procedure TTestPageControl.TestSwitchTabByClick;
|
||||
var
|
||||
s0, s1, s2, s3: TTestSheet;
|
||||
Name, Name2: String;
|
||||
T0Rect, T0RectScr: TRect;
|
||||
T1Rect, T1RectScr: TRect;
|
||||
T2Rect, T2RectScr: TRect;
|
||||
T2Recta, T2RectaScr: TRect;
|
||||
T3Rect, T3RectScr: TRect;
|
||||
begin
|
||||
RecreateForm(True);
|
||||
s0 := CreatePage('abc', 0, []);
|
||||
s1 := CreatePage('a', 1, []);
|
||||
s2 := CreatePage('foo 1', 2, []);
|
||||
s3 := CreatePage('p3', 3, []);
|
||||
|
||||
T0Rect := PageControl.TabRect(0);
|
||||
T1Rect := PageControl.TabRect(1);
|
||||
T2Rect := PageControl.TabRect(2);
|
||||
T3Rect := PageControl.TabRect(3);
|
||||
T0RectScr.TopLeft := PageControl.ClientToScreen(T0Rect.TopLeft);
|
||||
T1RectScr.TopLeft := PageControl.ClientToScreen(T1Rect.TopLeft);
|
||||
T2RectScr.TopLeft := PageControl.ClientToScreen(T2Rect.TopLeft);
|
||||
T3RectScr.TopLeft := PageControl.ClientToScreen(T3Rect.TopLeft);
|
||||
T0RectScr.BottomRight := PageControl.ClientToScreen(T0Rect.BottomRight);
|
||||
T1RectScr.BottomRight := PageControl.ClientToScreen(T1Rect.BottomRight);
|
||||
T2RectScr.BottomRight := PageControl.ClientToScreen(T2Rect.BottomRight);
|
||||
T3RectScr.BottomRight := PageControl.ClientToScreen(T3Rect.BottomRight);
|
||||
|
||||
//DebugLn([ dbgs(T2Rect),' / ', dbgs(T2RectScr),' / ' ]);
|
||||
|
||||
ResetCounts;
|
||||
ResetPaintCounts;
|
||||
|
||||
Application.BringToFront;
|
||||
Form.BringToFront;
|
||||
Application.ProcessMessages;
|
||||
|
||||
MouseInput.Click(mbLeft, [], (T2RectScr.Right+T2RectScr.Left) div 2, (T2RectScr.Bottom+T2RectScr.Top) div 2);
|
||||
Application.ProcessMessages;
|
||||
AssertEquals(Name+Name2+'PageIndex 2', 2, PageControl.ActivePageIndex);
|
||||
AssertEquals(Name+Name2+'OnChanging', 1, FOnChangingCalled);
|
||||
AssertEquals(Name+Name2+'OnChange', 1, FOnChangeCalled);
|
||||
AssertEquals(Name+Name2+'OnChangList cnt', FOnChangesList.Count, 2);
|
||||
AssertEquals(Name+Name2+'OnChangList 0', FOnChangesList[0], 'Changing 0');
|
||||
AssertEquals(Name+Name2+'OnChangList 1', FOnChangesList[1], 'Changed 2');
|
||||
CheckPaint(Name+Name2+'paint', s2);
|
||||
|
||||
end;
|
||||
|
||||
|
||||
@ -25,19 +25,22 @@
|
||||
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="4">
|
||||
<RequiredPackages Count="5">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
<PackageName Value="LazMouseAndKeyInput"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FPCUnitTestRunner"/>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="FCL"/>
|
||||
<PackageName Value="FPCUnitTestRunner"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="CodeTools"/>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<PackageName Value="CodeTools"/>
|
||||
</Item5>
|
||||
</RequiredPackages>
|
||||
<Units Count="14">
|
||||
<Unit0>
|
||||
@ -136,6 +139,7 @@
|
||||
<CompilerMessages>
|
||||
<UseMsgFile Value="True"/>
|
||||
</CompilerMessages>
|
||||
<CustomOptions Value="-WC"/>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
|
||||
@ -22,7 +22,7 @@ program runtestsgui;
|
||||
|
||||
uses
|
||||
Interfaces, Forms,
|
||||
GuiTestRunner,
|
||||
GuiTestRunner, lazmouseandkeyinput,
|
||||
testunits, TestLazUtils;
|
||||
|
||||
begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user