unit tcWidget; {$mode objfpc} interface uses Classes, SysUtils, fpcunit, testregistry, js, web, webwidget; Const SBaseWindowID = 'widget-window'; // Must match what is in HTML File BaseID = SBaseWindowID; SMyChildID = 'mychild'; SMyParentID = 'myparent'; Type TJSEventClass = Class of TJSEvent; { TMyWebWidget } TMyWebWidget = Class(TWebWidget) private FAdd: String; Protected Function WidgetClasses: String; override; Function DoRenderHTML(aParent,aElement : TJSHTMLElement) :TJSHTMLElement; override; Public Function HTMLTag : String; override; Function MyElement : TJSHTMLElement; Function MyParent : TJSHTMLElement; Function MyContent : TJSHTMLElement; Function MyTop : TJSHTMLElement; Property AddedClasses : String Read FAdd Write FAdd; end; { TMyChildWidget } TMyChildWidget = Class(TMyWebWidget); TMySimpleChildWidget = Class(TMyChildWidget) Public Class Function AllowChildren : Boolean; override; end; TMyParentWidget = Class(TMyWebWidget); { TMySubContentWidget } TMySubContentWidget = Class(TMyParentWidget) Private FSub: TJSHTMLElement; Protected Function DoRenderHTML(aParent,aElement : TJSHTMLElement) :TJSHTMLElement; override; Public Procedure DoUnRender(aParent: TJSHTMLElement); override; function GetContentElement: TJSHTMLELement; override; end; { TMyPrefixSubContentWidget } TMyPrefixSubContentWidget = Class(TMySubContentWidget) Private FTop : TJSHTMLELement; Protected Function DoRenderHTML(aParent,aElement : TJSHTMLElement) :TJSHTMLElement; override; Public Procedure DoUnRender(aParent: TJSHTMLElement); override; function GetTopElement: TJSHTMLELement; override; end; { TMyRefWidget } TMyRefWidget = Class(TMyPrefixSubContentWidget) Protected FUL : TJSHTMLElement; FSubs : TJSHTMLElementArray; Function DoRenderHTML(aParent,aElement : TJSHTMLElement) :TJSHTMLElement; override; Public Property References; Property Subs : TJSHTMLElementArray read FSubs; Property UL : TJSHTMLElement read FUL; Property Element; end; { TBaseTestWidget } TBaseTestWidget = Class(TTestCase) private FBaseWindow: TJSHTMLElement; FEventCount : Integer; FEventSender : TObject; FEventName : String; FDefaultPrevented : Boolean; Protected Procedure SetUp; override; Procedure TearDown; override; procedure MyTestEventHandler(Sender: TObject; Event: TJSEvent); Procedure AssertEvent(aName : String; aElement : TCustomWebWidget = Nil); Function FindElement(aID : String) : TJSHTMLElement; Function GetElement(aID : String) : TJSHTMLElement; // Checks for /tag(id)/tag(id) Function AssertTree(aParent : TJSHTmlElement; aTree : String) :TJSHTMLElement; Function AssertTree(aTree : String) : TJSHTMLElement; Public Property BaseWindow : TJSHTMLElement read FBaseWindow; Property EventName : String Read FEventName; // Set in MyTestEventHandler; Property EventSender : TObject Read FEventSender; Property EventCount : Integer Read FEventCount; Property DefaultPrevented : Boolean read FDefaultPrevented; end; { TTestWidgetBasicOperations } TTestWidgetBasicOperations = Class(TBaseTestWidget) private FMy: TMyChildWidget; FMyParent: TMyParentWidget; FMySub: TMySubContentWidget; FMyTop: TMyPrefixSubContentWidget; function GetMySub: TMySubContentWidget; function GetTop: TMyPrefixSubContentWidget; Protected Procedure SetUp; override; Procedure TearDown; override; Function SetupElement : TJSHTMLElement; procedure SetupParentElement; // Check for event trigger procedure TriggerEvent(aName: String; aClass: TJSEventClass=nil); // Calls triggerevent and then testevent procedure TestEvent(aName: String); // Create parent element below windowbase function CreateParentElement : TJSHTMLElement; // Create child element below windowbase or below parent function CreateMyElement(asChild : Boolean = False) : TJSHTMLELement; // Set parent of child Procedure SetParentElement; // Set element ID of child Procedure DoSetElementID; // Set Parent ID of child Procedure DoSetParentID; // Set dataset element Procedure DoSetDataset; // Create parent element and bind parent widget to it. function SetupParent: TJSHTMLElement; Property MyWidget : TMyChildWidget Read FMy; Property MyParentWidget : TMyParentWidget Read FMyParent; Property MySubWidget : TMySubContentWidget Read GetMySub; Property MyTopWidget : TMyPrefixSubContentWidget Read GetTop; Published // Public Procedure TestEmpty; Procedure TestNoElementIDAndParentElementID; procedure TestNoParentElementIDAndElementID; Procedure TestParentIDToElement; Procedure TestElementIDToElement; Procedure TestSetParent; Procedure TestRenderParent; Procedure TestRenderParentID; Procedure TestUnRenderParent; Procedure TestUnRenderParentID; Procedure TestUnRenderElementID; Procedure TestSubContent; Procedure TestTopContent; Procedure TestAddClasses; Procedure TestAddClassesNormalized; Procedure TestRemoveClasses; Procedure TestRemoveClassesNormalized; Procedure TestClassesBeforeRender; Procedure TestClassesAfterRender; Procedure TestWidgetClassesBeforeRender; Procedure TestWidgetClassesAfterRender; Procedure TestClassesOnElementID; Procedure TestStylesBeforeRender; Procedure TestStylesAfterRender; Procedure TestStylesRefreshOnRender; Procedure TestVisibleBeforeRender; Procedure TestVisibleAfterRender; Procedure TestVisibleBeforeRenderPreserves; Procedure TestVisibleAfterRenderPreserves; Procedure TestGetData; Procedure TestSetData; Procedure TestGetDataNotRendered; Procedure TestSetDataNotRendered; Procedure TestEventClick; Procedure TestEventOnAbort; Procedure TestEventOnAnimationCancel; Procedure TestEventOnAnimationEnd; Procedure TestEventOnAnimationIteration; Procedure TestEventOnAnimationStart; Procedure TestEventOnAuxClick; Procedure TestEventOnBlur; Procedure TestEventOnCancel; Procedure TestEventOnCanPlay; Procedure TestEventOnCanPlayThrough; Procedure TestEventOnChange; Procedure TestEventOnClick; Procedure TestEventOnCompositionEnd; Procedure TestEventOnCompositionStart; Procedure TestEventOnCompositionUpdate; Procedure TestEventOnContextMenu; Procedure TestEventOnCopy; Procedure TestEventOnCut; Procedure TestEventOnCueChange; Procedure TestEventOnDblClick; Procedure TestEventOnDurationChange; Procedure TestEventOnEnded ; Procedure TestEventOnError ; Procedure TestEventOnFocus; Procedure TestEventOnFocusIn ; Procedure TestEventOnFocusOut ; Procedure TestEventOnGotPointerCapture; Procedure TestEventOnInput; Procedure TestEventOnInvalid; Procedure TestEventOnKeyDown; Procedure TestEventOnKeyPress; Procedure TestEventOnKeyUp; Procedure TestEventOnLoad; Procedure TestEventOnLoadedData; Procedure TestEventOnLoadedMetaData; Procedure TestEventOnLoadend; Procedure TestEventOnLoadStart; Procedure TestEventOnLostPointerCapture; Procedure TestEventOnMouseDown; Procedure TestEventOnMouseEnter; Procedure TestEventOnMouseLeave; Procedure TestEventOnMouseMove; Procedure TestEventOnMouseOut; Procedure TestEventOnMouseUp; Procedure TestEventOnOverFlow; Procedure TestEventOnPaste; Procedure TestEventOnPause; Procedure TestEventOnPlay; Procedure TestEventOnPointerCancel; Procedure TestEventOnPointerDown; Procedure TestEventOnPointerEnter; Procedure TestEventOnPointerLeave; Procedure TestEventOnPointerMove; Procedure TestEventOnPointerOut; Procedure TestEventOnPointerOver; Procedure TestEventOnPointerUp; Procedure TestEventOnReset; Procedure TestEventOnResize; Procedure TestEventOnScroll; Procedure TestEventOnSelect; Procedure TestEventOnSubmit; Procedure TestEventOnTouchStart; Procedure TestEventOnTransitionCancel; Procedure TestEventOnTransitionEnd; Procedure TestEventOnTransitionRun; Procedure TestEventOnTransitionStart; Procedure TestEventOnWheel; end; { TTestWebWidgetStyles } TTestWebWidgetStyles = Class(TBaseTestWidget) private FMy: TMyChildWidget; procedure AddDefaults; procedure AssertStyle(aIdx: integer; const AName, aValue: String; CheckElement: Boolean=True); function GetItems: TWebWidgetStyles; procedure GetNonExist; Public Procedure Setup; override; Procedure TearDown; override; Property MyWidget : TMyChildWidget Read FMy; Property Styles : TWebWidgetStyles Read GetItems; Published Procedure TestEmpty; Procedure TestAdd; Procedure TestAddOnRender; Procedure TestAddAfterRender; Procedure TestIndexOf; Procedure TestFind; Procedure TestGet; Procedure TestEnsure; Procedure TestEnsureRendered; Procedure TestApplyToDOM; Procedure TestRefreshFromDOM; Procedure TestDirty; Procedure TestClearImported; end; { TTestWebWidgetReferences } TTestWebWidgetReferences = Class(TBaseTestWidget) private FMy: TMyRefWidget; F : TReferenceItem; function GetItems: TWebWidgetReferences; Public Procedure Setup; override; Procedure TearDown; override; Procedure AddSet; Procedure GetDRef; Property MyWidget : TMyRefWidget Read FMy; Property References : TWebWidgetReferences Read GetItems; Published Procedure TestEmpty; Procedure TestAdd; Procedure TestIndexOf; Procedure TestIndexOfCaseInsensitive; Procedure TestFind; Procedure TestGet; Procedure SelectSingleBeforeRefresh; Procedure GetSingleByName; Procedure GetSingleNonExist; Procedure GetSingleByNameCaseInsensitive; Procedure SelectMultiBeforeRefresh; procedure GetMultiByName; procedure GetMultiNonExist; Procedure SelectSingleAfterRefresh; Procedure SelectMultiAfterRefresh; end; TTestLoopWidget = Class(TSimpleLoopTemplateWidget); { TTestSimpleLoopWidget } TTestSimpleLoopWidget = class(TBaseTestWidget) private FMy: TTestLoopWidget; procedure CheckCount(aCount: Integer; ParentEl: TJSHTmlElement=nil; aRowOffset : Integer = 0); procedure DoGetValue(Sender: TObject; aValue: TLoopTemplateValue); procedure DoGroupValue(Sender: TObject; aValue: TLoopTemplateValue); function GetItems: TWebWidgetReferences; Public Procedure Setup; override; Procedure TearDown; override; Property MyWidget : TTestLoopWidget Read FMy; Property References : TWebWidgetReferences Read GetItems; Published // Public Procedure TestSetup; Procedure TestRender; Procedure TestRenderAfterMaxCount; Procedure TestRenderAfterHeader; Procedure TestRenderAfterFooter; Procedure TestRenderAfterItem; Procedure TestRenderGetValue; Procedure TestRenderOneGroup; // Published Procedure TestRenderTwoGroups; end; implementation { TTestSimpleLoopWidget } Const SSimpleHeader = '
'+sLinebreak; SSimpleFooter = '
'+sLinebreak; SSimpleItem = '
{{_row_}}
{{_index_}}
'+sLinebreak; SSimpleItem2 = '
{{_row_}}
{{_name_}}
'+sLinebreak; SSimpleDivGroupHeader = '
'+sLinebreak; SSimpleDivGroupFooter = '
'+sLinebreak; SSimpleGroupHeader = '
'+sLinebreak; SSimpleGroupFooter = '
'+sLinebreak; function TTestSimpleLoopWidget.GetItems: TWebWidgetReferences; begin Result:=MyWidget.References end; procedure TTestSimpleLoopWidget.Setup; begin inherited Setup; FMy:=TTestLoopWidget.Create(Nil); FMy.HeaderTemplate:=SSimpleHeader; FMy.FooterTemplate:=SSimpleFooter; FMy.ItemTemplate:=SSimpleItem; FMy.ItemCount:=3; FMy.ParentID:=SBaseWindowID; end; procedure TTestSimpleLoopWidget.TearDown; begin FreeAndNil(FMy); inherited TearDown; end; procedure TTestSimpleLoopWidget.TestSetup; begin AssertNotnull('have widget',MyWidget); AssertEquals('Have header template',SSimpleHeader,MyWidget.HeaderTemplate); AssertEquals('Have footer template',SSimpleFooter,MyWidget.FooterTemplate); AssertEquals('Have item template',SSimpleItem,MyWidget.ItemTemplate); end; procedure TTestSimpleLoopWidget.CheckCount(aCount: Integer; ParentEl: TJSHTmlElement; aRowOffset: Integer); Var El,EL2 : TJSHTMLElement; S : String; I : Integer; begin // Checks for /tag(id)/tag(id) //Function AssertTree(dl>aParent : TJSHTmlElement; aTree : String) :TJSHTMLElement; if Assigned(ParentEl) then El:=AssertTree(ParentEl,'dt('+IntToStr(1+aRowOffset)+')') else El:=AssertTree('dl/dt('+IntToStr(1+aRowOffset)+')'); For I:=1 to aCount do begin S:=IntToStr(aRowOffset+I); AssertEquals('dt text '+S,S,El.InnerText); El:=TJSHTMLElement(El.nextElementSibling); AssertNotNull('Have element '+S,El); AssertEquals('Have dd element '+S,'dd',LowerCase(El.TagName)); AssertEquals('dd text '+S,IntToStr(aRowOffset+I-1),El.InnerText); El:=TJSHTMLElement(El.nextElementSibling); if I<>aCount then begin AssertNotNull('Have next DT element '+S,El); AssertEquals('Have next DT element id',IntToStr(aRowOffset+I+1),El.ID); end else AssertNull('Last element : done',el); end; end; procedure TTestSimpleLoopWidget.DoGetValue(Sender: TObject; aValue: TLoopTemplateValue); begin With aValue do begin if Name='name' then Value:='Name-'+IntToStr(Index); end; end; procedure TTestSimpleLoopWidget.DoGroupValue(Sender: TObject; aValue: TLoopTemplateValue); begin if aValue.Name='divsplit' then aValue.Value:=IntToStr(aValue.Index div 10) else aValue.Value:=IntToStr(aValue.Index div 3); // Writeln('Calculating group ',aValue.name,' value ',aValue.Value,' from index ',aValue.Index); end; procedure TTestSimpleLoopWidget.TestRender; begin MyWidget.Refresh; CheckCount(3); end; procedure TTestSimpleLoopWidget.TestRenderAfterMaxCount; begin MyWidget.Refresh; MyWidget.ItemCount:=2; CheckCount(2); end; procedure TTestSimpleLoopWidget.TestRenderAfterHeader; begin MyWidget.Refresh; MyWidget.HeaderTemplate:='
'; AssertTree('dl(666)'); CheckCount(3); end; procedure TTestSimpleLoopWidget.TestRenderAfterFooter; begin MyWidget.Refresh; MyWidget.FooterTemplate:='

