1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
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.
|
