From 0e4c76c91ff1bb88aa8f909155bd9981fc3a241c Mon Sep 17 00:00:00 2001 From: michael Date: Sun, 11 Aug 2019 13:12:42 +0000 Subject: [PATCH] * Additional widgets and tests --- packages/webwidget/htmlwidgets.pp | 230 ++++++++++++++++++++- packages/webwidget/tests/tchtmlwidgets.pp | 233 +++++++++++++++++++++- packages/webwidget/tests/tcwidget.pp | 231 +++++++++++++++++++-- packages/webwidget/webwidget.pas | 177 +++++++++++++--- 4 files changed, 820 insertions(+), 51 deletions(-) diff --git a/packages/webwidget/htmlwidgets.pp b/packages/webwidget/htmlwidgets.pp index 7d18a41..1e76585 100644 --- a/packages/webwidget/htmlwidgets.pp +++ b/packages/webwidget/htmlwidgets.pp @@ -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
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
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]+'
'; + 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; diff --git a/packages/webwidget/tests/tchtmlwidgets.pp b/packages/webwidget/tests/tchtmlwidgets.pp index 4bf6764..cbad30a 100644 --- a/packages/webwidget/tests/tchtmlwidgets.pp +++ b/packages/webwidget/tests/tchtmlwidgets.pp @@ -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<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; @@ -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. diff --git a/packages/webwidget/tests/tcwidget.pp b/packages/webwidget/tests/tcwidget.pp index c6afd7f..e867474 100644 --- a/packages/webwidget/tests/tcwidget.pp +++ b/packages/webwidget/tests/tcwidget.pp @@ -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('