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(
''
+''
+'TComponent.Name '
+'Name of the component.
'
+'Declaration '
+'Source position: classesh.inc line 1678
'
+''
+''
+' published '
+' property '
+'TComponent '
+'. Name: '
+'TComponentName '
+'read FNamewrite SetNamestored False;
'
+'
'
+'Description '
+'Name 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.
'
+'By "letters", 7-bit letters are meant.
'
+'Errors '
+'Attempting to set the name to an invalid value will result in an exception being raised.
'
+'See also '
+''
+''
+'ValidateRename
Called when a name change must be validated
'
+''
+'Owner
Owner of this component.
'
+'
'
+'');
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.