So there I was, thinking today, what can I do to once more save future time... 
and I realised that something I would really like is to have a component that 
can wrap around ipro and implement a simple file-based html viewer with image 
support, jpeg loading and such built-in.

Easy right, after all just that exists in the example shipped for it, so all I 
have to do is plagiarise the code a bit and create a component out of it. 

So I created my component and added the bits I wanted, mostly just a property 
for specifying an html file and a method for showing it. 

And it works, even jpg's load fine.
But immediately after loading it throws an exception, ignore the exception and 
it throws it again, and again and again (no idea is given of WHAT exception).
The frequency and timing does however suggest that the exception is thrown 
during the onpaint event (though I never TOUCHED that :p )

Anyway, here is the code:
unit simple_html;
{A simple file based html viewer component based on ippro with image viewing 
added}

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics,IPHtml,lazjpeg;

type

  TSimpleIpHtml = class(TIpHtml)
  public
    property OnGetImageX;
  end;
  
  
   TSimpleHTML = class(TIpHtmlPanel)
  private
     FHtmlFile : String;
     FNewHTML: TSimpleIpHtml;
  public
    { public declarations }
      procedure HTMLGetImageX(Sender: TIpHtmlNode; const URL: string; var 
Picture: TPicture);
      procedure ShowFile; {Loads a designtime set html file}
      destructor destroy; override;
 published
     { published properties }
     constructor create(AOwner: TComponent); override;
     property HTMLFile : String Write FHtmlFile;
  end;

procedure register;

implementation
{TSImpleHTML}
procedure Register;
begin
  RegisterComponents('OLPack',[TSimpleHTML]);
end;
procedure TSimpleHTML.HTMLGetImageX(Sender: TIpHtmlNode; const URL: string;
  var Picture: TPicture);
var
  PicCreated: boolean;
begin
  try
    if FileExists(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 TSimpleHTML.ShowFile;
var
  fs: TFileStream;
begin
 if FileExists(FHtmlFile) then
  try
    fs:=TFileStream.Create(FHtmlFile,fmOpenRead);
    try
      FNewHTML.OnGetImageX:[EMAIL PROTECTED];
      FNewHTML.LoadFromStream(fs);
    finally
      fs.Free;
    end;
   SetHtml(FNewHTML);
  except
    on E: Exception do begin
      Writeln('Unable to open HTML file',FHtmlFile);
    end;
  end;
end;




destructor TSimpleHTML.destroy;
Begin
      inherited;
end;

constructor TSimpleHTML.create(AOwner: TComponent);
begin
 FNewHTML:=TSimpleIpHtml.Create;
  inherited;
end;
end.

---------------
Here is the relevant parts from a simple demo program I did to test it:
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    OpenDialog1: TOpenDialog;
    SimpleHTML1: TSimpleHTML;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
   Edit1.Text := OpenDialog1.Filename;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SimpleHTML1.HTMLFile := Edit1.Text;
  SimpleHTML1.ShowFile;
end;

-----------------------
Anybody here familiar enough with ipro to know what I am doing wrong ?

Ciao
A.J.

-- 
A.J. Venter
Chief Software Architect
OpenLab International
www.getopenlab.com
www.silentcoder.co.za
+27 82 726 5103

_________________________________________________________________
     To unsubscribe: mail [EMAIL PROTECTED] with
                "unsubscribe" as the Subject
   archives at http://www.lazarus.freepascal.org/mailarchives

Reply via email to