← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/turbopower_ipro/design/ipidehtmlcontrol.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/turbopower_ipro/design/ipidehtmlcontrol.pas
1
1
{
2
2
 *****************************************************************************
3
3
 *                                                                           *
4
 
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,        *
 
4
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
5
5
 *  for details about the copyright.                                         *
6
6
 *                                                                           *
7
7
 *  This program is distributed in the hope that it will be useful,          *
22
22
interface
23
23
 
24
24
uses
25
 
  Classes, SysUtils, LCLProc, Graphics, Controls, Dialogs,
26
 
  IpHtml, IDEHelpIntf, LazHelpIntf;
 
25
  Classes, SysUtils, LCLProc, Forms, Graphics, Controls, Dialogs, ExtCtrls, Menus,
 
26
  IpMsg, Ipfilebroker, IpHtml, IDEHelpIntf, LazHelpIntf, LazIDEIntf;
27
27
 
28
28
type
29
 
  TSimpleIpHtml = class(TIpHtml)
 
29
  TLazIPHtmlControl = class;
 
30
 
 
31
  { TLazIpHtmlDataProvider }
 
32
 
 
33
  TLazIpHtmlDataProvider = class(TIpHtmlDataProvider)
 
34
  private
 
35
    FControl: TLazIPHtmlControl;
 
36
  protected
 
37
    function DoGetStream(const URL: string): TStream; override;
30
38
  public
31
 
    property OnGetImageX;
 
39
    property Control: TLazIPHtmlControl read FControl;
32
40
  end;
33
41
 
34
 
  { TIPLazHtmlControl }
 
42
  { TLazIPHtmlControl }
35
43
 
36
 
  TIPLazHtmlControl = class(TIpHtmlPanel,TIDEHTMLControlIntf)
 
44
  TLazIPHtmlControl = class(TCustomPanel,TIDEHTMLControlIntf)
 
45
    function DataProviderCanHandle(Sender: TObject; const {%H-}URL: string): Boolean;
 
46
    procedure DataProviderCheckURL(Sender: TObject; const {%H-}URL: string;
 
47
      var Available: Boolean; var ContentType: string);
 
48
    procedure DataProviderGetHtml(Sender: TObject; const {%H-}URL: string;
 
49
      const {%H-}aPostData: TIpFormDataEntity; var Stream: TStream);
 
50
    procedure DataProviderGetImage(Sender: TIpHtmlNode; const URL: string;
 
51
      var Picture: TPicture);
 
52
    procedure DataProviderLeave(Sender: TIpHtml);
 
53
    procedure DataProviderReportReference(Sender: TObject; const {%H-}URL: string);
 
54
    procedure IPHTMLPanelHotClick(Sender: TObject);
37
55
  private
38
 
    FProvider: TAbstractIDEHTMLProvider;
 
56
    FIDEProvider: TAbstractIDEHTMLProvider;
 
57
    FIPHTMLPanel: TIpHtmlPanel;
39
58
    FURL: string;
40
 
    procedure SetProvider(const AValue: TAbstractIDEHTMLProvider);
41
 
    procedure HTMLGetImageX(Sender: TIpHtmlNode; const URL: string;
42
 
                            var Picture: TPicture);
 
59
    procedure SetIDEProvider(const AValue: TAbstractIDEHTMLProvider);
 
60
  protected
 
61
    procedure Notification(AComponent: TComponent; Operation: TOperation);
 
62
      override;
43
63
  public
44
64
    constructor Create(AOwner: TComponent); override;
 
65
    destructor Destroy; override;
45
66
    function GetURL: string;
46
67
    procedure SetURL(const AValue: string);
47
 
    property Provider: TAbstractIDEHTMLProvider read FProvider write SetProvider;
48
 
    procedure SetHTMLContent(Stream: TStream);
 
68
    property IDEProvider: TAbstractIDEHTMLProvider read FIDEProvider write SetIDEProvider;
 
69
    procedure SetHTMLContent(Stream: TStream; const NewURL: string);
49
70
    procedure GetPreferredControlSize(out AWidth, AHeight: integer);
 
71
    property IPHTMLPanel: TIpHtmlPanel read FIPHTMLPanel;
 
72
  end;
 
73
 
 
74
  { TLazIPHtmlControlClipboardPopup }
 
75
 
 
76
  TLazIPHtmlControlClipboardPopup = class(TPopupMenu)
 
77
  private
 
78
    FCopy, FSelectAll: TMenuItem;
 
79
    FPanel: TLazIPHtmlControl;
 
80
    procedure DoCopy(Sender: TObject);
 
81
    procedure DoSelectAll(Sender: TObject);
 
82
  protected
 
83
    procedure DoPopup(Sender: TObject); override;
 
84
  public
 
85
    constructor Create(AOwner: TComponent; APanel: TLazIPHtmlControl); reintroduce;
50
86
  end;
51
87
 
52
88
function IPCreateLazIDEHTMLControl(Owner: TComponent;
53
 
  var Provider: TAbstractIDEHTMLProvider): TControl;
 
89
  var Provider: TAbstractIDEHTMLProvider;
 
90
  {%H-}Flags: TIDEHTMLControlFlags = []): TControl;