me

'; CheckCount(3); AssertTree('p(me)'); end; procedure TTestSimpleLoopWidget.TestRenderAfterItem; begin MyWidget.Refresh; MyWidget.ItemTemplate:='
{{row}}
'; AssertTree('dl/dt(0)'); AssertTree('dl/dt(1)'); AssertTree('dl/dt(2)'); end; procedure TTestSimpleLoopWidget.TestRenderGetValue; begin MyWidget.OnGetValue:=@DoGetValue; MyWidget.Refresh; MyWidget.ItemTemplate:='
{{row}}
'; AssertTree('dl/dt(name-0)'); AssertTree('dl/dt(name-1)'); AssertTree('dl/dt(name-2)'); end; procedure TTestSimpleLoopWidget.TestRenderOneGroup; Var El : TJSHTMLElement; begin MyWidget.ItemCount:=9; MyWidget.ContainerTag:='div'; MyWidget.HeaderTemplate:=''; MyWidget.FooterTemplate:=''; MyWidget.Groups.AddGroup('split',SSimpleGroupHeader,SSimpleGroupFooter); MyWidget.OnGetGroupValue:=@DoGroupValue; MyWidget.Refresh; el:=AssertTree('div/dl(grp_0)'); CheckCount(3,El,0); el:=AssertTree('div/dl(grp_1)'); CheckCount(3,El,3); el:=AssertTree('div/dl(grp_2)'); CheckCount(3,El,6); end; procedure TTestSimpleLoopWidget.TestRenderTwoGroups; Var El : TJSHTMLElement; begin MyWidget.ItemCount:=27; MyWidget.ContainerTag:='div'; MyWidget.HeaderTemplate:=''; MyWidget.FooterTemplate:=''; MyWidget.Groups.AddGroup('divsplit',SSimpleDivGroupHeader,SSimpleDivGroupFooter); MyWidget.Groups.AddGroup('split',SSimpleGroupHeader,SSimpleGroupFooter); MyWidget.OnGetGroupValue:=@DoGroupValue; MyWidget.Refresh; // 0 -- 9 el:=AssertTree('div/div(div_0)/dl(grp_0)'); CheckCount(3,El,0); el:=AssertTree('div/div(div_0)/dl(grp_1)'); CheckCount(3,El,3); el:=AssertTree('div/div(div_0)/dl(grp_2)'); CheckCount(3,El,6); el:=AssertTree('div/div(div_0)/dl(grp_3)'); CheckCount(1,El,9); // 10-19 el:=AssertTree('div/div(div_1)/dl(grp_3)'); CheckCount(2,El,10); el:=AssertTree('div/div(div_1)/dl(grp_4)'); CheckCount(3,El,12); el:=AssertTree('div/div(div_1)/dl(grp_5)'); CheckCount(3,El,15); el:=AssertTree('div/div(div_1)/dl(grp_6)'); CheckCount(2,El,18); // 20-27 el:=AssertTree('div/div(div_2)/dl(grp_6)'); CheckCount(1,El,20); el:=AssertTree('div/div(div_2)/dl(grp_7)'); CheckCount(3,El,21); el:=AssertTree('div/div(div_2)/dl(grp_8)'); CheckCount(3,El,24); end; { TMyChildWidget } class function TMySimpleChildWidget.AllowChildren: Boolean; begin Result:=False; end; { TMyRefWidget } function TMyRefWidget.DoRenderHTML(aParent, aElement: TJSHTMLElement): TJSHTMLElement; { Final tree should be
} Var I : Integer; begin Result:=inherited DoRenderHTML(aParent, aElement); FUL:=TJSHTMLElement(Document.CreateElement('ul')); Result.insertBefore(Ful,FSub); SetLength(FSubs,10); For I:=0 to 9 do begin FSubs[i]:=TJSHTMLElement(Document.CreateElement('li')); FSubs[i].InnerText:='item '+IntToStr(I); FUL.AppendChild(FSubs[i]); end; end; { TTestWebWidgetReferences } function TTestWebWidgetReferences.GetItems: TWebWidgetReferences; begin Result:=FMy.References; end; procedure TTestWebWidgetReferences.Setup; begin inherited Setup; FMy:=TMyRefWidget.Create(Nil); FMy.ParentID:=SBaseWindowID; end; procedure TTestWebWidgetReferences.TearDown; begin FreeAndNil(FMy); inherited TearDown; end; procedure TTestWebWidgetReferences.AddSet; begin MyWidget.References.Add('a','div'); MyWidget.References.Add('b','ul'); MyWidget.References.Add('c','ul>li'); end; procedure TTestWebWidgetReferences.GetDRef; begin F:=References.GetReference('D'); end; procedure TTestWebWidgetReferences.TestEmpty; begin AssertNotNull('Have widget',MyWidget); AssertNull('widget not rendered',MyWidget.Element); AssertEquals('No references',0,MyWidget.References.Count); AssertSame('Correct references prop',MyWidget.References,References); end; procedure TTestWebWidgetReferences.TestAdd; begin AddSet; With References do begin AssertEquals('Count',3,Count); AssertEquals('0 : Name','a',Items[0].name); AssertEquals('0 : Selector','div',Items[0].Selector); AssertEquals('1 : Name','b',Items[1].name); AssertEquals('1 : Selector','ul',Items[1].selector); AssertEquals('2 : Name','c',Items[2].name); AssertEquals('2 : Selector','ul>li',Items[2].selector); end; end; procedure TTestWebWidgetReferences.TestIndexOf; begin AddSet; AssertEquals('a',0,References.IndexOfReference('a')); AssertEquals('b',1,References.IndexOfReference('b')); AssertEquals('c',2,References.IndexOfReference('c')); AssertEquals('d',-1,References.IndexOfReference('d')); end; procedure TTestWebWidgetReferences.TestIndexOfCaseInsensitive; begin AddSet; AssertEquals('a',0,References.IndexOfReference('A')); AssertEquals('b',1,References.IndexOfReference('B')); AssertEquals('c',2,References.IndexOfReference('C')); AssertEquals('d',-1,References.IndexOfReference('D')); end; procedure TTestWebWidgetReferences.TestFind; begin AddSet; AssertSame('A',References.Items[0],References.FindReference('A')); AssertSame('a',References.Items[0],References.FindReference('a')); AssertNull('e',References.FindReference('E')); end; procedure TTestWebWidgetReferences.TestGet; begin AddSet; AssertSame('A',References.Items[0],References.GetReference('A')); AssertSame('a',References.Items[0],References.GetReference('a')); AssertException('Get unknown',EWidgets,@GetDRef); end; procedure TTestWebWidgetReferences.SelectSingleBeforeRefresh; begin MyWidget.References.Add('me','ul'); AssertEquals('Ref count',1,MyWidget.References.Count); MyWidget.Refresh; AssertEquals('count of References found',1,Length(References.Items[0].Elements)); AssertSame('first array Reference filled',MyWidget.UL,References.Items[0].Elements[0]); AssertSame('Reference filled',MyWidget.UL,References.Items[0].Element); end; procedure TTestWebWidgetReferences.GetSingleByName; begin MyWidget.References.Add('me','ul'); AssertEquals('Ref count',1,MyWidget.References.Count); MyWidget.Refresh; AssertEquals('count of References found',1,Length(References.Items[0].Elements)); AssertSame('first array Reference filled',MyWidget.UL,References.Items[0].Elements[0]); AssertSame('Reference filled',MyWidget.UL,MyWidget.references.GetElementByName('me')); AssertEquals('Reference filled',1,Length(MyWidget.references.GetElementsByName('me'))); AssertSame('Reference filled',MyWidget.UL,MyWidget.references.GetElementsByName('me')[0]); end; procedure TTestWebWidgetReferences.GetSingleNonExist; begin MyWidget.References.Add('me','ul'); AssertEquals('Ref count',1,MyWidget.References.Count); MyWidget.Refresh; AssertNull('Reference filled',MyWidget.references.GetElementByName('a')); end; procedure TTestWebWidgetReferences.GetSingleByNameCaseInsensitive; begin MyWidget.References.Add('ME','ul'); AssertEquals('Ref count',1,MyWidget.References.Count); MyWidget.Refresh; AssertEquals('count of References found',1,Length(References.Items[0].Elements)); AssertSame('first array Reference filled',MyWidget.UL,References.Items[0].Elements[0]); AssertSame('Reference filled',MyWidget.UL,MyWidget.references.GetElementByName('me')); AssertEquals('Reference filled',1,Length(MyWidget.references.GetElementsByName('me'))); AssertSame('Reference filled',MyWidget.UL,MyWidget.references.GetElementsByName('me')[0]); end; procedure TTestWebWidgetReferences.SelectMultiBeforeRefresh; Var I : integer; begin MyWidget.References.Add('me','li'); AssertEquals('Ref count',1,MyWidget.References.Count); MyWidget.Refresh; AssertEquals('Count of References found',10,Length(References.Items[0].Elements)); for I:=0 to Length(MyWidget.FSubs)-1 do AssertSame('1 array Reference filled',MyWidget.Subs[I],References.Items[0].Elements[i]); AssertSame('first Reference filled',MyWidget.Subs[0],References.Items[0].Element); end; procedure TTestWebWidgetReferences.GetMultiByName; Var I : integer; a : TJSHTMLElementArray; begin MyWidget.References.Add('me','li'); AssertEquals('Ref count',1,MyWidget.References.Count); MyWidget.Refresh; a:=References.GetElementsByname('me'); AssertEquals('Count of References found',10,Length(a)); for I:=0 to Length(MyWidget.FSubs)-1 do AssertSame('1 array Reference filled',MyWidget.Subs[I],a[i]); end; procedure TTestWebWidgetReferences.GetMultiNonExist; Var a : TJSHTMLElementArray; begin MyWidget.References.Add('me','li'); AssertEquals('Ref count',1,MyWidget.References.Count); MyWidget.Refresh; A:=References.GetElementsByName('no'); AssertNotNull('Empty array 1',A); AssertEquals('Empty array 2',0, Length(A)); end; procedure TTestWebWidgetReferences.SelectSingleAfterRefresh; begin MyWidget.Refresh; MyWidget.References.Add('me','ul'); AssertEquals('Ref count',1,MyWidget.References.Count); AssertEquals('count of References found',1,Length(References.Items[0].Elements)); AssertSame('first array Reference filled',MyWidget.UL,References.Items[0].Elements[0]); AssertSame('Reference filled',MyWidget.UL,References.Items[0].Element); end; procedure TTestWebWidgetReferences.SelectMultiAfterRefresh; Var I : integer; begin MyWidget.Refresh; MyWidget.References.Add('me','li'); AssertEquals('Ref count',1,MyWidget.References.Count); AssertEquals('Count of References found',10,Length(References.Items[0].Elements)); for I:=0 to Length(MyWidget.FSubs)-1 do AssertSame('1 array Reference filled',MyWidget.Subs[I],References.Items[0].Elements[i]); AssertSame('first Reference filled',MyWidget.Subs[0],References.Items[0].Element); end; { TTestWebWidgetStyles } function TTestWebWidgetStyles.GetItems: TWebWidgetStyles; begin Result:=MyWidget.Styles; end; procedure TTestWebWidgetStyles.Setup; begin inherited Setup; FMy:=TMyChildWidget.Create(Nil); FMy.ParentID:=SBaseWindowID; end; procedure TTestWebWidgetStyles.TearDown; begin FreeAndNil(FMy); inherited TearDown; end; procedure TTestWebWidgetStyles.TestEmpty; begin AssertNotNull('Have widget',MyWidget); AssertNotNull('Have widget styles',MyWidget.Styles); AssertNull('Not yet rendered',MyWidget.MyElement); end; procedure TTestWebWidgetStyles.AssertStyle(aIdx : integer; const AName,aValue : String; CheckElement : Boolean = True); begin AssertTrue('Correct index',(aIdx>=0) and (aIdx-1); AssertStyle(idx,'display','block',False); AssertTrue('display imported',Styles[idx].Imported); idx:=Styles.IndexOfStyle('min-width'); AssertTrue('Have min-width',idx<>-1); AssertStyle(idx,'min-width','40px',False); AssertTrue('min-width imported',Styles[idx].Imported); idx:=Styles.IndexOfStyle('min-height'); AssertTrue('Have min-height',idx<>-1); AssertStyle(idx,'min-height','50px',False); AssertTrue('min-height imported',Styles[idx].Imported); end; procedure TTestWebWidgetStyles.TestDirty; begin MyWidget.Refresh; Styles.Add('display','none'); AssertStyle(0,'display','none',True); Styles.EnsureStyle('display','block'); AssertStyle(0,'display','block',True); end; procedure TTestWebWidgetStyles.TestClearImported; begin TestRefreshFromDOM; Styles.ClearImported; AssertEquals('None left',0,Styles.Count); end; { TMyPrefixSubContentWidget } function TMyPrefixSubContentWidget.DoRenderHTML(aParent, aElement: TJSHTMLElement): TJSHTMLElement; begin Result:=inherited DoRenderHTML(aParent, aElement); FTop:=CreateElement('span',aElement.ID+'-span'); aParent.removeChild(aElement); FTop.AppendChild(aElement); aParent.appendChild(FTop); end; procedure TMyPrefixSubContentWidget.DoUnRender(aParent: TJSHTMLElement); begin inherited DoUnRender(aParent); FTop:=Nil; end; function TMyPrefixSubContentWidget.GetTopElement: TJSHTMLELement; begin Result:=FTop; end; { TMySubContentWidget } function TMySubContentWidget.DoRenderHTML(aParent, aElement: TJSHTMLElement): TJSHTMLElement; begin Result:=inherited DoRenderHTML(aParent, aElement); FSub:=CreateElement('div',aElement.ID+'-sub'); Result.AppendChild(FSub); end; procedure TMySubContentWidget.DoUnRender(aParent: TJSHTMLElement); begin inherited DoUnRender(aParent); FSub:=nil; end; function TMySubContentWidget.GetContentElement: TJSHTMLELement; begin Result:=FSub; end; { TMyWebWidget } function TMyWebWidget.WidgetClasses: String; begin Result:=FAdd; end; function TMyWebWidget.DoRenderHTML(aParent,aElement: TJSHTMLElement): TJSHTMLElement; begin // Do nothing if aParent<>Nil then; Result:=aElement; end; function TMyWebWidget.HTMLTag: String; begin Result:='div' end; function TMyWebWidget.MyElement: TJSHTMLElement; begin Result:=Element; end; function TMyWebWidget.MyParent: TJSHTMLElement; begin Result:=ParentElement; end; function TMyWebWidget.MyContent: TJSHTMLElement; begin Result:=ContentElement; end; function TMyWebWidget.MyTop: TJSHTMLElement; begin Result:=TopElement; end; { TTestWidgetBasicOperations } function TTestWidgetBasicOperations.GetTop: TMyPrefixSubContentWidget; begin if FMyTop=Nil then FMyTop:=TMyPrefixSubContentWidget.Create(Nil); Result:=FMyTop; end; function TTestWidgetBasicOperations.GetMySub: TMySubContentWidget; begin If FMySub=Nil then FMySub:=TMySubContentWidget.Create(Nil); Result:=FMySub; end; procedure TTestWidgetBasicOperations.SetUp; begin inherited SetUp; FMy:=TMyChildWidget.Create(Nil); AssertEquals('Correct tag','div',FMy.HTMLTag); FMyParent:=TMyParentWidget.Create(Nil); AssertEquals('Correct parent tag','div',FMyParent.HTMLTag); FEventCount:=0; FEventSender:=Nil; FEventName:=''; FDefaultPrevented:=False; FMySub:=Nil; FMyTop:=Nil; end; procedure TTestWidgetBasicOperations.TearDown; begin FreeAndNil(FMySub); FreeAndNil(FMyTop); FreeAndNil(FMy); FreeAndNil(FMyParent); inherited TearDown; end; procedure TTestWidgetBasicOperations.TriggerEvent(aName: String; aClass : TJSEventClass = Nil); Var ev : TJSEvent; begin if aClass=Nil then ev:=TJSEvent.New(aName) else ev:=aClass.New(aName); FDefaultPrevented:=FMy.EnsureElement.dispatchEvent(ev); end; function TTestWidgetBasicOperations.CreateParentElement: TJSHTMLElement; begin Result:=TJSHTMLElement(Document.CreateElement('div')); Result.Id:=SMyParentID; BaseWindow.AppendChild(Result); end; function TTestWidgetBasicOperations.CreateMyElement(asChild: Boolean = False): TJSHTMLELement; Var El : TJSHTMLElement; begin if AsChild then El:=CreateParentElement else El:=BaseWindow; Result:=TJSHTMLElement(Document.CreateElement('div')); Result.Id:=SMyChildID; El.AppendChild(Result); end; procedure TTestWidgetBasicOperations.SetParentElement; begin FMy.Parent:=FMyParent; end; procedure TTestWidgetBasicOperations.DoSetElementID; begin FMy.ElementID:=SMyChildID; end; procedure TTestWidgetBasicOperations.DoSetParentID; begin FMy.ParentID:=SMyParentID;; end; procedure TTestWidgetBasicOperations.DoSetDataset; begin MyWidget.Data['name']:='me'; end; function TTestWidgetBasicOperations.SetupParent: TJSHTMLElement; begin Result:=CreateParentElement; FMyParent.ElementID:=SMyParentID; end; procedure TTestWidgetBasicOperations.TestEmpty; begin AssertNotNull(MyWidget); AssertNotNull(MyParentWidget); end; procedure TTestWidgetBasicOperations.TestNoElementIDAndParentElementID; begin DoSetElementID; AssertException('Cannot set both',EWidgets,@DoSetParentID); end; procedure TTestWidgetBasicOperations.TestNoParentElementIDAndElementID; begin DoSetParentID; AssertException('Cannot set both',EWidgets,@DoSetElementID); end; procedure TTestWidgetBasicOperations.TestParentIDToElement; Var El : TJSHTMLElement; begin El:=CreateParentElement; DoSetParentID; AssertSame('Correct parent element',El,MyWidget.MyParent); AssertSame('Correct content element',MyWidget.MyElement,MyWidget.MyContent); AssertTree('div('+SMyParentID+')'); end; procedure TTestWidgetBasicOperations.TestElementIDToElement; Var El : TJSHTMLElement; begin El:=CreateMyElement; DoSetElementID; AssertSame('Correct element',El,MyWidget.MyElement); AssertSame('Correct content element',El,MyWidget.MyContent); AssertTree('div('+SMyChildID+')'); AssertEquals('Have element data',el.ID,String(el.dataset['wwElement'])); AssertEquals('Have element top data',el.ID,String(el.dataset['wwElementTop'])); AssertEquals('Have element content data',el.ID,String(el.dataset['wwElementContent'])); end; procedure TTestWidgetBasicOperations.TestSetParent; Var El : TJSHTMLElement; begin El:=SetupParent; AssertSame('Correct parent element',El,MyParentWidget.MyElement); MyWidget.Parent:=MyParentWidget; AssertEquals('Child count correct',1,MyParentWidget.ChildCount); AssertSame('Correct parent element',El,MyWidget.MyParent); AssertNull('No element yet',MyWidget.Element); MyWidget.Refresh; AssertTrue('Have element ID',MyWidget.ElementID<>''); AssertTree('div('+SMyParentID+')/div('+MyWidget.ElementID+')'); // No ID assigned ! MyWidget.Parent:=Nil; AssertEquals('Child count correct',0,MyParentWidget.ChildCount); AssertNull('No more parent element ',MyWidget.MyParent); end; procedure TTestWidgetBasicOperations.TestRenderParent; Var El,El2 : TJSHTMLElement; begin El:=SetupParent; MyWidget.Parent:=MyParentWidget; MyWidget.Refresh; El2:=MyWidget.MyElement; AssertNotNull('Have element',El2); AssertSame('Have content element',El2,MyWidget.MyContent); AssertSame('Have correct parent element',El,El2.parentElement); AssertSame('Have correct parent',El,MyWidget.MyParent); AssertEquals('Correct ID',el2.ID,MyWidget.ElementiD); AssertEquals('Have element data',el2.ID,String(el2.dataset['wwElement'])); AssertEquals('Have element top data',el2.ID,String(el2.dataset['wwElementTop'])); AssertEquals('Have element content data',el2.ID,String(el2.dataset['wwElementContent'])); end; procedure TTestWidgetBasicOperations.TestRenderParentID; Var El,El2 : TJSHTMLElement; begin El:=CreateParentElement; MyWidget.ParentID:=el.ID; MyWidget.Refresh; El2:=MyWidget.MyElement; AssertNotNull('Have element',El2); AssertSame('Have content element',El2,MyWidget.MyContent); AssertSame('Have correct parent element',El,El2.parentElement); AssertSame('Have correct parent',El,MyWidget.MyParent); AssertEquals('Correct ID',el2.ID,MyWidget.ElementiD); AssertEquals('Have element data',el2.ID,String(el2.dataset['wwElement'])); AssertEquals('Have element top data',el2.ID,String(el2.dataset['wwElementTop'])); AssertEquals('Have element content data',el2.ID,String(el2.dataset['wwElementContent'])); end; procedure TTestWidgetBasicOperations.TestUnRenderParent; Var El,El2 : TJSHTMLElement; begin El:=SetupParent; MyWidget.Parent:=MyParentWidget; MyWidget.Refresh; El2:=MyWidget.MyElement; AssertNotNull('Have element',El2); MyWidget.Parent:=Nil; AssertEquals('Not rendered any more',0,el.childElementCount); AssertNull('Have no more element',MyWidget.MyElement); AssertNull('Have no more parent element',MyWidget.MyParent); end; procedure TTestWidgetBasicOperations.TestUnRenderParentID; Var El,El2 : TJSHTMLElement; begin El:=CreateParentElement; MyWidget.ParentID:=el.ID; MyWidget.Refresh; El2:=MyWidget.MyElement; AssertNotNull('Have element',El2); MyWidget.ParentID:=''; AssertEquals('Not rendered any more',0,el.childElementCount); AssertNull('Have no more element',MyWidget.MyElement); AssertNull('Have no more parent element',MyWidget.MyParent); end; procedure TTestWidgetBasicOperations.TestUnRenderElementID; Var El : TJSHTMLElement; begin TestElementIDToElement; El:=MyWidget.MyElement; // This will unrender MyWidget.ElementID:=''; AssertTrue('Have removed element data', IsUndefined(el.dataset['WwElement'])); AssertTrue('Have removed element top data',isUndefined(el.dataset['WwElementTop'])); AssertTrue('Have removed element content data',isUndefined(el.dataset['WwElementContent'])); end; procedure TTestWidgetBasicOperations.TestSubContent; begin SetupParentElement; MySubWidget.Parent:=MyParentWidget; MySubWidget.Refresh; AssertTree('div('+SMyParentID+')/div('+MySubWidget.ElementID+')/div('+MySubWidget.ElementID+'-sub)'); AssertNotNull('have content',MySubWidget.MyContent); AssertSame('content element parent is element',MySubWidget.MyElement,MySubWidget.MyContent.parentElement); end; procedure TTestWidgetBasicOperations.TestTopContent; begin { SetupParentElement; MySubWidget.Parent:=MyParentWidget; MySubWidget.Refresh; AssertTree('div('+SMyParentID+')/span('+MySubWidget.ElementID+'-top)/div('+MySubWidget.ElementID+')/div('+MySubWidget.ElementID+'-sub)'); AssertNotNull('have content',MySubWidget.MyContent); AssertNotNull('have top content',MySubWidget.MyTop); AssertSame('top element parent is element',MyParentWidget.MyContent,MySubWidget.MyTop.parentElement); AssertSame('element parent is top element',MySubWidget.MyTop,MySubWidget.MyElement.parentElement); AssertSame('content element parent is element',MySubWidget.MyElement,MySubWidget.MyContent.parentElement);} end; procedure TTestWidgetBasicOperations.TestAddClasses; Var S : String; begin S:=TWebWidget.AddClasses('a b c','d c e'); AssertEquals('Correctly added, no duplicates','a b c d e',S); end; procedure TTestWidgetBasicOperations.TestAddClassesNormalized; Var S : String; begin S:=TWebWidget.AddClasses('a b c','d c e',true); AssertEquals('Correctly added, no duplicates','a b c d e',S); end; procedure TTestWidgetBasicOperations.TestRemoveClasses; Var S : String; begin S:=TWebWidget.RemoveClasses('a b c','d c e'); AssertEquals('Correctly removed','a b ',S); end; procedure TTestWidgetBasicOperations.TestRemoveClassesNormalized; Var S : String; begin S:=TWebWidget.RemoveClasses('a b c','d c e',True); AssertEquals('Correctly removed','a b',S); end; procedure TTestWidgetBasicOperations.TestClassesBeforeRender; begin SetupParent; MyWidget.Parent:=MyParentWidget; MyWidget.Classes:='a b c'; MyWidget.Refresh; AssertNotNull('Have element',MyWidget.Element); AssertEquals('Have element classes ','a b c',MyWidget.Element.className); end; procedure TTestWidgetBasicOperations.TestClassesAfterRender; begin SetupParent; MyWidget.Parent:=MyParentWidget; MyWidget.Refresh; AssertNotNull('Have element',MyWidget.Element); MyWidget.Classes:='a b c'; AssertEquals('Have element classes ','a b c',MyWidget.Element.className); end; procedure TTestWidgetBasicOperations.TestWidgetClassesBeforeRender; begin SetupParent; MyWidget.Parent:=MyParentWidget; MyWidget.AddedClasses:='d e c'; MyWidget.Refresh; AssertNotNull('Have element',MyWidget.Element); MyWidget.Classes:='a b c'; AssertEquals('Have element classes ','a b c d e',MyWidget.Element.className); end; procedure TTestWidgetBasicOperations.TestWidgetClassesAfterRender; begin SetupParent; MyWidget.Parent:=MyParentWidget; MyWidget.Refresh; AssertNotNull('Have element',MyWidget.Element); MyWidget.AddedClasses:='d e c'; // They are not yet added AssertEquals('Have element classes before setting','',MyWidget.Element.className); // but now they are added MyWidget.Classes:='a b c'; AssertEquals('Have element classes ','a b c d e',MyWidget.Element.className); end; procedure TTestWidgetBasicOperations.TestClassesOnElementID; var el : TJSHTMLElement; begin el:=CreateMyElement(); MyWidget.Classes:='a b c'; MyWidget.ElementID:=SMyChildID; AssertNotNull('Have element',MyWidget.MyElement); AssertSame('Have element',El,MyWidget.MyElement); AssertEquals('Have element classes ','a b c',MyWidget.Element.className); end; procedure TTestWidgetBasicOperations.TestStylesBeforeRender; begin MyWidget.ParentID:=BaseID; MyWidget.Styles.Add('display').Value:='none'; MyWidget.Refresh; AssertTree('div('+MyWidget.ElementID+')'); AssertEquals('have style applied','none',MyWidget.MyElement.style.getPropertyValue('display')); end; procedure TTestWidgetBasicOperations.TestStylesAfterRender; begin MyWidget.ParentID:=BaseID; MyWidget.Refresh; MyWidget.Styles.Add('display').Value:='none'; AssertTree('div('+MyWidget.ElementID+')'); AssertEquals('have style applied','none',MyWidget.MyElement.style.getPropertyValue('display')); end; procedure TTestWidgetBasicOperations.TestStylesRefreshOnRender; var Idx : Integer; begin CreateMyElement(False).Style.setProperty('width','30px'); AssertTree('div('+MyWidget.ElementID+')'); MyWidget.ElementID:=SMyChildID; AssertTree('div('+MyWidget.ElementID+')'); MyWidget.Refresh; MyWidget.Styles.Add('display').Value:='none'; AssertEquals('have style applied','none',MyWidget.MyElement.style.getPropertyValue('display')); AssertEquals('have pre-existing imported: count',2,MyWidget.Styles.Count); Idx:=MyWidget.Styles.IndexOfStyle('width'); AssertTrue('have pre-existing imported: find name',Idx<>-1); AssertEquals('have pre-existing imported: have value','30px',MyWidget.Styles[idx].Value); AssertEquals('have pre-existing imported: marked as imported',True,MyWidget.Styles[idx].IMported); end; procedure TTestWidgetBasicOperations.TestVisibleBeforeRender; begin MyWidget.Visible:=False; SetupElement; AssertFalse('Visible false',MyWidget.Visible); AssertEquals('Display none','none',MyWidget.MyElement.Style.getPropertyValue('display')); end; procedure TTestWidgetBasicOperations.TestVisibleAfterRender; begin SetupElement; MyWidget.Refresh; MyWidget.Visible:=False; AssertFalse('Visible false',MyWidget.Visible); AssertEquals('Display none','none',MyWidget.MyElement.Style.getPropertyValue('display')); end; procedure TTestWidgetBasicOperations.TestVisibleBeforeRenderPreserves; begin MyWidget.Visible:=False; SetupElement.style.setProperty('display','inline'); MyWidget.Refresh; AssertFalse('Visible false',MyWidget.Visible); AssertEquals('Display none','none',MyWidget.MyElement.Style.getPropertyValue('display')); MyWidget.Visible:=True; AssertTrue('Visible true',MyWidget.Visible); AssertEquals('Display none','inline',MyWidget.MyElement.Style.getPropertyValue('display')); end; procedure TTestWidgetBasicOperations.TestVisibleAfterRenderPreserves; begin SetupElement.style.setProperty('display','inline'); MyWidget.Refresh; MyWidget.Visible:=False; AssertFalse('Visible false',MyWidget.Visible); AssertEquals('Display none','none',MyWidget.MyElement.Style.getPropertyValue('display')); MyWidget.Visible:=True; AssertTrue('Visible true',MyWidget.Visible); AssertEquals('Display none','inline',MyWidget.MyElement.Style.getPropertyValue('display')); end; procedure TTestWidgetBasicOperations.TestGetData; begin SetupElement.Dataset['name']:='me'; AssertEquals('Correctly read','me',MyWidget.Data['name']); end; procedure TTestWidgetBasicOperations.TestSetData; var el : TJSHTMLElement; begin El:=SetupElement; MyWidget.Data['name']:='me'; AssertEquals('Correctly set','me',String(el.Dataset['name'])); end; procedure TTestWidgetBasicOperations.TestGetDataNotRendered; begin AssertEquals('Correctly read','',MyWidget.Data['name']); end; procedure TTestWidgetBasicOperations.TestSetDataNotRendered; begin AssertException('Cannot write',EWidgets,@DoSetDataset); end; function TTestWidgetBasicOperations.SetupElement: TJSHTMLElement; begin Result:=CreateMyElement(False); MyWidget.ElementID:=SMyChildID; end; procedure TTestWidgetBasicOperations.SetupParentElement; begin CreateParentElement; MyParentWidget.ElementID:=SMyParentID; end; procedure TTestWidgetBasicOperations.TestEvent(aName : String); begin TriggerEvent(aName); AssertEvent(aName,Fmy); end; procedure TTestWidgetBasicOperations.TestEventClick; begin SetupElement; MyWidget.OnClick:=@MyTestEventHandler; TestEvent('click'); end; { --------------------------------------------------------------------- TBaseTestWidget ---------------------------------------------------------------------} procedure TBaseTestWidget.SetUp; begin inherited SetUp; FBaseWindow:=GetElement(BaseID); end; procedure TBaseTestWidget.TearDown; begin if Assigned(FBaseWindow) then FBaseWindow.InnerHTML:=''; FBaseWindow:=Nil; inherited TearDown; end; procedure TBaseTestWidget.AssertEvent(aName: String; aElement : TCustomWebWidget = Nil); begin AssertEquals('Event handler called',1,FEventCount); AssertSame('Event handler sender',aElement,FEventSender); AssertEquals('Event name',aName,FEventName); end; procedure TBaseTestWidget.MyTestEventHandler(Sender: TObject; Event: TJSEvent); begin Inc(FEventCount); FEventSender:=Sender; FEventName:=Event._type; end; function TBaseTestWidget.FindElement(aID: String): TJSHTMLElement; begin Result:=TJSHTMLElement(Document.GetElementById(aID)); end; function TBaseTestWidget.GetElement(aID: String): TJSHTMLElement; begin Result:=FindElement(aID); if Result=Nil then Fail('No such element : '+aID); end; Function TBaseTestWidget.AssertTree(aParent: TJSHTmlElement; aTree: String) : TJSHTMLElement; Var S,aTag,aID : String; P : integer; T : TJSHTMLElement; begin P:=Pos('/',aTree); if P=0 then P:=Length(aTree)+1; aTag:=Copy(aTree,1,P-1); aTree:=Copy(aTree,P+1,Length(aTree)-P); P:=Pos('(',aTag); if P=0 then P:=Length(aTag)+1; aID:=Copy(aTag,P+1,Length(aTag)-P); aTag:=Copy(aTag,1,P-1); P:=Pos(')',aID); if P>0 then aID:=Copy(aID,1,P-1); // Writeln('Look for <',aTag,'>(',aID,')'); T:=TJSHTMLElement(aParent.firstElementChild); While (T<>Nil) and Not (SameText(T.tagName,aTag) and ((aID='') or SameText(T.ID,aID))) do T:=TJSHTMLElement(T.nextElementSibling); if (T=Nil) then begin S:='Could not find <'+aTag+'>'; if (aID<>'') then S:=S+'(ID='+aID+')'; S:=S+'below element '+aParent.TagName; if (aParent.ID<>'') then S:=S+'(ID='+aParent.ID+')'; Fail(S); end; // Writeln('Found: <',T.TagName,'>(iD=',T.ID+')'); if aTree<>'' then Result:=AssertTree(T,aTree) else Result:=T; end; Function TBaseTestWidget.AssertTree(aTree: String) : TJSHTMLElement; begin Result:=AssertTree(BaseWindow,aTree) end; { --------------------------------------------------------------------- TTestWidgetBasicOperations ---------------------------------------------------------------------} procedure TTestWidgetBasicOperations.TestEventOnAbort; begin SetupElement; MyWidget.OnAbort:=@MyTestEventHandler; TestEvent('abort'); end; procedure TTestWidgetBasicOperations.TestEventOnAnimationCancel; begin SetupElement; MyWidget.OnAnimationCancel:=@MyTestEventHandler; TestEvent('animationcancel'); end; procedure TTestWidgetBasicOperations.TestEventOnAnimationEnd; begin SetupElement; MyWidget.OnAnimationEnd:=@MyTestEventHandler; TestEvent('animationend'); end; procedure TTestWidgetBasicOperations.TestEventOnAnimationIteration; begin SetupElement; MyWidget.OnAnimationIteration:=@MyTestEventHandler; TestEvent('animationiteration'); end; procedure TTestWidgetBasicOperations.TestEventOnAnimationStart; begin SetupElement; MyWidget.OnAnimationStart:=@MyTestEventHandler; TestEvent('animationstart'); end; procedure TTestWidgetBasicOperations.TestEventOnAuxClick; begin SetupElement; MyWidget.OnAuxClick:=@MyTestEventHandler; TestEvent('auxclick'); end; procedure TTestWidgetBasicOperations.TestEventOnBlur; begin SetupElement; MyWidget.OnBlur:=@MyTestEventHandler; TestEvent('blur'); end; procedure TTestWidgetBasicOperations.TestEventOnCancel; begin SetupElement; MyWidget.OnCancel:=@MyTestEventHandler; TestEvent('cancel'); end; procedure TTestWidgetBasicOperations.TestEventOnCanPlay; begin SetupElement; MyWidget.OnCanPlay:=@MyTestEventHandler; TestEvent('canplay'); end; procedure TTestWidgetBasicOperations.TestEventOnCanPlayThrough; begin SetupElement; MyWidget.OnCanPlayThrough:=@MyTestEventHandler; TestEvent('canplaythrough'); end; procedure TTestWidgetBasicOperations.TestEventOnChange; begin SetupElement; MyWidget.OnChange:=@MyTestEventHandler; TestEvent('change'); end; procedure TTestWidgetBasicOperations.TestEventOnClick; begin SetupElement; MyWidget.OnClick:=@MyTestEventHandler; TestEvent('click'); end; procedure TTestWidgetBasicOperations.TestEventOnCompositionEnd; begin SetupElement; MyWidget.OnCompositionEnd:=@MyTestEventHandler; TestEvent('compositionend'); end; procedure TTestWidgetBasicOperations.TestEventOnCompositionStart; begin SetupElement; MyWidget.OnCompositionStart:=@MyTestEventHandler; TestEvent('compositionstart'); end; procedure TTestWidgetBasicOperations.TestEventOnCompositionUpdate; begin SetupElement; MyWidget.OnCompositionUpdate:=@MyTestEventHandler; TestEvent('compositionupdate'); end; procedure TTestWidgetBasicOperations.TestEventOnContextMenu; begin SetupElement; MyWidget.OnContextMenu:=@MyTestEventHandler; TestEvent('contextmenu'); end; procedure TTestWidgetBasicOperations.TestEventOnCopy; begin SetupElement; MyWidget.OnCopy:=@MyTestEventHandler; TestEvent('copy'); end; procedure TTestWidgetBasicOperations.TestEventOnCut; begin SetupElement; MyWidget.OnCut:=@MyTestEventHandler; TestEvent('cut'); end; procedure TTestWidgetBasicOperations.TestEventOnCueChange; begin SetupElement; MyWidget.OnCueChange:=@MyTestEventHandler; TestEvent('cuechange'); end; procedure TTestWidgetBasicOperations.TestEventOnDblClick; begin SetupElement; MyWidget.OnDblClick:=@MyTestEventHandler; TestEvent('dblclick'); end; procedure TTestWidgetBasicOperations.TestEventOnDurationChange; begin SetupElement; MyWidget.OnDurationChange:=@MyTestEventHandler; TestEvent('durationchange'); end; procedure TTestWidgetBasicOperations.TestEventOnEnded; begin SetupElement; MyWidget.OnEnded :=@MyTestEventHandler; TestEvent('ended'); end; procedure TTestWidgetBasicOperations.TestEventOnError; begin SetupElement; MyWidget.OnError :=@MyTestEventHandler; TestEvent('error'); end; procedure TTestWidgetBasicOperations.TestEventOnFocus; begin SetupElement; MyWidget.OnFocus:=@MyTestEventHandler; TestEvent('focus'); end; procedure TTestWidgetBasicOperations.TestEventOnFocusIn; begin SetupElement; MyWidget.OnFocusIn :=@MyTestEventHandler; TestEvent('focusin'); end; procedure TTestWidgetBasicOperations.TestEventOnFocusOut; begin SetupElement; MyWidget.OnFocusOut :=@MyTestEventHandler; TestEvent('focusout'); end; procedure TTestWidgetBasicOperations.TestEventOnGotPointerCapture; begin SetupElement; MyWidget.OnGotPointerCapture:=@MyTestEventHandler; TestEvent('gotpointercapture'); end; procedure TTestWidgetBasicOperations.TestEventOnInput; begin SetupElement; MyWidget.OnInput:=@MyTestEventHandler; TestEvent('input'); end; procedure TTestWidgetBasicOperations.TestEventOnInvalid; begin SetupElement; MyWidget.OnInvalid:=@MyTestEventHandler; TestEvent('invalid'); end; procedure TTestWidgetBasicOperations.TestEventOnKeyDown; begin SetupElement; MyWidget.OnKeyDown:=@MyTestEventHandler; TestEvent('keydown'); end; procedure TTestWidgetBasicOperations.TestEventOnKeyPress; begin SetupElement; MyWidget.OnKeyPress:=@MyTestEventHandler; TestEvent('keypress'); end; procedure TTestWidgetBasicOperations.TestEventOnKeyUp; begin SetupElement; MyWidget.OnKeyUp:=@MyTestEventHandler; TestEvent('keyup'); end; procedure TTestWidgetBasicOperations.TestEventOnLoad; begin SetupElement; MyWidget.OnLoad:=@MyTestEventHandler; TestEvent('load'); end; procedure TTestWidgetBasicOperations.TestEventOnLoadedData; begin SetupElement; MyWidget.OnLoadedData:=@MyTestEventHandler; TestEvent('loadeddata'); end; procedure TTestWidgetBasicOperations.TestEventOnLoadedMetaData; begin SetupElement; MyWidget.OnLoadedMetaData:=@MyTestEventHandler; TestEvent('loadedmetadata'); end; procedure TTestWidgetBasicOperations.TestEventOnLoadend; begin SetupElement; MyWidget.OnLoadend:=@MyTestEventHandler; TestEvent('loadend'); end; procedure TTestWidgetBasicOperations.TestEventOnLoadStart; begin SetupElement; MyWidget.OnLoadStart:=@MyTestEventHandler; TestEvent('loadstart'); end; procedure TTestWidgetBasicOperations.TestEventOnLostPointerCapture; begin SetupElement; MyWidget.OnLostPointerCapture:=@MyTestEventHandler; TestEvent('lostpointercapture'); end; procedure TTestWidgetBasicOperations.TestEventOnMouseDown; begin SetupElement; MyWidget.OnMouseDown:=@MyTestEventHandler; TestEvent('mousedown'); end; procedure TTestWidgetBasicOperations.TestEventOnMouseEnter; begin SetupElement; MyWidget.OnMouseEnter:=@MyTestEventHandler; TestEvent('mouseenter'); end; procedure TTestWidgetBasicOperations.TestEventOnMouseLeave; begin SetupElement; MyWidget.OnMouseLeave:=@MyTestEventHandler; TestEvent('mouseleave'); end; procedure TTestWidgetBasicOperations.TestEventOnMouseMove; begin SetupElement; MyWidget.OnMouseMove:=@MyTestEventHandler; TestEvent('mousemove'); end; procedure TTestWidgetBasicOperations.TestEventOnMouseOut; begin SetupElement; MyWidget.OnMouseOut:=@MyTestEventHandler; TestEvent('mouseout'); end; procedure TTestWidgetBasicOperations.TestEventOnMouseUp; begin SetupElement; MyWidget.OnMouseUp:=@MyTestEventHandler; TestEvent('mouseup'); end; procedure TTestWidgetBasicOperations.TestEventOnOverFlow; begin SetupElement; MyWidget.OnOverFlow:=@MyTestEventHandler; TestEvent('overflow'); end; procedure TTestWidgetBasicOperations.TestEventOnPaste; begin SetupElement; MyWidget.OnPaste:=@MyTestEventHandler; TestEvent('paste'); end; procedure TTestWidgetBasicOperations.TestEventOnPause; begin SetupElement; MyWidget.OnPause:=@MyTestEventHandler; TestEvent('pause'); end; procedure TTestWidgetBasicOperations.TestEventOnPlay; begin SetupElement; MyWidget.OnPlay:=@MyTestEventHandler; TestEvent('play'); end; procedure TTestWidgetBasicOperations.TestEventOnPointerCancel; begin SetupElement; MyWidget.OnPointerCancel:=@MyTestEventHandler; TestEvent('pointercancel'); end; procedure TTestWidgetBasicOperations.TestEventOnPointerDown; begin SetupElement; MyWidget.OnPointerDown:=@MyTestEventHandler; TestEvent('pointerdown'); end; procedure TTestWidgetBasicOperations.TestEventOnPointerEnter; begin SetupElement; MyWidget.OnPointerEnter:=@MyTestEventHandler; TestEvent('pointerenter'); end; procedure TTestWidgetBasicOperations.TestEventOnPointerLeave; begin SetupElement; MyWidget.OnPointerLeave:=@MyTestEventHandler; TestEvent('pointerleave'); end; procedure TTestWidgetBasicOperations.TestEventOnPointerMove; begin SetupElement; MyWidget.OnPointerMove:=@MyTestEventHandler; TestEvent('pointermove'); end; procedure TTestWidgetBasicOperations.TestEventOnPointerOut; begin SetupElement; MyWidget.OnPointerOut:=@MyTestEventHandler; TestEvent('pointerout'); end; procedure TTestWidgetBasicOperations.TestEventOnPointerOver; begin SetupElement; MyWidget.OnPointerOver:=@MyTestEventHandler; TestEvent('pointerover'); end; procedure TTestWidgetBasicOperations.TestEventOnPointerUp; begin SetupElement; MyWidget.OnPointerUp:=@MyTestEventHandler; TestEvent('pointerup'); end; procedure TTestWidgetBasicOperations.TestEventOnReset; begin SetupElement; MyWidget.OnReset:=@MyTestEventHandler; TestEvent('reset'); end; procedure TTestWidgetBasicOperations.TestEventOnResize; begin SetupElement; MyWidget.OnResize:=@MyTestEventHandler; TestEvent('resize'); end; procedure TTestWidgetBasicOperations.TestEventOnScroll; begin SetupElement; MyWidget.OnScroll:=@MyTestEventHandler; TestEvent('scroll'); end; procedure TTestWidgetBasicOperations.TestEventOnSelect; begin SetupElement; MyWidget.OnSelect:=@MyTestEventHandler; TestEvent('select'); end; procedure TTestWidgetBasicOperations.TestEventOnSubmit; begin SetupElement; MyWidget.OnSubmit:=@MyTestEventHandler; TestEvent('submit'); end; procedure TTestWidgetBasicOperations.TestEventOnTouchStart; begin SetupElement; MyWidget.OnTouchStart:=@MyTestEventHandler; TestEvent('touchstart'); end; procedure TTestWidgetBasicOperations.TestEventOnTransitionCancel; begin SetupElement; MyWidget.OnTransitionCancel:=@MyTestEventHandler; TestEvent('transitioncancel'); end; procedure TTestWidgetBasicOperations.TestEventOnTransitionEnd; begin SetupElement; MyWidget.OnTransitionEnd:=@MyTestEventHandler; TestEvent('transitionend'); end; procedure TTestWidgetBasicOperations.TestEventOnTransitionRun; begin SetupElement; MyWidget.OnTransitionRun:=@MyTestEventHandler; TestEvent('transitionrun'); end; procedure TTestWidgetBasicOperations.TestEventOnTransitionStart; begin SetupElement; MyWidget.OnTransitionStart:=@MyTestEventHandler; TestEvent('transitionstart'); end; procedure TTestWidgetBasicOperations.TestEventOnWheel; begin SetupElement; MyWidget.OnWheel:=@MyTestEventHandler; TestEvent('wheel'); end; initialization RegisterTests([TTestWidgetBasicOperations,TTestWebWidgetStyles,TTestWebWidgetReferences,TTestSimpleLoopWidget]); end.