unit tcHTMLWidgets;
{$mode objfpc}
interface
uses
Classes, SysUtils, fpcunit, testregistry, web, webwidget, htmlwidgets, tcwidget, js;
Type
{ TTestButtonWidget }
TTestButtonWidget = Class(TBaseTestWidget)
private
FButton: TButtonWidget;
Protected
Procedure SetUp; override;
Procedure TearDown; override;
Property Button : TButtonWidget Read FButton;
Published
Procedure TestTextBeforeRender;
Procedure TestTextAfterRender;
Procedure TestTextElementID;
Procedure TestClick;
end;
{ TTestLabelWidget }
TMyLabelWidget = Class(TLabelWidget)
Public
Property LabelElement;
end;
TTestLabelWidget = Class(TBaseTestWidget)
private
FEdit: TTextInputWidget;
FMy: TMyLabelWidget;
Protected
Procedure SetUp; override;
Procedure TearDown; override;
Property My : TMyLabelWidget Read FMy;
Property Edit : TTextInputWidget Read FEdit;
Published
Procedure TestPropsBeforeRender;
Procedure TestPropsAfterRender;
end;
{ TTestViewPort }
{ TMyViewPort }
TMyViewPort = Class(TViewPort)
Public
Procedure SetParentId;
Procedure SetParent;
Procedure SetElementID;
end;
TTestViewPort = Class(TBaseTestWidget)
private
FMy: TMyViewPort;
Protected
Procedure Setup; override;
Procedure TearDown; override;
Property My : TMyViewPort Read FMy;
Published
Procedure TestInstance;
Procedure TestHTMLTag;
Procedure TestElement;
Procedure TestUnrender;
Procedure TestNoParent;
Procedure TestNoElementID;
Procedure TestNoParentID;
end;
{ TTestPage }
{ TMyWebPage }
TMyWebPage = Class(TWebPage)
Public
Procedure SetParentId;
Procedure SetParent;
Procedure SetElementID;
end;
TTestPage = Class(TBaseTestWidget)
private
FMy: TMyWebPage;
Protected
Function CreateElement(aID : String) : TJSHTMLElement;
Procedure Setup; override;
Procedure TearDown; override;
Property My : TMyWebPage Read FMy;
Published
Procedure TestEmpty;
Procedure TestAsWindow;
Procedure TestNoParentOK;
Procedure TestDefaultTag;
end;
{ TBaseTestInputElement }
TInputHack = class(TCustomInputWidget)
Public
Property Element;
Property InputElement;
end;
TBaseTestInputElement = Class(TBaseTestWidget)
private
FMy: TCustomInputWidget;
function GetInputElement: TJSHTMLInputElement;
Protected
// Must be handled in descendent. Called during setup to populate My.
Function CreateInput : TCustomInputWidget; virtual; abstract;
// (Re)create my. Calls createinput
Procedure CreateMy; virtual;
Procedure Setup; override;
Procedure TearDown; override;
// Assert basic properties are correct on the element.
procedure AssertBaseProps(aType, aValueName, aValue: String; aText: String='');
Property My : TCustomInputWidget Read FMy;
Property InputElement : TJSHTMLInputElement Read GetInputElement;
Published
Procedure TestEmpty;
Procedure TestRequiredOnRender;
Procedure TestReadOnlyOnRender;
Procedure TestRequiredAfterRender;
Procedure TestReadOnlyAfterRender;
end;
{ TTestTextInputElement }
TTestTextInputElement = Class(TBaseTestInputElement)
Protected
FITT: TInputTextType;
Procedure setup; override;
Function CreateInput : TCustomInputWidget; override;
Function MyText : TTextInputWidget;
Published
Procedure TestDefaultTextType;
Procedure TestRender;
Procedure TestChangeValue;
Procedure TestChangeName;
Procedure TestChangeTextType;
Procedure TestTypePassword;
Procedure TestTypeNumber;
Procedure TestAsNumber;
Procedure TestTypeEmail;
Procedure TestTypeSearch;
Procedure TestTypeTel;
Procedure TestTypeURL;
Procedure TestTypeColor;
end;
{ TTestRadioInputElement }
TTestRadioInputElement = Class(TBaseTestInputElement)
Protected
Function CreateInput : TCustomInputWidget; override;
Function MyRadio : TRadioInputWidget;
Published
Procedure TestPropsOnRender;
Procedure TestPropsAfterRender;
end;
TTestCheckboxInputElement = Class(TBaseTestInputElement)
Protected
Function CreateInput : TCustomInputWidget; override;
Function MyCheckbox : TCheckboxInputWidget;
Published
Procedure TestPropsOnRender;
Procedure TestPropsAfterRender;
end;
TMyDateInputWidget = Class(TDateInputWidget)
end;
{ TTestDateInputElement }
TTestDateInputElement = Class(TBaseTestInputElement)
Protected
Function CreateInput : TCustomInputWidget; override;
Procedure CreateMy; override;
Function MyDate : TMyDateInputWidget;
Published
Procedure TestPropsOnRender;
Procedure TestPropsAfterRender;
end;
TMyFileInputWidget = Class(TFileInputWidget)
end;
{ TTestFileInputElement }
TTestFileInputElement = Class(TBaseTestInputElement)
Protected
Function CreateInput : TCustomInputWidget; override;
Procedure CreateMy; override;
Function MyFile : TMyFileInputWidget;
Published
Procedure TestPropsOnRender;
Procedure TestPropsAfterRender;
end;
TMyHiddenInputWidget = Class(THiddenInputWidget)
end;
{ TTestHiddenInputElement }
TTestHiddenInputElement = Class(TBaseTestInputElement)
Protected
Function CreateInput : TCustomInputWidget; override;
Function MyHidden : TMyHiddenInputWidget;
Published
Procedure TestPropsOnRender;
Procedure TestPropsAfterRender;
end;
{ TTestTextAreaElement }
TMyTextAreaWidget = Class(TTextAreaWidget)
Public
Property TextArea;
end;
TTestTextAreaElement = Class(TBaseTestWidget)
private
FMy: TMyTextAreaWidget;
function GetArea: TJSHTMLTextAreaElement;
Protected
Procedure Setup; override;
Procedure TearDown; override;
Property My : TMyTextAreaWidget Read FMy;
Property Area : TJSHTMLTextAreaElement Read GetArea;
Published
Procedure TestEmpty;
Procedure TestPropsOnRender;
Procedure TestPropsAfterRender;
end;
TMyImageWidget = Class(TImageWidget)
Public
Property Element;
end;
{ TTestImageElement }
TTestImageElement = Class(TBaseTestWidget)
private
FMy: TMyImageWidget;
function GetImg: TJSHTMLImageElement;
Protected
Procedure Setup; override;
Procedure TearDown; override;
Function ThisURL : String;
Property My : TMyImageWidget Read FMy;
Property Image : TJSHTMLImageElement Read GetImg;
Published
Procedure TestEmpty;
Procedure TestPropsOnRender;
Procedure TestPropsAfterRender;
end;
TMySelectWidget = Class(TSelectWidget)
Public
Property Element;
Property SelectElement;
Property Options;
end;
{ TTestSelectElement }
TTestSelectElement = Class(TBaseTestWidget)
private
FMy: TMySelectWidget;
procedure AssertOption(Idx: Integer; aText, aValue: String; Selected: Boolean=False);
function GetOptions: TJSHTMLOPtionElementArray;
function GetSelect: TJSHTMLSelectElement;
Protected
Procedure Setup; override;
Procedure TearDown; override;
Property My : TMySelectWidget Read FMy;
Property Select : TJSHTMLSelectElement Read GetSelect;
Property Options : TJSHTMLOPtionElementArray Read GetOptions;
Published
Procedure TestEmpty;
Procedure TestPropsOnRender;
Procedure TestPropsAfterRender;
Procedure TestMultiSelect;
Procedure TestNoSelectedIndex;
end;
TMyTextWidget = Class(TTextWidget)
Public
Property Element;
Property ParentElement;
end;
{ TTestTextWidget }
TTestTextWidget = Class(TBaseTestWidget)
private
FMy: TMyTextWidget;
Protected
Procedure Setup; override;
Procedure TearDown; override;
Property My : TMyTextWidget Read FMy;
Published
Procedure TestEmpty;
Procedure TestRenderText;
Procedure TestRenderedTextChange;
Procedure TestRenderHTML;
Procedure TestRenderedHTMLChange;
procedure TestTextModeChangeRenders;
procedure TestEnvelopeChangeRenders;
end;
TMyTextLinesWidget = Class(TTextLinesWidget)
Public
Property Element;
Property ParentElement;
end;
{ TTestTextLinesWidget }
TTestTextLinesWidget = Class(TBaseTestWidget)
private
FMy: TMyTextLinesWidget;
Protected
Procedure Setup; override;
Procedure TearDown; override;
Property My : TMyTextLinesWidget Read FMy;
Published
Procedure TestEmpty;
Procedure TestRenderText;
Procedure TestRenderedTextChange;
Procedure TestRenderTextLineBreaks;
Procedure TestRenderHTML;
Procedure TestRenderHTMLLineBreaks;
Procedure TestRenderedHTMLChange;
procedure TestTextModeChangeRenders;
procedure TestEnvelopeChangeRenders;
end;
{ TMyTableWidget }
TMyTableWidget = Class(TCustomTableWidget)
private
FRowCount: Integer;
Protected
Type
TMyTableRowCountEnumerator = Class(TTableRowCountEnumerator)
procedure GetCellData(aData: TTableWidgetCellData); override;
end;
Public
Constructor create(aOwner : TComponent); override;
Function GetBodyRowEnumerator : TTableRowEnumerator; override;
Function GetRowEnumerator(aKind: TRowKind): TTableRowEnumerator; override;
Property RowCount : Integer Read FRowCount Write FRowCount;
Property CustomColumns;
Property Caption;
Property TableOptions;
Property OnGetCellData;
Property OnCellClick;
Property OnHeaderCellClick;
Property OnFooterCellClick;
Property OnRowClick;
Property OnHeaderRowClick;
Property OnFooterRowClick;
end;
{ TTestTableWidget }
TTestTableWidget = Class(TBaseTestWidget)
private
FMy: TMyTableWidget;
FClickCount : Integer;
FClickEvent: TJSEvent;
procedure AssertTableCaption(El: TJSHTMLElement);
procedure CheckBodyCells(aParent: TJSHTMLELement);
procedure CheckBodyRow(aParent: TJSHTMLELement; aIndex: Integer);
procedure CheckCellData(el: TJSHTMLElement; aRow, aCol: Integer; rk: TRowKind; RowOption: TTableOption; ColOption: TTableOption);
procedure CheckHeaderCells(aParent: TJSHTMLELement);
procedure CheckFooterCells(aParent: TJSHTMLELement);
procedure CheckRowData(aRow: TJSHTMLELement; aRowKind: TRowKind; aRowKindOption: TTableOption; aIndex: integer);
procedure DoClickCount(Sender: TObject; Event: TJSEvent);
Protected
Procedure Setup; override;
Procedure TearDown; override;
Property My : TMyTableWidget Read FMy;
Published
Procedure TestEmpty;
Procedure TestRender;
Procedure TestRenderNoCaption;
Procedure TestRenderNoCaptionNoHeaders;
Procedure TestRenderFooters;
Procedure TestRenderNoheaderFooterBody;
Procedure TestRenderRowId;
Procedure TestRenderCellID;
Procedure TestRenderHeaderRowData;
Procedure TestRenderHeaderCellDataRow;
Procedure TestRenderHeaderCellDataCol;
Procedure TestRenderRowData;
Procedure TestRenderBodyCellDataRow;
Procedure TestRenderBodyCellDataCol;
Procedure TestRenderFooterRowData;
Procedure TestRenderFooterCellDataRow;
Procedure TestRenderFooterCellDataCol;
Procedure TestClickHeaderCell;
Procedure TestClickFooterCell;
Procedure TestClickCell;
Procedure TestClickRow;
Procedure TestClickRowFromCell;
Procedure TestClickHeaderRowFromHeaderCell;
Procedure TestClickFooterRowFromFooterCell;
end;
implementation
{ TTestTableWidget }
procedure TTestTableWidget.Setup;
begin
inherited Setup;
FMy:=TMyTableWidget.Create(Nil);
FMy.ParentID:=SBaseWindowID;
end;
procedure TTestTableWidget.TearDown;
begin
FreeAndNil(FMy);
inherited TearDown;
end;
procedure TTestTableWidget.TestEmpty;
begin
AssertNotNull('Have table',My);
AssertEquals('Have parentid',SBaseWindowID,My.ParentID);
AssertNotNull('Have table cols',My.CustomColumns);
AssertEquals('Have table col count',2,My.CustomColumns.Count);
end;
procedure TTestTableWidget.CheckHeaderCells(aParent : TJSHTMLELement);
Var
El : TJSHTMLElement;
I : integer;
Col : TCustomTableColumn;
begin
AssertEquals('Header row count',1, aParent.childElementCount);
aParent:=TJSHTMLElement(aParent.firstElementChild);
AssertnotNull('Have row',aParent);
AssertEquals('Have row tag','tr',LowerCase(aParent.tagname));
CheckRowData(aParent,rkHeader,toHeaderRowData,0);
AssertEquals('Header cell count',My.CustomColumns.Count, aParent.childElementCount);
I:=0;
el:=TJSHTMLElement(aParent.firstElementChild);
While el<>Nil do
begin
AssertTrue('have col avail',INil do
begin
AssertTrue('have col avail',I [] then
AssertEquals(S+'row kind data',S,String(el.Dataset['kind']))
else
AssertTrue(S+'cell empty row data',isUndefined(el.Dataset['kind']));
if (rowOption in My.TableOptions) then
AssertEquals(S+'cell row data',IntToStr(aRow),String(el.Dataset['row']))
else
AssertTrue(S+' cell empty row data',isUndefined(el.Dataset['row']));
if (ColOption in My.TableOptions) then
AssertEquals(S+' cell col data',IntToStr(aCol),String(el.Dataset['col']))
else
AssertTrue(S+' cell empty col data',isUndefined(el.Dataset['col']));
end;
procedure TTestTableWidget.CheckBodyRow(aParent : TJSHTMLELement; aIndex : Integer);
Var
El : TJSHTMLElement;
I : integer;
Col : TCustomTableColumn;
begin
CheckRowData(aParent,rkBody,toBodyRowData,aIndex);
AssertEquals('row cell count',My.CustomColumns.Count, aParent.childElementCount);
I:=0;
el:=TJSHTMLElement(aParent.firstElementChild);
While el<>Nil do
begin
AssertTrue('have col avail',Inil do
begin
AssertNotNull('Have row',aParent);
AssertEquals('Have row tag','tr',LowerCase(aParent.tagname));
CheckBodyRow(aParent,aRow);
aParent:=TJSHTMLElement(aParent.nextElementSibling);
inc(aRow);
end;
end;
procedure TTestTableWidget.AssertTableCaption(El : TJSHTMLElement);
begin
AssertTrue('Caption element',SameText('caption',el.tagName));
AssertEquals('Caption',My.Caption,El.InnerHTML)
end;
procedure TTestTableWidget.TestRender;
Var
El : TJSHTMLElement;
begin
My.Refresh;
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','table',Lowercase(My.Element.tagName));
AssertEquals('Sub elements',3,My.Element.childElementCount);
El:=TJSHTMLElement(My.Element.firstElementChild);
AssertTableCaption(El);
El:=TJSHTMLElement(El.nextElementSibling);
AssertEquals('Have head element','thead',LowerCase(el.tagName));
CheckHeaderCells(el);
El:=TJSHTMLElement(El.nextElementSibling);
AssertEquals('Have body element','tbody',LowerCase(el.tagName));
CheckBodyCells(el);
end;
procedure TTestTableWidget.TestRenderNoCaption;
Var
El : TJSHTMLElement;
begin
My.Caption:='';
My.Refresh;
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','table',Lowercase(My.Element.tagName));
AssertEquals('Sub elements',2,My.Element.childElementCount);
El:=TJSHTMLElement(My.Element.firstElementChild);
AssertEquals('Have head element','thead',LowerCase(el.tagName));
CheckHeaderCells(el);
El:=TJSHTMLElement(El.nextElementSibling);
AssertEquals('Have body element','tbody',LowerCase(el.tagName));
CheckBodyCells(el);
end;
procedure TTestTableWidget.TestRenderNoCaptionNoHeaders;
Var
El : TJSHTMLElement;
begin
My.Caption:='';
My.TableOptions:=My.TableOptions-[toHeaderRow];
My.Refresh;
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','table',Lowercase(My.Element.tagName));
AssertEquals('Sub elements',1,My.Element.childElementCount);
El:=TJSHTMLElement(My.Element.firstElementChild);
AssertEquals('Have body element','tbody',LowerCase(el.tagName));
CheckBodyCells(el);
end;
procedure TTestTableWidget.TestRenderFooters;
Var
El : TJSHTMLElement;
begin
My.TableOptions:=My.TableOptions+[toFooterRow];
My.Refresh;
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','table',Lowercase(My.Element.tagName));
AssertEquals('Sub elements',4,My.Element.childElementCount);
El:=TJSHTMLElement(My.Element.firstElementChild);
AssertTableCaption(El);
El:=TJSHTMLElement(El.nextElementSibling);
AssertEquals('Have head element','thead',LowerCase(el.tagName));
CheckHeaderCells(el);
El:=TJSHTMLElement(El.nextElementSibling);
AssertEquals('Have body element','tbody',LowerCase(el.tagName));
CheckBodyCells(el);
El:=TJSHTMLElement(El.nextElementSibling);
AssertEquals('Have footer element','tfoot',LowerCase(el.tagName));
CheckFooterCells(el);
end;
procedure TTestTableWidget.TestRenderNoheaderFooterBody;
Var
El : TJSHTMLElement;
begin
My.TableOptions:=My.TableOptions-[toFooter,toBody,toHeader]+[toFooterRow];
My.Refresh;
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','table',Lowercase(My.Element.tagName));
AssertEquals('Sub elements',5,My.Element.childElementCount);
El:=TJSHTMLElement(My.Element.firstElementChild);
AssertTableCaption(El);
El:=TJSHTMLElement(El.nextElementSibling);
AssertEquals('Have head element','tr',LowerCase(el.tagName));
El:=TJSHTMLElement(El.nextElementSibling);
AssertEquals('Have body element 1','tr',LowerCase(el.tagName));
CheckBodyRow(El,0);
El:=TJSHTMLElement(El.nextElementSibling);
AssertEquals('Have body element 2','tr',LowerCase(el.tagName));
CheckBodyRow(El,1);
El:=TJSHTMLElement(El.nextElementSibling);
AssertEquals('Have footer element','tr',LowerCase(el.tagName));
end;
procedure TTestTableWidget.TestRenderRowId;
begin
My.TableOptions:=My.TableOptions+[toRowID];
TestRender;// Check functions will do additional check.
end;
procedure TTestTableWidget.TestRenderCellID;
begin
My.TableOptions:=My.TableOptions+[toCellID];
TestRender;// Check functions will do additional check.
end;
procedure TTestTableWidget.TestRenderHeaderRowData;
begin
My.TableOptions:=My.TableOptions+[toHeaderRowData];
TestRender;// Check functions will do additional check.
end;
procedure TTestTableWidget.TestRenderHeaderCellDataRow;
begin
My.TableOptions:=My.TableOptions+[toHeaderCellDataRow];
TestRender;// Check functions will do additional check.
end;
procedure TTestTableWidget.TestRenderHeaderCellDataCol;
begin
My.TableOptions:=My.TableOptions+[toHeaderCellDataCol];
TestRender;// Check functions will do additional check.
end;
procedure TTestTableWidget.TestRenderRowData;
begin
My.TableOptions:=My.TableOptions+[toBodyRowData];
TestRender;// Check functions will do additional check.
end;
procedure TTestTableWidget.TestRenderBodyCellDataRow;
begin
My.TableOptions:=My.TableOptions+[toBodyCellDataRow];
TestRender;// Check functions will do additional check.
end;
procedure TTestTableWidget.TestRenderBodyCellDataCol;
begin
My.TableOptions:=My.TableOptions+[toBodyCellDataCol];
TestRender;// Check functions will do additional check.
end;
procedure TTestTableWidget.TestRenderFooterRowData;
begin
My.TableOptions:=My.TableOptions+[tofooterRowData];
TestRender;// Check functions will do additional check.
end;
procedure TTestTableWidget.TestRenderFooterCellDataRow;
begin
My.TableOptions:=My.TableOptions+[tofooterCellDataRow];
TestRender;// Check functions will do additional check.
end;
procedure TTestTableWidget.TestRenderFooterCellDataCol;
begin
My.TableOptions:=My.TableOptions+[tofooterCellDataCol];
TestRender;// Check functions will do additional check.
end;
procedure TTestTableWidget.TestClickHeaderCell;
Var
ev : TJSEvent;
el : TJSHTMLElement;
begin
My.Caption:='';
My.OnHeaderCellClick:=@DoClickCount;
My.Refresh;
AssertNotNull('Have element',My.Element);
ev:=TJSEvent.New('click');
el:=TJSHTMLElement(My.Element.firstElementChild.firstElementChild.firstElementChild);
AssertEquals('TH el','th',LowerCase(el.TagName));
el.dispatchEvent(ev);
AssertEquals('One click',1,FClickCount);
AssertSame('Event',ev,FClickEvent);
end;
procedure TTestTableWidget.TestClickFooterCell;
Var
ev : TJSEvent;
el : TJSHTMLElement;
begin
My.Caption:='';
My.TableOptions:=My.TableOptions-[toHeaderRow]+[toFooterRow];
My.OnFooterCellClick:=@DoClickCount;
My.Refresh;
AssertNotNull('Have element',My.Element);
ev:=TJSEvent.New('click');
el:=TJSHTMLElement(My.Element.firstElementChild.nextElementSibling.firstElementChild.firstElementChild);
AssertEquals('TD el','td',LowerCase(el.TagName));
el.dispatchEvent(ev);
AssertEquals('One click',1,FClickCount);
AssertSame('Event',ev,FClickEvent);
end;
procedure TTestTableWidget.TestClickCell;
Var
ev : TJSEvent;
el : TJSHTMLElement;
begin
My.Caption:='';
My.TableOptions:=My.TableOptions-[toHeaderRow];
My.OnCellClick:=@DoClickCount;
My.Refresh;
AssertNotNull('Have element',My.Element);
ev:=TJSEvent.New('click');
el:=TJSHTMLElement(My.Element.firstElementChild.firstElementChild.firstElementChild);
AssertEquals('TD el','td',LowerCase(el.TagName));
el.dispatchEvent(ev);
AssertEquals('One click',1,FClickCount);
AssertSame('Event',ev,FClickEvent);
end;
procedure TTestTableWidget.TestClickRow;
Var
ev : TJSEvent;
el : TJSHTMLElement;
begin
My.Caption:='';
My.TableOptions:=My.TableOptions-[toHeaderRow];
My.OnRowClick:=@DoClickCount;
My.Refresh;
AssertNotNull('Have element',My.Element);
ev:=TJSEvent.New('click');
el:=TJSHTMLElement(My.Element.firstElementChild.firstElementChild);
AssertEquals('TD el','tr',LowerCase(el.TagName));
el.dispatchEvent(ev);
AssertEquals('One click',1,FClickCount);
AssertSame('Event',ev,FClickEvent);
end;
procedure TTestTableWidget.TestClickRowFromCell;
Var
ev : TJSEvent;
el : TJSHTMLElement;
begin
My.Caption:='';
My.TableOptions:=My.TableOptions-[toHeaderRow];
My.OnRowClick:=@DoClickCount;
My.Refresh;
AssertNotNull('Have element',My.Element);
ev:=TJSEvent.New('click');
el:=TJSHTMLElement(My.Element.firstElementChild.firstElementChild.FirstElementChild);
AssertEquals('TD el','td',LowerCase(el.TagName));
el.dispatchEvent(ev);
AssertEquals('One click',1,FClickCount);
AssertSame('Event',ev,FClickEvent);
end;
procedure TTestTableWidget.TestClickHeaderRowFromHeaderCell;
Var
ev : TJSEvent;
el : TJSHTMLElement;
begin
My.Caption:='';
// My.TableOptions:=My.TableOptions;
My.OnHeaderRowClick:=@DoClickCount;
My.Refresh;
AssertNotNull('Have element',My.Element);
ev:=TJSEvent.New('click');
el:=TJSHTMLElement(My.Element.firstElementChild.firstElementChild.FirstElementChild);
AssertEquals('TD el','th',LowerCase(el.TagName));
el.dispatchEvent(ev);
AssertEquals('One click',1,FClickCount);
AssertSame('Event',ev,FClickEvent);
end;
procedure TTestTableWidget.TestClickFooterRowFromFooterCell;
Var
ev : TJSEvent;
el : TJSHTMLElement;
begin
My.Caption:='';
My.TableOptions:=My.TableOptions-[toHeaderRow]+[toFooterRow];
My.OnFooterRowClick:=@DoClickCount;
My.Refresh;
AssertNotNull('Have element',My.Element);
ev:=TJSEvent.New('click');
el:=TJSHTMLElement(My.Element.firstElementChild.nextElementSibling.firstElementChild.firstElementChild);
AssertEquals('TD el','td',LowerCase(el.TagName));
el.dispatchEvent(ev);
AssertEquals('One click',1,FClickCount);
AssertSame('Event',ev,FClickEvent);
end;
{ TMyTableWidget }
constructor TMyTableWidget.create(aOwner: TComponent);
begin
inherited create(aOwner);
CustomColumns.Add ('Col1');
CustomColumns.Add ('Col2');
Caption:='Our caption';
RowCount:=2;
end;
function TMyTableWidget.GetBodyRowEnumerator: TTableRowEnumerator;
begin
Result:=TMyTableRowCountEnumerator.Create(Self,RowCount);
end;
function TMyTableWidget.GetRowEnumerator(aKind: TRowKind): TTableRowEnumerator;
begin
if AKind=rkFooter then
Result:=TMyTableRowCountEnumerator.Create(Self,1)
else
Result:=Inherited GetRowEnumerator(aKind);
end;
procedure TMyTableWidget.TMyTableRowCountEnumerator.GetCellData(aData: TTableWidgetCellData);
begin
inherited GetCellData(aData);
Case aData.Kind of
rkBody :
aData.Text:=Format('cell[%d,%d]',[aData.Col,aData.Row]);
rkFooter :
begin
aData.Text:=Format('Footer[%d]',[aData.Col]);
end;
end;
end;
{ TTestTextLinesWidget }
procedure TTestTextLinesWidget.Setup;
begin
inherited Setup;
FMy:=TMyTextLinesWidget.Create(Nil);
FMy.ParentID:=SBaseWindowID;
FMy.Lines.Add('0<1');
FMy.Lines.Add('two');
end;
procedure TTestTextLinesWidget.TearDown;
begin
FreeAndNil(FMy);
inherited TearDown;
end;
procedure TTestTextLinesWidget.TestEmpty;
begin
AssertNotNull('Have widget',My);
AssertNull('widget not rendered',My.Element);
AssertTrue('Text mode default text',tmText=My.TextMode);
AssertTrue('Envelope tag default paragraph',ttParagraph=My.EnvelopeTag);
end;
procedure TTestTextLinesWidget.TestRenderText;
begin
My.Refresh;
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','P',My.Element.tagName);
AssertEquals('Have text','0<1'+slineBreak+'two'+slineBreak,My.Element.InnerText);
end;
procedure TTestTextLinesWidget.TestRenderedTextChange;
begin
My.Refresh;
My.Lines[1]:='Three';
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','P',My.Element.tagName);
AssertEquals('Have text','0<1'+slineBreak+'Three'+slineBreak,My.Element.InnerText);
end;
procedure TTestTextLinesWidget.TestRenderTextLineBreaks;
begin
My.ForceLineBreaks:=True;
My.Refresh;
AssertNotNull('Have element',My.Element);
AssertEquals('Have text','0<1'+slineBreak+'two'+slineBreak,My.Element.InnerText);
AssertEquals('Have HTML','0<1
two
',My.Element.InnerHtml);
end;
procedure TTestTextLinesWidget.TestRenderHTML;
begin
My.TextMode:=tmHTML;
My.Refresh;
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','P',My.Element.tagName);
AssertEquals('Have text','0<1 two',My.Element.InnerText);
AssertEquals('Have HTML','0<1'+sLineBreak+'two'+sLineBreak,My.Element.InnerHtml);
end;
procedure TTestTextLinesWidget.TestRenderHTMLLineBreaks;
begin
My.TextMode:=tmHTML;
My.ForceLineBreaks:=True;
My.Refresh;
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','P',My.Element.tagName);
AssertEquals('Have text','0<1'+slineBreak+'two'+slineBreak,My.Element.InnerText);
AssertEquals('Have HTML','0<1
two
',My.Element.InnerHtml);
end;
procedure TTestTextLinesWidget.TestRenderedHTMLChange;
begin
TestRenderHTML;
My.Lines[1]:='three';
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','P',My.Element.tagName);
AssertEquals('Have text','0<1 three',My.Element.InnerText);
AssertEquals('Have HTML','0<1'+sLineBreak+'three'+sLineBreak,My.Element.InnerHtml);
end;
procedure TTestTextLinesWidget.TestTextModeChangeRenders;
begin
TestRenderText;
My.TextMode:=tmHTML;
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','P',My.Element.tagName);
AssertEquals('Have text','0<1 two',My.Element.InnerText);
AssertEquals('Have HTML','0<1'+sLineBreak+'two'+sLineBreak,My.Element.InnerHtml);
end;
procedure TTestTextLinesWidget.TestEnvelopeChangeRenders;
begin
TestRenderText;
My.EnvelopeTag:=ttSpan;
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','SPAN',My.Element.tagName);
AssertEquals('Have text','0<1'+slineBreak+'two'+slineBreak,My.Element.InnerText);
end;
{ TTestTextWidget }
procedure TTestTextWidget.Setup;
begin
inherited Setup;
FMy:=TMyTextWidget.Create(Nil);
FMy.ParentID:=SBaseWindowID;
FMy.Text:='0<1';
end;
procedure TTestTextWidget.TearDown;
begin
FreeAndNil(FMy);
inherited TearDown;
end;
procedure TTestTextWidget.TestEmpty;
begin
AssertNotNull('Have widget',My);
AssertNull('widget not rendered',My.Element);
AssertTrue('Text mode default text',tmText=My.TextMode);
AssertTrue('Envelope tag default paragraph',ttParagraph=My.EnvelopeTag);
end;
procedure TTestTextWidget.TestRenderText;
begin
My.Refresh;
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','P',My.Element.tagName);
AssertEquals('Have text','0<1',My.Element.InnerText);
end;
procedure TTestTextWidget.TestRenderedTextChange;
begin
TestRenderText;
My.Text:='Something else';
AssertEquals('Have text','Something else',My.Element.InnerText);
end;
procedure TTestTextWidget.TestRenderHTML;
begin
My.TextMode:=tmHTML;
My.Refresh;
AssertNotNull('Have element',My.Element);
AssertEquals('Have element','P',My.Element.tagName);
AssertEquals('Have text','0<1',My.Element.InnerText);
AssertEquals('Have HTML','0<1',My.Element.InnerHtml);
end;
procedure TTestTextWidget.TestRenderedHTMLChange;
begin
TestRenderHtml;
My.Text:='2>1';
AssertEquals('Have text','2>1',My.Element.InnerText);
AssertEquals('Have HTML','2>1',My.Element.InnerHtml);
end;
procedure TTestTextWidget.TestTextModeChangeRenders;
begin
TestRenderText;
My.TextMode:=tmHTML;
AssertEquals('Have text','0<1',My.Element.InnerText);
AssertEquals('Have HTML','0<1',My.Element.InnerHtml);
end;
procedure TTestTextWidget.TestEnvelopeChangeRenders;
begin
TestRenderText;
My.EnvelopeTag:=ttSpan;
AssertEquals('Have element','SPAN',My.Element.tagName);
AssertEquals('Have text','0<1',My.Element.InnerText);
AssertEquals('Have HTML','0<1',My.Element.InnerHtml);
end;
{ TTestLabelWidget }
procedure TTestLabelWidget.SetUp;
begin
inherited SetUp;
FMy:=TMyLabelWidget.Create(Nil);
My.Text:='Your name';
My.ParentID:=SBaseWindowID;
FEdit:=TTextInputWidget.Create(Nil);
FEdit.ParentID:=SBaseWindowID;
FMy.LabelFor:=Edit;
end;
procedure TTestLabelWidget.TearDown;
begin
FreeAndNil(Fmy);
FreeAndNil(FEdit);
inherited TearDown;
end;
procedure TTestLabelWidget.TestPropsBeforeRender;
begin
Edit.Refresh;
My.Refresh;
AssertEquals('text','Your name',My.LabelElement.innerText);
AssertEquals('for',Edit.ElementID,My.LabelElement.For_);
end;
procedure TTestLabelWidget.TestPropsAfterRender;
begin
My.LabelFor:=Nil;
My.Refresh;
AssertEquals('text','Your name',My.LabelElement.innerText);
AssertEquals('for','',My.LabelElement.For_);
// Will render Edit!
My.LabelFor:=Edit;
AssertTrue('Have edit id',Edit.ElementID<>'');
My.Text:='My Name';
My.Refresh;
AssertEquals('text','My Name',My.LabelElement.innerText);
AssertEquals('for',Edit.ElementID,My.LabelElement.For_);
end;
{ TTestSelectElement }
function TTestSelectElement.GetOptions: TJSHTMLOPtionElementArray;
begin
Result:=My.Options;
end;
function TTestSelectElement.GetSelect: TJSHTMLSelectElement;
begin
Result:=My.SelectElement;
end;
procedure TTestSelectElement.Setup;
begin
inherited Setup;
FMy:=TMySelectWidget.Create(Nil);
FMy.ParentID:=SBaseWindowID;
FMy.Items.Add('One');
FMy.Items.Add('Two');
FMy.Items.Add('Three');
FMy.Values.Add('1');
FMy.Values.Add('2');
FMy.Values.Add('3');
FMy.SelectedIndex:=0;
end;
procedure TTestSelectElement.TearDown;
begin
FreeAndNil(FMy);
inherited TearDown;
end;
procedure TTestSelectElement.TestEmpty;
begin
AssertNotNull('Have widget',My);
AssertNull('Not rendered',My.Element);
end;
procedure TTestSelectElement.AssertOption(Idx : Integer; aText,aValue : String; Selected : Boolean= False);
Var
O : TJSHTMLOptionElement;
begin
AssertTrue('Correct index',Idx