* Additional widgets and tests

This commit is contained in:
michael 2019-08-11 13:12:42 +00:00
parent 6bc0de13f9
commit 0e4c76c91f
4 changed files with 820 additions and 51 deletions

View File

@ -8,20 +8,26 @@ uses
Classes, SysUtils, webwidget, js, web;
Type
TTextMode = (tmText,tmHTML);
{ TButtonWidget }
TButtonWidget = Class(TWebWidget)
private
FText: String;
FTextMode: TTextMode;
procedure SetText(AValue: String);
procedure SetTextMode(AValue: TTextMode);
Protected
procedure ApplyText(aElement: TJSHTMLElement);
Procedure SetName(const NewName: TComponentName); override;
Procedure ApplyWidgetSettings(aElement: TJSHTMLElement); override;
Public
Procedure Click;
Function HTMLTag : String; override;
Published
Property Text : String Read FText Write SetText;
Property TextMode : TTextMode Read FTextMode Write SetTextMode;
end;
{ TViewPort }
@ -473,9 +479,73 @@ Type
Property LabelFor : TWebWidget Read FLabelFor Write SetLabelFor;
end;
TTextTag = (ttParagraph,ttBold,ttItalic,ttUnderline,ttStrikeThrough,ttSpan,ttQuote,ttBlockQuote,ttH1,ttH2,ttH3,ttH4,ttH5,ttH6,ttPre,ttRuby,ttArticle,ttAddress,ttAbbr,ttCustom);
{ TTextWidget }
{ TCustomTextWidget }
TCustomTextWidget = Class(TCustomWebWidget)
private
FCustomTag: String;
FEnvelopeTag: TTextTag;
FTextMode: TTextMode;
SerCustomTag: String;
procedure SetCustomTag(AValue: String);
procedure SetEnvelopeTag(AValue: TTextTag);
procedure SetTextMode(AValue: TTextMode);
Protected
procedure ApplyWidgetSettings(aElement: TJSHTMLElement); override;
procedure ApplyText(aElement : TJSHTMLElement); virtual;
Function GetText : String; virtual; abstract;
Public
Function HTMLTag : String; override;
Published
Property CustomTag : String Read FCustomTag Write SetCustomTag;
Property EnvelopeTag : TTextTag Read FEnvelopeTag Write SetEnvelopeTag;
Property TextMode : TTextMode Read FTextMode Write SetTextMode;
end;
TTextWidget = Class(TCustomTextWidget)
private
FText : String;
procedure SetText(AValue: String);
Protected
Function GetText : String; override;
published
Property Text : String Read FText Write SetText;
end;
{ TTextLinesWidget }
TTextLinesWidget = Class(TCustomTextWidget)
private
FLines : TStrings;
FForceLineBreaks: Boolean;
procedure DoLinesChanged(Sender: TObject);
procedure SetLines(AValue: TStrings);
procedure SetForceLineBreaks(AValue: Boolean);
Protected
Function GetText : String; override;
procedure ApplyText(aElement : TJSHTMLElement); override;
Public
Constructor Create(aOwner : TComponent); override;
Destructor Destroy; override;
published
Property Lines : TStrings Read FLines Write SetLines;
// When forcelinebreaks is true a <br> will be appended to every line.
// Note that for TextMode=tmText this means the lines will be rendered as-is, but there will still be a <br> between the lines
Property ForceLineBreaks : Boolean Read FForceLineBreaks Write SetForceLineBreaks;
end;
Function ViewPort : TViewPort;
Const
TextTagNames : Array[TTextTag] of string
= ('p','b','i','u','s','span','quote','blockquote','h1','h2','h3','h4','h5','h6','pre','ruby','article','address','abbr','');
implementation
uses DateUtils;
@ -489,6 +559,145 @@ begin
Result:=TViewPort.Instance;
end;
{ TCustomTextWidget }
procedure TCustomTextWidget.SetEnvelopeTag(AValue: TTextTag);
begin
if FEnvelopeTag=AValue then Exit;
FEnvelopeTag:=AValue;
if (FEnvelopeTag=ttCustom) and (FCustomTag='') then
FCustomTag:='div';
if IsRendered then
Refresh;
end;
procedure TCustomTextWidget.SetCustomTag(AValue: String);
begin
if FCustomTag=AValue then Exit;
FCustomTag:=AValue;
if (FCustomTag<>'') then
FEnvelopeTag:=ttCustom;
if IsRendered then
Refresh;
end;
procedure TCustomTextWidget.SetTextMode(AValue: TTextMode);
begin
if FTextMode=AValue then Exit;
FTextMode:=AValue;
if IsRendered then
ApplyText(Element);
end;
procedure TCustomTextWidget.ApplyWidgetSettings(aElement: TJSHTMLElement);
begin
inherited ApplyWidgetSettings(aElement);
ApplyText(aElement);
end;
procedure TCustomTextWidget.ApplyText(aElement: TJSHTMLElement);
begin
if FTextMode=tmText then
aElement.innerText:=GetText
else
aElement.innerHTML:=GetText;
end;
function TCustomTextWidget.HTMLTag: String;
begin
Result:=TextTagNames[FEnvelopeTag];
if Result='' then
Result:='div';
end;
{ TTextLinesWidget }
procedure TTextLinesWidget.SetLines(AValue: TStrings);
begin
if FLines=AValue then Exit;
FLines.Assign(AValue);
end;
procedure TTextLinesWidget.SetForceLineBreaks(AValue: Boolean);
begin
if FForceLineBreaks=AValue then Exit;
FForceLineBreaks:=AValue;
if IsRendered then
ApplyText(Element);
end;
procedure TTextLinesWidget.DoLinesChanged(Sender: TObject);
begin
if IsRendered then
ApplyText(Element);
end;
function TTextLinesWidget.GetText: String;
Var
I : integer;
begin
if (FTextMode=tmHTML) and ForceLineBreaks then
begin
Result:='';
For I:=0 to FLines.Count-1 do
Result:=Result+flines[i]+'<br/>';
end
else
Result:=FLines.Text;
end;
procedure TTextLinesWidget.ApplyText(aElement: TJSHTMLElement);
Var
I : integer;
begin
if (TextMode=tmHTML) or (Not ForceLineBreaks) then
inherited ApplyText(aElement)
else
begin
For I:=0 to FLines.Count-1 do
begin
aElement.AppendChild(Document.createTextNode(FLines[i]));
aElement.AppendChild(CreateElement('br',''));
end;
end;
end;
constructor TTextLinesWidget.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
FLines:=TstringList.Create;
TstringList(FLines).OnChange:=@DoLinesChanged;
end;
destructor TTextLinesWidget.Destroy;
begin
FLines:=TstringList.Create;
inherited Destroy;
end;
{ TTextWidget }
procedure TTextWidget.SetText(AValue: String);
begin
if FText=AValue then Exit;
FText:=AValue;
if IsRendered then
ApplyText(Element);
end;
function TTextWidget.GetText: String;
begin
Result:=FText;
end;
{ TLabelWidget }
procedure TLabelWidget.ApplyLabelFor(aLabelElement : TJSHTMLLabelElement);
@ -1399,7 +1608,15 @@ begin
if FText=AValue then Exit;
FText:=AValue;
if IsRendered then
Element.InnerText:=Ftext;
ApplyText(Element);
end;
procedure TButtonWidget.SetTextMode(AValue: TTextMode);
begin
if FTextMode=AValue then Exit;
FTextMode:=AValue;
if IsRendered then
ApplyText(Element)
end;
@ -1423,7 +1640,16 @@ end;
procedure TButtonWidget.ApplyWidgetSettings(aElement: TJSHTMLElement);
begin
Inherited;
aElement.InnerText:=Text;
ApplyText(aElement);
end;
Procedure TButtonWidget.ApplyText(aElement : TJSHTMLElement);
begin
if FTextMode=tmText then
aElement.InnerText:=FText
else
aElement.InnerHTML:=FText;
end;
procedure TButtonWidget.Click;