54
91
 
55
92
procedure Register;
56
93
 
57
94
implementation
58
95
 
 
96
resourcestring
 
97
  ipdCopy = '&Copy';
 
98
  ipdSelectAll = 'Select &all';
 
99
 
59
100
procedure Register;
60
101
begin
61
102
  CreateIDEHTMLControl:=@IPCreateLazIDEHTMLControl;
62
103
end;
63
104
 
64
105
function IPCreateLazIDEHTMLControl(Owner: TComponent;
65
 
  var Provider: TAbstractIDEHTMLProvider): TControl;
 
106
  var Provider: TAbstractIDEHTMLProvider;
 
107
  Flags: TIDEHTMLControlFlags = []): TControl;
66
108
var
67
 
  HTMLControl: TIPLazHtmlControl;
 
109
  HTMLControl: TLazIPHtmlControl;
68
110
begin
69
 
  HTMLControl:=TIPLazHtmlControl.Create(Owner);
 
111
  //debugln(['IPCreateLazIDEHTMLControl ']);
 
112
  HTMLControl:=TLazIPHtmlControl.Create(Owner);
70
113
  Result:=HTMLControl;
71
114
  if Provider=nil then
72
115
    Provider:=CreateIDEHTMLProvider(HTMLControl);
73
 
  Provider.ControlIntf:=HTMLControl;
74
 
  HTMLControl.Provider:=Provider;
75
 
end;
76
 
 
77
 
{ TIPLazHtmlControl }
78
 
 
79
 
procedure TIPLazHtmlControl.SetProvider(const AValue: TAbstractIDEHTMLProvider
80
 
  );
81
 
begin
82
 
  if FProvider=AValue then exit;
83
 
  FProvider:=AValue;
84
 
end;
85
 
 
86
 
