From 789705e0a330b0beef0605daea0b146de7852c81 Mon Sep 17 00:00:00 2001 From: mattias Date: Sun, 27 Mar 2011 17:55:16 +0000 Subject: [PATCH] turbopower_ipro: added example with css git-svn-id: trunk@30039 - --- .gitattributes | 4 + .../turbopower_ipro/examples/htmlwithcss.lpi | 62 ++++++ .../turbopower_ipro/examples/htmlwithcss.lpr | 14 ++ .../examples/htmlwithcssfrm.lfm | 12 ++ .../examples/htmlwithcssfrm.pas | 201 ++++++++++++++++++ 5 files changed, 293 insertions(+) create mode 100644 components/turbopower_ipro/examples/htmlwithcss.lpi create mode 100644 components/turbopower_ipro/examples/htmlwithcss.lpr create mode 100644 components/turbopower_ipro/examples/htmlwithcssfrm.lfm create mode 100644 components/turbopower_ipro/examples/htmlwithcssfrm.pas diff --git a/.gitattributes b/.gitattributes index 1a7793d576..65bcd37524 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2526,6 +2526,10 @@ components/turbopower_ipro/examples/htmfileexplorer1.lpi svneol=native#text/plai components/turbopower_ipro/examples/htmfileexplorer1.lpr svneol=native#text/plain components/turbopower_ipro/examples/htmfileexplorer2.lpi svneol=native#text/plain components/turbopower_ipro/examples/htmfileexplorer2.lpr svneol=native#text/plain +components/turbopower_ipro/examples/htmlwithcss.lpi svneol=native#text/plain +components/turbopower_ipro/examples/htmlwithcss.lpr svneol=native#text/plain +components/turbopower_ipro/examples/htmlwithcssfrm.lfm svneol=native#text/plain +components/turbopower_ipro/examples/htmlwithcssfrm.pas svneol=native#text/plain components/turbopower_ipro/examples/index.html svneol=native#text/plain components/turbopower_ipro/examples/simplepage2.html svneol=native#text/plain components/turbopower_ipro/for_delphi/ipHtml.dcr -text diff --git a/components/turbopower_ipro/examples/htmlwithcss.lpi b/components/turbopower_ipro/examples/htmlwithcss.lpi new file mode 100644 index 0000000000..4e4ee8387e --- /dev/null +++ b/components/turbopower_ipro/examples/htmlwithcss.lpi @@ -0,0 +1,62 @@ + + + + + + + + + + + + <ResourceType Value="res"/> + </General> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IgnoreBinaries Value="False"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="TurboPowerIPro"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + <MinVersion Major="1" Valid="True"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="htmlwithcss.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="htmlwithcss"/> + </Unit0> + <Unit1> + <Filename Value="htmlwithcssfrm.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="htmlwithcssfrm"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="10"/> + <Other> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/components/turbopower_ipro/examples/htmlwithcss.lpr b/components/turbopower_ipro/examples/htmlwithcss.lpr new file mode 100644 index 0000000000..3eeb4ea0b7 --- /dev/null +++ b/components/turbopower_ipro/examples/htmlwithcss.lpr @@ -0,0 +1,14 @@ +program htmlwithcss; + +{$mode objfpc}{$H+} + +uses + Interfaces, + Forms, htmlwithcssfrm; + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/components/turbopower_ipro/examples/htmlwithcssfrm.lfm b/components/turbopower_ipro/examples/htmlwithcssfrm.lfm new file mode 100644 index 0000000000..eefec9d3a6 --- /dev/null +++ b/components/turbopower_ipro/examples/htmlwithcssfrm.lfm @@ -0,0 +1,12 @@ +object Form1: TForm1 + Left = 291 + Height = 300 + Top = 167 + Width = 400 + HorzScrollBar.Page = 401 + VertScrollBar.Page = 301 + Caption = 'Form1' + OnCreate = FormCreate + LCLVersion = '0.9.31' + Visible = True +end diff --git a/components/turbopower_ipro/examples/htmlwithcssfrm.pas b/components/turbopower_ipro/examples/htmlwithcssfrm.pas new file mode 100644 index 0000000000..eb7ff600ca --- /dev/null +++ b/components/turbopower_ipro/examples/htmlwithcssfrm.pas @@ -0,0 +1,201 @@ +unit htmlwithcssfrm; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs, + IPHtml, Ipfilebroker, IpMsg; + +type + + { TMyIpHtmlDataProvider } + + TMyIpHtmlDataProvider = class(TIpHtmlDataProvider) + protected + function DoGetStream(const URL: string): TStream; override; + public + + end; + + { TForm1 } + + TForm1 = class(TForm) + function DataProvider1CanHandle(Sender: TObject; const URL: string + ): Boolean; + procedure DataProvider1CheckURL(Sender: TObject; const URL: string; + var Available: Boolean; var ContentType: string); + procedure DataProvider1GetHtml(Sender: TObject; const URL: string; + const PostData: TIpFormDataEntity; var Stream: TStream); + procedure DataProvider1GetImage(Sender: TIpHtmlNode; const URL: string; + var Picture: TPicture); + procedure DataProvider1Leave(Sender: TIpHtml); + procedure DataProvider1ReportReference(Sender: TObject; const URL: string); + procedure FormCreate(Sender: TObject); + private + procedure ShowHTML(Src: string); + public + IpHtmlPanel1: TIpHtmlPanel; + DataProvider1: TMyIpHtmlDataProvider; + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +{ TMyIpHtmlDataProvider } + +function TMyIpHtmlDataProvider.DoGetStream(const URL: string): TStream; +var + ms: TMemoryStream; +begin + Result:=nil; + debugln(['TMyIpHtmlDataProvider.DoGetStream ',URL]); + + if URL='fpdoc.css' then begin + debugln(['TMyIpHtmlDataProvider.DoGetStream ',FileExists(URL)]); + ms:=TMemoryStream.Create; + try + ms.LoadFromFile(URL); + ms.Position:=0; + except + ms.Free; + end; + Result:=ms; + end; +end; + +{ TForm1 } + +procedure TForm1.FormCreate(Sender: TObject); +begin + DataProvider1:=TMyIpHtmlDataProvider.Create(Self); + with DataProvider1 do begin + Name:='DataProvider1'; + OnCanHandle:=@DataProvider1CanHandle; + OnGetHtml:=@DataProvider1GetHtml; + OnGetImage:=@DataProvider1GetImage; + OnLeave:=@DataProvider1Leave; + OnCheckURL:=@DataProvider1CheckURL; + OnReportReference:=@DataProvider1ReportReference; + end; + IpHtmlPanel1:=TIpHtmlPanel.Create(Self); + with IpHtmlPanel1 do begin + Name:='IpHtmlPanel1'; + Parent:=Self; + Align:=alClient; + DefaultFontSize:=10; + DataProvider:=DataProvider1; + end; + + ShowHTML( + '<HTML>' + +'<head>' + +'<link rel="stylesheet" href="fpdoc.css" type="text/css">' + +'</head>' + +'<BODY>' + +'<h1>TComponent.Name</h1>' + +'<p>Name of the component.</p>' + +'<h2>Declaration</h2>' + +'<p>Source position: classesh.inc line 1678</p>' + +'<table cellpadding="0" cellspacing="0">' + +'<tr>' + +'<td><p><tt><span class="code"> <span class="kw">published</span>' + +' <span class="kw">property </span>' + +'<a href="../classes/tcomponent.html">TComponent</a>' + +'<span class="sym">.</span>Name<span class="sym">: </span>' + +'<a href="../classes/tcomponentname.html">TComponentName</a>' + +'<br>  <span class="kw">read </span>FName<br>  ' + +'<span class="kw">write </span>SetName<br>  ' + +'<span class="kw">stored </span>False<span class="sym">;</span></span></tt></p></td>' + +'</tr>' + +'</table>' + +'<h2>Description</h2>' + +'<p><var>Name</var> is the name of the component. This name should be a valid identifier,' + +' i.e. must start with a letter or underscore, and can contain only letters, numbers and' + +' the underscore character. When attempting to set the name of a component, the name' + +' will be checked for validity. Furthermore, when a component is owned by another component,' + +' the name must be either empty or must be unique among the child component names. </p>' + +'<p>By "letters", 7-bit letters are meant. </p>' + +'<h2>Errors</h2>' + +'<p>Attempting to set the name to an invalid value will result in an exception being raised. </p>' + +'<h2>See also</h2>' + +'<table cellpadding="0" cellspacing="0">' + +'<tr>' + +'<td valign="top"><p><a href="../classes/tcomponent.validaterename.html">ValidateRename</a></p></td>' + +'<td><p>  </p></td>' + +'<td><p class="cmt">Called when a name change must be validated</p></td>' + +'</tr>' + +'<tr>' + +'<td valign="top"><p><a href="../classes/tcomponent.owner.html">Owner</a></p></td>' + +'<td><p>  </p></td>' + +'<td><p class="cmt">Owner of this component.</p></td>' + +'</tr>' + +'</table>' + +'</BODY></HTML>'); +end; + +function TForm1.DataProvider1CanHandle(Sender: TObject; const URL: string + ): Boolean; +begin + debugln(['TForm1.DataProvider1CanHandle ',URL]); + Result:=false; +end; + +procedure TForm1.DataProvider1CheckURL(Sender: TObject; const URL: string; + var Available: Boolean; var ContentType: string); +begin + debugln(['TForm1.DataProvider1CheckURL ',URL]); + Available:=false; + ContentType:=''; +end; + +procedure TForm1.DataProvider1GetHtml(Sender: TObject; const URL: string; + const PostData: TIpFormDataEntity; var Stream: TStream); +begin + debugln(['TForm1.DataProvider1GetHtml ',URL]); + Stream:=nil; +end; + +procedure TForm1.DataProvider1GetImage(Sender: TIpHtmlNode; const URL: string; + var Picture: TPicture); +begin + debugln(['TForm1.DataProvider1GetImage ',URL]); + Picture:=nil; +end; + +procedure TForm1.DataProvider1Leave(Sender: TIpHtml); +begin + +end; + +procedure TForm1.DataProvider1ReportReference(Sender: TObject; const URL: string + ); +begin + debugln(['TForm1.DataProvider1ReportReference ',URL]); +end; + +procedure TForm1.ShowHTML(Src: string); +var + ss: TStringStream; + NewHTML: TIpHtml; +begin + ss := TStringStream.Create(Src); + try + NewHTML := TIpHtml.Create; // Beware: Will be freed automatically by IpHtmlPanel1 + debugln(['TForm1.ShowHTML BEFORE SETHTML']); + IpHtmlPanel1.SetHtml(NewHTML); + debugln(['TForm1.ShowHTML BEFORE LOADFROMSTREAM']); + NewHTML.LoadFromStream(ss); + //if Anchor <> '' then IpHtmlPanel1.MakeAnchorVisible(Anchor); + finally + ss.Free; + end; +end; + +end. +