View File

@ -289,9 +289,237 @@ Type
Procedure TestMultiSelect;
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;
implementation
{ TTestTextLinesWidget }
procedure TTestTextLinesWidget.Setup;
begin
inherited Setup;
FMy:=TMyTextLinesWidget.Create(Nil);
FMy.ParentID:=SBaseWindowID;
FMy.Lines.Add('0&lt;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&lt;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&lt;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&lt;1'+slineBreak+'two'+slineBreak,My.Element.InnerText);
AssertEquals('Have HTML','0&amp;lt;1<br>two<br>',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&lt;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&lt;1<br>two<br>',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&lt;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&lt;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&lt;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&lt;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&lt;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&lt;1',My.Element.InnerHtml);
end;
procedure TTestTextWidget.TestRenderedHTMLChange;
begin
TestRenderHtml;
My.Text:='2&gt;1';
AssertEquals('Have text','2>1',My.Element.InnerText);
AssertEquals('Have HTML','2&gt;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&lt;1',My.Element.InnerHtml);
end;
procedure TTestTextWidget.TestEnvelopeChangeRenders;
begin
TestRenderText;
My.EnvelopeTag:=ttSpan;
AssertEquals('Have element','SPAN',My.Element.tagName);
AssertEquals('Have text','0&lt;1',My.Element.InnerText);
AssertEquals('Have HTML','0&amp;lt;1',My.Element.InnerHtml);
end;
{ TTestLabelWidget }
procedure TTestLabelWidget.SetUp;
@ -457,7 +685,6 @@ begin
AssertEquals('SelectionItem[0]','One',My.SelectionItem[0]);
AssertEquals('SelectionValue[1]','3',My.selectionValue[1]);
AssertEquals('SelectionItem[1]','Three',My.selectionItem[1]);
end;
{ TTestImageElement }
@ -1144,12 +1371,12 @@ begin
end;
initialization
RegisterTests([TTestViewPort,TTestButtonWidget,TTestPage,
RegisterTests([{TTestViewPort,TTestButtonWidget,TTestPage,
TTestTextInputElement,TTestTextAreaElement,
TTestRadioInputElement,TTestCheckBoxInputElement,
TTestDateInputElement,TTestFileInputElement,
TTestHiddenInputElement, TTestImageElement,
TTestImageElement,TTestSelectElement,
TTestLabelWidget]);
TTestLabelWidget,TTestTextWidget,}TTestTextLinesWidget]);
end.

