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
|
unit MainUnit;
{$mode objfpc}{$H+}
{$define UsePreview}
interface
uses
Classes, SysUtils, Forms, Graphics, Dialogs, ExtCtrls, StdCtrls,
{$ifdef UsePreview}
OsPrinters,
{$endif}
LazFileUtils, LazUTF8, IpHtml;
type
TSimpleIpHtml = class(TIpHtml)
public
property OnGetImageX;
end;
// TIpSimpleHtmlDataProvider = class(TIpAbstractHtmlDataProvider)
// end;
{ TMainForm }
TMainForm = class(TForm)
Button1: TButton;
IpHtmlPanel1: TIpHtmlPanel;
OpenDialog1: TOpenDialog;
OpenHTMLFileButton1: TButton;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure HTMLGetImageX(Sender: TIpHtmlNode; const URL: string;
var Picture: TPicture);
procedure IpHtmlPanel1HotClick(Sender: TObject);
procedure MainFormCreate(Sender: TObject);
procedure OpenHTMLFileButtonClick(Sender: TObject);
public
procedure OpenHTMLFile(const Filename: string);
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.MainFormCreate(Sender: TObject);
begin
OpenHTMLFile('index.html');
end;
procedure TMainForm.OpenHTMLFileButtonClick(Sender: TObject);
begin
if OpenDialog1.Execute then begin
OpenHtmlFile(OpenDialog1.FileName);
end;
end;
procedure TMainForm.IpHtmlPanel1HotClick(Sender: TObject);
var
NodeA: TIpHtmlNodeA;
NewFilename: String;
begin
if IpHtmlPanel1.HotNode is TIpHtmlNodeA then begin
NodeA:=TIpHtmlNodeA(IpHtmlPanel1.HotNode);
NewFilename:=NodeA.HRef;
OpenHTMLFile(NewFilename);
end;
end;
procedure TMainForm.HTMLGetImageX(Sender: TIpHtmlNode; const URL: string;
var Picture: TPicture);
var
PicCreated: boolean;
begin
try
if FileExistsUTF8(URL) then begin
PicCreated := False;
if Picture=nil then begin
Picture:=TPicture.Create;
PicCreated := True;
end;
Picture.LoadFromFile(URL);
end;
except
if PicCreated then
Picture.Free;
Picture := nil;
end;
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
{$ifdef UsePreview}
IpHtmlPanel1.PrintPreview;
{$else}
ShowMessage(
'In order to use this feature, please read instructions'+LineEnding+
'contained in the readme file included in this project'+LineEnding+
'directory');
{$endif}
end;
procedure TMainForm.OpenHTMLFile(const Filename: string);
var
fs: TFileStream;
NewHTML: TSimpleIpHtml;
begin
try
fs:=TFileStream.Create(UTF8ToSys(Filename),fmOpenRead);
try
NewHTML:=TSimpleIpHtml.Create; // Beware: Will be freed automatically by IpHtmlPanel1
NewHTML.OnGetImageX:=@HTMLGetImageX;
NewHTML.LoadFromStream(fs);
finally
fs.Free;
end;
IpHtmlPanel1.SetHtml(NewHTML);
except
on E: Exception do begin
MessageDlg('Unable to open HTML file',
'HTML File: '+Filename+LineEnding
+'Error: '+E.Message,mtError,[mbCancel],0);
end;
end;
end;
end.
|
