A.J. Venter napsal(a):
I'm trying to extend my tsimple_html component so it can read from a
tstringlist property instead of a URL (which in many [at least of my]
programs could severely reduce overhead).
So I basically just added a tstringlist property exactly as I have always done
it before (and I compared code with my other components, I cannot find the
difference).
But in this one, the moment you click the property editor for the tstringlist,
it throws an access violation - not a good sign.
Any chance somebody knows what I am doing wrong here ? (code attached)
A.J.
Maybe changing type of FLines and Lines property from TStringList to
TStrings would help.
tombo
------------------------------------------------------------------------
Unit simple_html;
{A simple file based html viewer component based on ippro with image viewing
added}
{$mode objfpc}{$H+}
interface
uses
LResources,Classes, SysUtils, Forms, Controls,
Graphics,IPHtml,lazjpeg,util,simple_downloader
,fileUtil,dialogs,extCtrls;
Type
TParseEvent = procedure(Sender: TObject;TempFileName:String) of object;
THTML = class(TIpHtml)
public
property OnGetImageX;
end;
TSimpleHtml = Class(TComponent)
private
FTDIR : String;
FURL : String;
FHTML : THTML;
FLines : TStringlist;
FPanel : TipHTMLPanel;
FParseMe: TParseEvent;
FDownLoader : TSimple_Downloader;
Function FetchURL(URL:String):String;
destructor destroy;
procedure setHTMLSTrings(const Avalue: TStringlist);
Public
constructor Create(AOwner: TComponent);
procedure showHTML;
Procedure HTMLGetImageX(Sender: TIpHtmlNode; Const URL:
String; Var Picture: TPicture);
published
property URL : String read FURL write FURL;
property HTMLSTrings : TStringlist read FLines write
setHTMLSTrings;
property TempDir : String read FTDir write FTDir;
property Panel: TipHTMLPanel read FPanel write Fpanel;
property OnCanParse: TParseEvent read FParseMe write
FParseMe;
property DownLoader : TSimple_Downloader read FDownLoader
Write FDownloader;
End;
procedure Register;
Implementation
procedure Register;
begin
RegisterComponents('OLPack',[TSimpleHTML]);
end;
Procedure TSimpleHTML.SetHTMLSTrings(const Avalue: TStringList);
Begin
If AValue <> Nil then
FLines.Assign(AValue);
end;
Function TSimpleHTML.FetchURL(URL:String):String;
Var
SDIR,Ext: STring;
Begin
If pos('://',URL) = 0 then
FetchURL := URL
else begin
FileUTil.ForceDirectory(FTDIR);
SDIR := '';
Ext := UpperCase(ExtractFileExt(URL));
If (Ext = '.JPG') or
(Ext = '.PNG') or
(Ext = '.GIF') or
(Ext = '.XPM') then
SDIR := FTDIR+pathDelim+ExtractFileName(URL) else
If (length(ExtractFileName(URL)) = 0) or (Length(EXT)=0) then
SDIR := FTDIR+pathdelim+'index.html' else
If pos('.html',ExtractFileName(URL)) = 0 then
SDIR := FTDIR+pathdelim+ExtractFileName(URL)+'.html' else
SDIR := FTDIR+pathdelim+ExtractFileName(URL);
SDIR := SingleSlashes(SDIR);
DownLoader.URL := URL;
Downloader.Download;
DownLoader.Output.SaveToFile(SDIR);
if ((ExtractFileExt(SDIR) = '.html') or (ExtractFileExt(SDIR) = '.htm'))
And (Assigned(FParseMe)) then
FParseMe(Self,SDIR);
FetchURL := SDIR;
end;
end;
Procedure TSimpleHTML.HTMLGetImageX(Sender:TIpHtmlNode; Const URL: String; Var
Picture: TPicture);
Var
PicCreated: boolean;
IMGFile:String;
Begin
Try
IF (FileExists(FTDIR+PathDelim+ExtractFileName(URL))) then
IMGFile := FTDIR+PathDelim+ExtractFileName(URL) else
if (pos('://',URL) <> 0) then
IMGFile := FetchURL(URL) else
IMGFILE := URL;
If FileExists(IMGFIle) Then
Begin
PicCreated := False;
If Picture=Nil Then
Begin
Picture := TPicture.Create;
PicCreated := True;
End;
Picture.LoadFromFile(IMGFile);
End;
Except
If PicCreated Then
Picture.Free;
Picture := Nil;
End;
End;
Constructor TSimpleHTML.Create(AOwner: TComponent);
Begin
FLines := TStringlist.create;
inherited create(AOwner);
End;
Procedure TSimpleHTML.ShowHTML;
Var Path : String;
HTMLStream: TMemoryStream;
I :Integer;
Begin
if length(FTDir) = 0 then
FTDir := SysUtils.GetTempFileName;
If Length(FURL) <> 0 then
begin
Path := FetchURL(FURL);
HTMLStream := TMemoryStream.Create;
HTMLStream.LoadFromFile(Path);
end else
begin
For I := 0 to FLines.Count - 1 do
HTMLStream.WriteAnsiString(FLines[I]);
end;
FHTML := THTML.Create;
FHTML.OnGetImageX := @HTMLGetImageX;
FHTML.LoadFromStream(HTMLStream);
HTMLStream.Free;
Panel.SetHTML(FHtml);
End;
destructor TSimpleHTML.destroy;
Begin
FLines.Free;
inherited destroy;
End;
initialization
{$I simple_html.lrs}
End.
_________________________________________________________________
To unsubscribe: mail [EMAIL PROTECTED] with
"unsubscribe" as the Subject
archives at http://www.lazarus.freepascal.org/mailarchives