View File

@ -33,7 +33,15 @@ Type
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 }
@ -69,6 +77,7 @@ Type
Property References;
Property Subs : TJSHTMLElementArray read FSubs;
Property UL : TJSHTMLElement read FUL;
Property Element;
end;
@ -277,18 +286,42 @@ Type
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;
implementation
{ TMyChildWidget }
class function TMySimpleChildWidget.AllowChildren: Boolean;
begin
Result:=FAlse;
end;
{ TMyRefWidget }
function TMyRefWidget.DoRenderHTML(aParent, aElement: TJSHTMLElement): TJSHTMLElement;
@ -310,15 +343,14 @@ Var
I : Integer;
begin
Result:=inherited DoRenderHTML(aParent, aElement);
FUL:=TJSHTMLElement(Document.CreateElement('<ul>'));
FUL:=TJSHTMLElement(Document.CreateElement('ul'));
Result.insertBefore(Ful,FSub);
Result.AppendChild(FUL);
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);
FUL.AppendChild(FSubs[i]);
end;
end;
@ -332,16 +364,189 @@ 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;
AssertEquals('Count',3,references.Count);
AssertEquals('0 : Name','a',references[0].name);
AssertEquals('0 : Selector','div',references[0].Selector);
AssertEquals('1 : Name','b',references[1].name);
AssertEquals('1 : Selector','ul',references[1].selector);
AssertEquals('2 : Name','c',references[2].name);
AssertEquals('2 : Selector','ul>li',references[2].selector);
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[0],References.FindReference('A'));
AssertSame('a',References[0],References.FindReference('a'));
AssertNull('e',References.FindReference('E'));
end;
procedure TTestWebWidgetReferences.TestGet;
begin
AddSet;
AssertSame('A',References[0],References.GetReference('A'));
AssertSame('a',References[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[0].Elements));
AssertSame('first array Reference filled',MyWidget.UL,References[0].Elements[0]);
AssertSame('Reference filled',MyWidget.UL,References[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[0].Elements));
AssertSame('first array Reference filled',MyWidget.UL,References[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[0].Elements));
AssertSame('first array Reference filled',MyWidget.UL,References[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[0].Elements));
for I:=0 to Length(MyWidget.FSubs)-1 do
AssertSame('1 array Reference filled',MyWidget.Subs[I],References[0].Elements[i]);
AssertSame('first Reference filled',MyWidget.Subs[0],References[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[0].Elements));
AssertSame('first array Reference filled',MyWidget.UL,References[0].Elements[0]);
AssertSame('Reference filled',MyWidget.UL,References[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[0].Elements));
for I:=0 to Length(MyWidget.FSubs)-1 do
AssertSame('1 array Reference filled',MyWidget.Subs[I],References[0].Elements[i]);
AssertSame('first Reference filled',MyWidget.Subs[0],References[0].Element);
end;
{ TTestWebWidgetStyles }
@ -755,9 +960,9 @@ begin
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']));
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;
@ -795,9 +1000,9 @@ begin
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']));
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;
@ -815,9 +1020,9 @@ begin
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']));
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;
@ -1755,6 +1960,6 @@ begin
end;
initialization
RegisterTests([TTestWidgetBasicOperations,TTestWebWidgetStyles]);
// RegisterTests([TTestWidgetBasicOperations,TTestWebWidgetStyles,TTestWebWidgetReferences]);
end.