procedure TIPLazHtmlControl.HTMLGetImageX(Sender: TIpHtmlNode;
 
116
  //debugln(['IPCreateLazIDEHTMLControl Provider=',DbgSName(Provider)]);
 
117
  HTMLControl.IDEProvider:=Provider;
 
118
 
 
119
  if ihcWithClipboardMenu in Flags then
 
120
    TLazIPHtmlControlClipboardPopup.Create(Owner, HTMLControl);
 
121
end;
 
122
 
 
123
{ TLazIPHtmlControlClipboardPopup }
 
124
 
 
125
procedure TLazIPHtmlControlClipboardPopup.DoCopy(Sender: TObject);
 
126
begin
 
127
  if FPanel.IPHTMLPanel <> nil then
 
128
    FPanel.IPHTMLPanel.CopyToClipboard;
 
129
end;
 
130
 
 
131
procedure TLazIPHtmlControlClipboardPopup.DoSelectAll(Sender: TObject);
 
132
begin
 
133
  if FPanel.IPHTMLPanel <> nil then
 
134
    FPanel.IPHTMLPanel.SelectAll;
 
135
end;
 
136
 
 
137
procedure TLazIPHtmlControlClipboardPopup.DoPopup(Sender: TObject);
 
138
begin
 
139
  if FPanel.IPHTMLPanel <> nil then
 
140
    FCopy.Enabled := FPanel.IPHTMLPanel.HaveSelection;
 
141
  inherited DoPopup(Sender);
 
142
end;
 
143
 
 
144
constructor TLazIPHtmlControlClipboardPopup.Create(AOwner: TComponent;
 
145
  APanel: TLazIPHtmlControl);
 
146
begin
 
147
  inherited Create(AOwner);
 
148
  FPanel := APanel;
 
149
  AutoPopup := True;
 
150
 
 
151
  FCopy := TMenuItem.Create(Owner);
 
152
  FCopy.Caption := ipdCopy;
 
153
  FCopy.ShortCut := ShortCut(ord('C'), [ssCtrl]);
 
154
  FCopy.OnClick  := @DoCopy;
 
155
  Items.Add(FCopy);
 
156
 
 
157
  FSelectAll := TMenuItem.Create(Owner);
 
158
  FSelectAll.Caption := ipdSelectAll;
 
159
  FSelectAll.ShortCut := ShortCut(ord('A'), [ssCtrl]);
 
160
  FSelectAll.OnClick   := @DoSelectAll;
 
161
  Items.Add(FSelectAll);
 
162
 
 
163
  TControl(Owner).PopupMenu := Self;
 
164
end;
 
165
 
 
166
{ TLazIpHtmlDataProvider }
 
167
 
 
168
function TLazIpHtmlDataProvider.DoGetStream(const URL: string): TStream;
 
169
begin
 
170
  //debugln(['TLazIpHtmlDataProvider.DoGetStream ',URL,' ',DbgSName(Control.IDEProvider)]);
 
171
  Result:=Control.IDEProvider.GetStream(URL,false);
 
172
end;
 
173
 
 
174
{ TLazIPHtmlControl }
 
175
 
 
176
function TLazIPHtmlControl.DataProviderCanHandle(Sender: TObject;
 
177
  const URL: string): Boolean;
 
178
begin
 
179
  //debugln(['TLazIPHtmlControl.DataProviderCanHandle URL=',URL]);
 
180
  Result:=false;
 
181
end;
 
182
 
 
183
procedure TLazIPHtmlControl.DataProviderCheckURL(Sender: TObject;
 
184
  const URL: string; var Available: Boolean; var ContentType: string);
 
185
begin
 
186
  //debugln(['TLazIPHtmlControl.DataProviderCheckURL URL=',URL]);
 
187
  Available:=false;
 
188
  ContentType:='';
 
189
end;
 
190
 
 
191
procedure TLazIPHtmlControl.DataProviderGetHtml(Sender: TObject;
 
192
  const URL: string; const aPostData: TIpFormDataEntity; var Stream: TStream);
 
193
begin
 
194
  //debugln(['TLazIPHtmlControl.DataProviderGetHtml URL=',URL]);
 
195
  Stream:=nil;
 
196
end;
 
197
 
 
198
procedure TLazIPHtmlControl.DataProviderGetImage(Sender: TIpHtmlNode;
87
199
  const URL: string; var Picture: TPicture);
88
200
var
89
201
  URLType: string;
95
207
  NewURL: String;
96
208
begin
97
209
  //DebugLn(['TIPLazHtmlControl.HTMLGetImageX URL=',URL]);
98
 
  if Provider=nil then exit;
99
 
  NewURL:=Provider.BuildURL(Provider.BaseURL,URL);
100
 
  //DebugLn(['TIPLazHtmlControl.HTMLGetImageX NewURL=',NewURL,' Provider.BaseURL=',Provider.BaseURL,' URL=',URL]);
 
210
  if IDEProvider=nil then exit;
 
211
  NewURL:=IDEProvider.MakeURLAbsolute(IDEProvider.BaseURL,URL);
 
212
  //DebugLn(['TIPLazHtmlControl.HTMLGetImageX NewURL=',NewURL,' Provider.BaseURL=',IDEProvider.BaseURL,' URL=',URL]);
101
213
 
102
214
  Picture:=nil;
103
215
  Stream:=nil;
110
222
      Ext:=ExtractFileExt(Filename);
111
223
      //DebugLn(['TIPLazHtmlControl.HTMLGetImageX URLPath=',URLPath,' Filename=',Filename,' Ext=',Ext]);
112
224
      Picture:=TPicture.Create;
113
 
      // quick check if file format is supported
 
225
      // quick check if file format is supported (raises an exception)
114
226
      Picture.FindGraphicClassWithFileExt(Ext);
115
227
      // get stream
116
 
      Stream:=Provider.GetStream(NewURL);
 
228
      Stream:=IDEProvider.GetStream(NewURL,true);
117
229
      // load picture
118
230
      Picture.LoadFromStreamWithFileExt(Stream,Ext);
119
231
    finally
120
232
      if Stream<>nil then
121
 
        Provider.ReleaseStream(NewURL);
 
233
        IDEProvider.ReleaseStream(NewURL);
122
234
    end;
123
235
  except
124
236
    on E: Exception do begin
128
240
  end;
129
241
end;
130
242
 
131
 
constructor TIPLazHtmlControl.Create(AOwner: TComponent);
 
243
procedure TLazIPHtmlControl.DataProviderLeave(Sender: TIpHtml);
 
244
begin
 
245
  //debugln(['TLazIPHtmlControl.DataProviderLeave ']);
 
246
end;
 
247
 
 
248
procedure TLazIPHtmlControl.DataProviderReportReference(Sender: TObject;
 
249
  const URL: string);
 
250
begin
 
251
  //debugln(['TLazIPHtmlControl.DataProviderReportReference URL=',URL]);
 
252
end;
 
253
 
 
254
procedure TLazIPHtmlControl.IPHTMLPanelHotClick(Sender: TObject);
 
255
var
 
256
  HotNode: TIpHtmlNode;
 
257
  HRef: String;
 
258
  //Target: String;
 
259
begin
 
260
  HotNode:=FIPHTMLPanel.HotNode;
 
261
  if HotNode is TIpHtmlNodeA then begin
 
262
    HRef := TIpHtmlNodeA(HotNode).HRef;
 
263
    //Target := TIpHtmlNodeA(HotNode).Target;
 
264
  end else begin
 
265
    HRef := TIpHtmlNodeAREA(HotNode).HRef;
 
266
    //Target := TIpHtmlNodeAREA(HotNode).Target;
 
267
  end;
 
268
  //debugln(['TLazIPHtmlControl.IPHTMLPanelHotClick HRef="',HRef,'" Target="',Target,'"']);
 
269
  IDEProvider.OpenURLAsync(HRef);
 
270
end;
 
271
 
 
272
procedure TLazIPHtmlControl.SetIDEProvider(
 
273
  const AValue: TAbstractIDEHTMLProvider);
 
274
begin
 
275
  if FIDEProvider=AValue then exit;
 
276
  //debugln(['TLazIPHtmlControl.SetIDEProvider Old=',DbgSName(FIDEProvider),' New=',DbgSName(FIDEProvider)]);
 
277
  if FIDEProvider<>nil then begin
 
278
    IDEProvider.ControlIntf:=nil;
 
279
  end;
 
280
  FIDEProvider:=AValue;
 
281
  if FIDEProvider<>nil then begin
 
282
    FreeNotification(FIDEProvider);
 
283
    IDEProvider.ControlIntf:=Self;
 
284
  end;
 
285
end;
 
286
 
 
287
procedure TLazIPHtmlControl.Notification(AComponent: TComponent;
 
288
  Operation: TOperation);
 
289
begin
 
290
  inherited Notification(AComponent, Operation);
 
291
  if Operation=opRemove then begin
 
292
    if IDEProvider=AComponent then begin
 
293
      if IDEProvider.ControlIntf=TIDEHTMLControlIntf(Self) then
 
294
        IDEProvider.ControlIntf:=nil;
 
295
      IDEProvider:=nil;
 
296
    end;
 
297
  end;
 
298
end;
 
299
 
 
300
constructor TLazIPHtmlControl.Create(AOwner: TComponent);
132
301
begin
133
302
  inherited Create(AOwner);
134
 
  DefaultFontSize := 8;
135
 
  MarginHeight := 0;
136
 
  MarginWidth := 0; 
137
 
end;
138
 
 
139
 
function TIPLazHtmlControl.GetURL: string;
 
303
  FIPHTMLPanel:=TIpHtmlPanel.Create(Self);
 
304
  with FIPHTMLPanel do begin
 
305
    Name:='TLazIPHtmlControl_IPHTMLPanel';
 
306
    Align:=alClient;
 
307
    DefaultFontSize:=8;
 
308
    MarginHeight:=2;
 
309
    MarginWidth:=2;
 
310
    Parent:=Self;
 
311
    WantTabs := False;
 
312
    OnHotClick:=@IPHTMLPanelHotClick;
 
313
  end;
 
314
  FIPHTMLPanel.DataProvider:=TLazIpHtmlDataProvider.Create(FIPHTMLPanel);
 
315
  with TLazIpHtmlDataProvider(FIPHTMLPanel.DataProvider) do begin
 
316
    FControl:=Self;
 
317
    Name:='TLazIPHtmlControl_DataProvider';
 
318
    OnCanHandle:=@DataProviderCanHandle;
 
319
    OnGetHtml:=@DataProviderGetHtml;
 
320
    OnGetImage:=@DataProviderGetImage;
 
321
    OnLeave:=@DataProviderLeave;
 
322
    OnCheckURL:=@DataProviderCheckURL;
 
323
    OnReportReference:=@DataProviderReportReference;
 
324
  end;
 
325
  Caption:='';
 
326
  BevelInner:=bvLowered;
 
327
end;
 
328
 
 
329
destructor TLazIPHtmlControl.Destroy;
 
330
begin
 
331
  //debugln(['TLazIPHtmlControl.Destroy ',DbgSName(Self),' ',dbgs(Pointer(Self))]);
 
332
  FreeAndNil(FIDEProvider);
 
333
  inherited Destroy;
 
334
end;
 
335
 
 
336
function TLazIPHtmlControl.GetURL: string;
140
337
begin
141
338
  Result:=FURL;
142
339
end;
143
340
 
144
 
procedure TIPLazHtmlControl.SetURL(const AValue: string);
 
341
procedure TLazIPHtmlControl.SetURL(const AValue: string);
145
342
var
146
343
  Stream: TStream;
147
 
  NewHTML: TSimpleIpHtml;
 
344
  NewHTML: TIpHtml;
148
345
  NewURL: String;
149
 
  ok: Boolean;
150
346
begin
151
 
  if Provider=nil then raise Exception.Create('TIPLazHtmlControl.SetURL missing Provider');
 
347
  if IDEProvider=nil then raise Exception.Create('TIPLazHtmlControl.SetURL missing Provider');
152
348
  if FURL=AValue then exit;
153
 
  NewURL:=Provider.BuildURL(Provider.BaseURL,AValue);
 
349
  NewURL:=IDEProvider.MakeURLAbsolute(IDEProvider.BaseURL,AValue);
154
350
  if FURL=NewURL then exit;
155
351
  FURL:=NewURL;
156
352
  try
157
 
    Stream:=Provider.GetStream(FURL);
158
 
    ok:=false;
159
 
    NewHTML:=nil;
 
353
    Stream:=IDEProvider.GetStream(FURL,true);
160
354
    try
161
 
      NewHTML:=TSimpleIpHtml.Create; // Beware: Will be freed automatically TIpHtmlPanel
162
 
      NewHTML.OnGetImageX:=@HTMLGetImageX;
 
355
      NewHTML:=TIpHtml.Create; // Beware: Will be freed automatically TIpHtmlPanel
 
356
      FIPHTMLPanel.SetHtml(NewHTML);
163
357
      NewHTML.LoadFromStream(Stream);
164
 
      ok:=true;
165
358
    finally
166
 
      if not ok then NewHTML.Free;
167
 
      Provider.ReleaseStream(FURL);
 
359
      IDEProvider.ReleaseStream(FURL);
168
360
    end;
169
 
    SetHtml(NewHTML);
170
361
  except
171
362
    on E: Exception do begin
172
363
      MessageDlg('Unable to open HTML file',
173
 
        'HTML File: '+FURL+#13
 
364
        'URL: '+FURL+#13
174
365
        +'Error: '+E.Message,mtError,[mbCancel],0);
175
366
    end;
176
367
  end;
177
368
end;
178
369
 
179
 
procedure TIPLazHtmlControl.SetHTMLContent(Stream: TStream);
 
370
procedure TLazIPHtmlControl.SetHTMLContent(Stream: TStream; const NewURL: string
 
371
  );
180
372
var
181
 
  ok: Boolean;
182
 
  NewHTML: TSimpleIpHtml;
 
373
  NewHTML: TIpHtml;
183
374
begin
184
 
  ok:=false;
185
 
  NewHTML:=nil;
 
375
  FURL:=NewURL;
186
376
  try
187
 
    NewHTML:=TSimpleIpHtml.Create; // Beware: Will be freed automatically by TIpHtmlPanel
188
 
    NewHTML.OnGetImageX:=@HTMLGetImageX;
 
377
    NewHTML:=TIpHtml.Create; // Beware: Will be freed automatically TIpHtmlPanel
 
378
    FIPHTMLPanel.SetHtml(NewHTML);
189
379
    NewHTML.LoadFromStream(Stream);
190
 
    ok:=true;
191
 
  finally
192
 
    if not ok then NewHTML.Free;
 
380
  except
 
381
    on E: Exception do begin
 
382
      MessageDlg('Unable to load HTML stream',
 
383
        'URL: '+FURL+#13
 
384
        +'Error: '+E.Message,mtError,[mbCancel],0);
 
385
    end;
193
386
  end;
194
 
  SetHtml(NewHTML);
195
387
end;
196
388
 
197
 
procedure TIPLazHtmlControl.GetPreferredControlSize(out AWidth, AHeight: integer);
 
389
procedure TLazIPHtmlControl.GetPreferredControlSize(out AWidth, AHeight: integer);
198
390
begin
199
 
  with GetContentSize do
200
 
  begin
201
 
    AWidth := cx;
202
 
    AHeight := cy;
203
 
  end;
 
391
  AWidth:=0;
 
392
  AHeight:=0;
 
393
  inherited GetPreferredSize(AWidth, AHeight);
204
394
end;
205
395
 
206
396
end.