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&lt;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&lt;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