View File

@ -81,7 +81,6 @@ Const
SEventTransitionRun = 'transitionrun';
SEventTransitionStart = 'transitionstart';
SEventWheel = 'wheel';
SErrNotRendered = 'Cannot perform this operation: Widget not rendered';
Type
@ -186,8 +185,8 @@ Type
Function Widget : TCustomWebWidget;
// Manipulate
Function Add(Const aName : String; aSelector : String = '') : TReferenceItem; overload;
Function EnsureReference(Const aName : String) : TReferenceItem;
Function IndexOfReference(Const aName : String) : TReferenceItem;
Function EnsureReference(Const aName : String; Const aSelector : String = '') : TReferenceItem;
Function IndexOfReference(Const aName : String) : Integer;
Function FindReference(Const aName : String) : TReferenceItem;
Function GetReference(Const aName : String) : TReferenceItem;
Procedure RemoveReference(Const aName : String);
@ -353,9 +352,9 @@ Type
Function DisplayElementName : String;
// Make sure there is an element.
function EnsureElement: TJSHTMLElement;
// Set parent element to nil.
// Set parent element to nil. No rendering is done. Can be called when there are no DOM elements
Procedure InvalidateParentElement;
// Set element to nil, clears styles
// Set element to nil, clears styles and references. Can be called when there are no DOM elements
Procedure InvalidateElement;
// Name of the tag to create. Set to '' if you don't want RenderHTML to create one.
Function HTMLTag : String; virtual; abstract;
@ -382,11 +381,14 @@ Type
// Apply data to Element, Top and Content. Can only be called when the 3 are set, i.e. after RenderHTML or when Element is set from ElementID.
Procedure ApplyData; virtual;
Procedure RemoveData; virtual;
// Update references
Procedure RefreshReferences; virtual;
// Create html. Creates element below parent, and renders HTML using doRenderHTML
Function RenderHTML(aParent : TJSHTMLELement) : TJSHTMLElement;
// Override this if you need to do additional actions besides removing top element from parent. Parent is always assigned
Procedure DoUnRender(aParent : TJSHTMLElement) ; virtual;
// Remove HTML, if any. aParent can be nil.
Procedure UnRender(aParent : TJSHTMLElement);
Procedure UnRender(aParent : TJSHTMLElement); overload;
// Dispatch an event
Function DispatchEvent(aName : String; aEvent : TJSEvent = Nil) : Boolean;
// the rendered or attached element if ElementID was set. Can be Nil;
@ -426,6 +428,8 @@ Type
Procedure RemoveData(const aName : String);
// Re-render
Procedure Refresh;
// Unrender
Procedure Unrender; overload;
// These work on the classes property, and on the current element if rendered. Returns the new value of classes.
Function RemoveClasses(const aClasses : String; Normalize : Boolean = false) : String;
Function AddClasses(const aClasses : String; Normalize : Boolean = false) : String;
@ -674,18 +678,22 @@ ResourceString
SErrElementIDNotAllowed = 'Setting element ID is not allowed';
SErrParentIDNotAllowed = 'Setting parent ID is not allowed';
SErrParentNotAllowed = 'Setting parent is not allowed';
SErrChildrenNotAllowed = 'Parent does not allow children';
SErrWidgetNotFound = 'Widget with ID "%s" not found.';
SErrUnknownReference = 'Unknown reference: %s';
SErrNotRendered = 'Cannot perform this operation: Widget not rendered';
SErrCannotRefreshNoWidget = 'Cannot refresh references without widget';
{ TWebWidgetReferences }
function TWebWidgetReferences.GetReferenceItem(aIndex : Integer): TReferenceItem;
begin
Result:=TReferenceItem(Items[aIndex])
end;
procedure TWebWidgetReferences.SetReferenceItem(aIndex : Integer; AValue: TReferenceItem);
begin
Items[aIndex]:=aValue;
end;
procedure TWebWidgetReferences.MarkDirty(aItem: TReferenceItem);
@ -695,8 +703,28 @@ begin
end;
procedure TWebWidgetReferences.RefreshFromDOM(aItem: TReferenceItem; aElement: TJSHTMlElement);
begin
Var
a : TJSHTMlElementArray;
Nodes : TJSNodeList;
I : integer;
begin
if (Widget=Nil) then
Raise EWidgets.Create(SErrCannotRefreshNoWidget);
if (Widget.Element=Nil) then
Raise EWidgets.Create(SErrNotRendered);
if FRefs=Nil then
FRefs:=New([]);
try
Nodes:=Widget.Element.querySelectorAll(aItem.Selector);
SetLength(a,Nodes.length);
For I:=0 to Nodes.length-1 do
A[i]:=TJSHTMLElement(Nodes[i]);
except
SetLength(a,0);
end;
FRefs[LowerCase(aItem.Name)]:=A;
end;
function TWebWidgetReferences.Widget: TCustomWebWidget;
@ -713,44 +741,87 @@ begin
MarkDirty(Result)
end;
function TWebWidgetReferences.EnsureReference(const aName: String): TReferenceItem;
function TWebWidgetReferences.EnsureReference(const aName: String; const aSelector: String): TReferenceItem;
begin
Result:=FindReference(aName);
if Result=Nil then
Result:=Add(aName,aSelector);
end;
function TWebWidgetReferences.IndexOfReference(const aName: String): TReferenceItem;
function TWebWidgetReferences.IndexOfReference(const aName: String): Integer;
begin
Result:=Count-1;
While (Result>=0) and not SameText(GetReferenceItem(Result).Name,aName) do
Dec(Result);
end;
function TWebWidgetReferences.FindReference(const aName: String): TReferenceItem;
begin
Var
Idx:Integer;
begin
Idx:=IndexOfReference(aName);
if Idx=-1 then
Result:=Nil
else
Result:=GetReferenceItem(Idx)
end;
function TWebWidgetReferences.GetReference(const aName: String): TReferenceItem;
begin
Result:=FindReference(aName);
if (Result=Nil) then
Raise EWidgets.CreateFmt(SErrUnknownReference,[aName]);
end;
procedure TWebWidgetReferences.RemoveReference(const aName: String);
begin
Var
Idx:Integer;
begin
Idx:=IndexOfReference(aName);
if Idx<>-1 then
Delete(Idx);
end;
function TWebWidgetReferences.GetElementByName(const aName: String): TJSHTMLElement;
begin
Var
J : JSValue;
Arr : TJSArray absolute J;
begin
Result:=Nil;
if FRefs=Nil then
exit;
J:=FRefs[LowerCase(aName)];
if isArray(J) and (Arr.Length>0) then
Result:=TJSHTMLElement(Arr[0])
end;
function TWebWidgetReferences.GetElementsByName(const aName: String): TJSHTMLElementArray;
begin
Var
J : JSValue;
Arr : TJSArray absolute J;
begin
Result:=Nil;
if FRefs=Nil then
exit;
J:=FRefs[LowerCase(aName)];
if isArray(J) and (Arr.Length>0) then
Result:=TJSHTMLElementArray(Arr)
end;
procedure TWebWidgetReferences.RefreshFromDOM(aElement: TJSHTMlElement);
begin
Var
I : Integer;
begin
For I:=0 to Count-1 do
RefreshFromDOM(GetReferenceItem(I),aElement);
end;
{ TReferenceItem }
@ -1160,21 +1231,36 @@ begin
Result:=RenderHTML(P);
FOwnsElement:=True;
FElement:=Result;
ApplyData;
end;
ApplyData;
RefreshReferences; // After data, so data can be used in selectors
end;
end;
procedure TCustomWebWidget.InvalidateParentElement;
Var
I : Integer;
begin
FParentElement:=nil;
For I:=0 to ChildCount-1 do
Children[i].InvalidateParentElement;
end;
procedure TCustomWebWidget.InvalidateElement;
Var
I : Integer;
begin
If FStyles.Count>0 then
FStyles.ClearImported;
if Assigned(Freferences) then
FReferences.FRefs:=Nil;
FElement:=nil;
For I:=0 to ChildCount-1 do
Children[i].InvalidateElement;
end;
function TCustomWebWidget.WidgetClasses: String;
@ -1199,6 +1285,7 @@ begin
ApplyWidgetSettings(el);
FElement:=El;
ApplyData;
RefreshReferences;// After data, so data can be used in selectors
end;
end;
Result:=FElement;
@ -1407,6 +1494,9 @@ begin
if (AValue=FParent) then exit;
if (FixedParent<>Nil) then
Raise EWidgets.Create(SErrParentNotAllowed);
if Assigned(aValue) then
if Not aValue.AllowChildren then
Raise EWidgets.Create(SErrChildrenNotAllowed);
If Assigned(FParent) then
FParent.RemoveChild(Self);
// Unrender
@ -1423,7 +1513,10 @@ begin
begin
FElement:=RenderHTML(ParentElement);
if Assigned(FElement) then
begin
ApplyData;
RefreshReferences;
end;
end;
end;
@ -1638,20 +1731,28 @@ end;
procedure TCustomWebWidget.Refresh;
Var
I : integer;
begin
if IsRendered then
UnRender(ParentElement);
InvalidateParentElement;
EnsureElement;
For I:=0 to ChildCount-1 do
Children[i].Refresh;
end;
procedure TCustomWebWidget.Unrender;
Var
P : TJSHTMLElement;
begin
P:=Nil;
if Assigned(FElement) then
begin
P:=ParentElement;
if Assigned(P) and (FElementID='') then // Do not remove when it's not ours to begin with
P.removeChild(FElement);
end;
InvalidateParentElement;
InvalidateElement;
EnsureElement;
P:=ParentElement;
If Assigned(P) then
UnRender(P);
end;
procedure TCustomWebWidget.ApplyWidgetSettings(aElement: TJSHTMLElement);
@ -1725,6 +1826,15 @@ begin
MaybeUnSet(ContentElement,SContentElementData);
end;
procedure TCustomWebWidget.RefreshReferences;
begin
if Assigned(FReferences) then
if Assigned(Element) then
References.RefreshFromDom(Element)
else
References.FRefs:=Nil;
end;
class function TCustomWebWidget.GenerateID: String;
begin
@ -1767,8 +1877,8 @@ begin
if Assigned(aParent) and Assigned(FElement) then
begin
if FOwnsElement then
aParent.removeChild(FElement);
FElement:=Nil
aParent.removeChild(TopElement);
InvalidateElement;
end;
end;
@ -1777,7 +1887,8 @@ begin
if Assigned(FBeforeUnRenderHTML) then
FBeforeUnRenderHTML(Self);
RemoveData;
DoUnRender(aParent);
if assigned(AParent) then
DoUnRender(aParent);
if Assigned(FAfterUnRenderHTML) then
FAfterUnRenderHTML(Self);
end;