1 unit htmlwithcssfrm;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
9 IPHtml, Ipfilebroker, IpMsg;
10
11 type
12
13 { TMyIpHtmlDataProvider }
14
15 TMyIpHtmlDataProvider = class(TIpHtmlDataProvider)
16 protected
DoGetStreamnull17 function DoGetStream(const URL: string): TStream; override;
18 public
19
20 end;
21
22 { TForm1 }
23
24 TForm1 = class(TForm)
DataProvider1CanHandlenull25 function DataProvider1CanHandle(Sender: TObject; const URL: string
26 ): Boolean;
27 procedure DataProvider1CheckURL(Sender: TObject; const URL: string;
28 var Available: Boolean; var ContentType: string);
29 procedure DataProvider1GetHtml(Sender: TObject; const URL: string;
30 const PostData: TIpFormDataEntity; var Stream: TStream);
31 procedure DataProvider1GetImage(Sender: TIpHtmlNode; const URL: string;
32 var Picture: TPicture);
33 procedure DataProvider1Leave(Sender: TIpHtml);
34 procedure DataProvider1ReportReference(Sender: TObject; const URL: string);
35 procedure FormCreate(Sender: TObject);
36 private
37 procedure ShowHTML(Src: string);
38 public
39 IpHtmlPanel1: TIpHtmlPanel;
40 DataProvider1: TMyIpHtmlDataProvider;
41 end;
42
43 var
44 Form1: TForm1;
45
46 implementation
47
48 {$R *.lfm}
49
50 { TMyIpHtmlDataProvider }
51
TMyIpHtmlDataProvider.DoGetStreamnull52 function TMyIpHtmlDataProvider.DoGetStream(const URL: string): TStream;
53 var
54 ms: TMemoryStream;
55 begin
56 Result:=nil;
57 debugln(['TMyIpHtmlDataProvider.DoGetStream ',URL]);
58
59 if URL='fpdoc.css' then begin
60 debugln(['TMyIpHtmlDataProvider.DoGetStream ',FileExists(URL)]);
61 ms:=TMemoryStream.Create;
62 try
63 ms.LoadFromFile(URL);
64 ms.Position:=0;
65 except
66 ms.Free;
67 end;
68 Result:=ms;
69 end;
70 end;
71
72 { TForm1 }
73
74 procedure TForm1.FormCreate(Sender: TObject);
75 begin
76 DataProvider1:=TMyIpHtmlDataProvider.Create(Self);
77 with DataProvider1 do begin
78 Name:='DataProvider1';
79 OnCanHandle:=@DataProvider1CanHandle;
80 OnGetHtml:=@DataProvider1GetHtml;
81 OnGetImage:=@DataProvider1GetImage;
82 OnLeave:=@DataProvider1Leave;
83 OnCheckURL:=@DataProvider1CheckURL;
84 OnReportReference:=@DataProvider1ReportReference;
85 end;
86 IpHtmlPanel1:=TIpHtmlPanel.Create(Self);
87 with IpHtmlPanel1 do begin
88 Name:='IpHtmlPanel1';
89 Parent:=Self;
90 Align:=alClient;
91 DefaultFontSize:=10;
92 DataProvider:=DataProvider1;
93 end;
94
95 ShowHTML(
96 '<HTML>'
97 +'<head>'
98 +'<link rel="stylesheet" href="fpdoc.css" type="text/css">'
99 +'</head>'
100 +'<BODY>'
101 +'<h1>TComponent.Name</h1>'
102 +'<p>Name of the component.</p>'
103 +'<h2>Declaration</h2>'
104 +'<p>Source position: classesh.inc line 1678</p>'
105 +'<table cellpadding="0" cellspacing="0">'
106 +'<tr>'
107 +'<td><p><tt><span class="code"> <span class="kw">published</span>'
108 +' <span class="kw">property </span>'
109 +'<a href="../classes/tcomponent.html">TComponent</a>'
110 +'<span class="sym">.</span>Name<span class="sym">: </span>'
111 +'<a href="../classes/tcomponentname.html">TComponentName</a>'
112 +'<br> <span class="kw">read </span>FName<br> '
113 +'<span class="kw">write </span>SetName<br> '
114 +'<span class="kw">stored </span>False<span class="sym">;</span></span></tt></p></td>'
115 +'</tr>'
116 +'</table>'
117 +'<h2>Description</h2>'
118 +'<p><var>Name</var> is the name of the component. This name should be a valid identifier,'
119 +' i.e. must start with a letter or underscore, and can contain only letters, numbers and'
120 +' the underscore character. When attempting to set the name of a component, the name'
121 +' will be checked for validity. Furthermore, when a component is owned by another component,'
122 +' the name must be either empty or must be unique among the child component names. </p>'
123 +'<p>By "letters", 7-bit letters are meant. </p>'
124 +'<h2>Errors</h2>'
125 +'<p>Attempting to set the name to an invalid value will result in an exception being raised. </p>'
126 +'<h2>See also</h2>'
127 +'<table cellpadding="0" cellspacing="0">'
128 +'<tr>'
129 +'<td valign="top"><p><a href="../classes/tcomponent.validaterename.html">ValidateRename</a></p></td>'
130 +'<td><p> </p></td>'
131 +'<td><p class="cmt">Called when a name change must be validated</p></td>'
132 +'</tr>'
133 +'<tr>'
134 +'<td valign="top"><p><a href="../classes/tcomponent.owner.html">Owner</a></p></td>'
135 +'<td><p> </p></td>'
136 +'<td><p class="cmt">Owner of this component.</p></td>'
137 +'</tr>'
138 +'</table>'
139 +'</BODY></HTML>');
140 end;
141
TForm1.DataProvider1CanHandlenull142 function TForm1.DataProvider1CanHandle(Sender: TObject; const URL: string
143 ): Boolean;
144 begin
145 debugln(['TForm1.DataProvider1CanHandle ',URL]);
146 Result:=false;
147 end;
148
149 procedure TForm1.DataProvider1CheckURL(Sender: TObject; const URL: string;
150 var Available: Boolean; var ContentType: string);
151 begin
152 debugln(['TForm1.DataProvider1CheckURL ',URL]);
153 Available:=false;
154 ContentType:='';
155 end;
156
157 procedure TForm1.DataProvider1GetHtml(Sender: TObject; const URL: string;
158 const PostData: TIpFormDataEntity; var Stream: TStream);
159 begin
160 debugln(['TForm1.DataProvider1GetHtml ',URL]);
161 Stream:=nil;
162 end;
163
164 procedure TForm1.DataProvider1GetImage(Sender: TIpHtmlNode; const URL: string;
165 var Picture: TPicture);
166 begin
167 debugln(['TForm1.DataProvider1GetImage ',URL]);
168 Picture:=nil;
169 end;
170
171 procedure TForm1.DataProvider1Leave(Sender: TIpHtml);
172 begin
173
174 end;
175
176 procedure TForm1.DataProvider1ReportReference(Sender: TObject; const URL: string
177 );
178 begin
179 debugln(['TForm1.DataProvider1ReportReference ',URL]);
180 end;
181
182 procedure TForm1.ShowHTML(Src: string);
183 var
184 ss: TStringStream;
185 NewHTML: TIpHtml;
186 begin
187 ss := TStringStream.Create(Src);
188 try
189 NewHTML := TIpHtml.Create; // Beware: Will be freed automatically by IpHtmlPanel1
190 debugln(['TForm1.ShowHTML BEFORE SETHTML']);
191 IpHtmlPanel1.SetHtml(NewHTML);
192 debugln(['TForm1.ShowHTML BEFORE LOADFROMSTREAM']);
193 NewHTML.LoadFromStream(ss);
194 //if Anchor <> '' then IpHtmlPanel1.MakeAnchorVisible(Anchor);
195 finally
196 ss.Free;
197 end;
198 end;
199
200 end.
201
202