问题
I have a string var 'HTMLCode' that contains HTML code. I want to load this code into the browser.
This is Embarcadero's code:
procedure THTMLEdit.EditText(CONST HTMLCode: string);
{VAR
Doc: IHTMLDocument2;
TempFile: string; }
begin
TempFile := GetTempFile('.html');
StringToFile(TempFile, HTMLCode);
wbBrowser.Navigate(TempFile);
Doc := GetDocument;
if Doc <> NIL
then Doc.Body.SetAttribute('contentEditable', 'true', 0); //crash here when I load complex html files
DeleteFile(TempFile);
end;
It has some problems so I replaced it with this one:
procedure THTMLEdit.EditText(CONST HTMLCode: string);
VAR
TSL: TStringList;
MemStream: TMemoryStream;
begin
wbBrowser.Navigate('about:blank');
WHILE wbBrowser.ReadyState < READYSTATE_INTERACTIVE
DO Application.ProcessMessages;
GetDocument.DesignMode := 'On';
if Assigned(wbBrowser.Document) then
begin
TSL := TStringList.Create;
TRY
MemStream := TMemoryStream.Create;
TRY
TSL.Text := HTMLCode;
TSL.SaveToStream(MemStream);
MemStream.Seek(0, 0);
(wbBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(MemStream));
FINALLY
MemStream.Free;
end;
FINALLY
TSL.Free;
end;
end;
end;
But this one has problems also . First, when I insert links (...) into the HTML code, the browser will alter the code, appending 'about:' in front of my URLs. Second: it is slower than the first procedure (the one with temp file).
Can I load HTML code in browser without navigating first to 'about:blank'?
回答1:
You could load your HTML
code as the below
procedure THTMLEdit.EditText(CONST HTMLCode: string);
var
Doc: Variant;
begin
if NOT Assigned(wbBrowser.Document) then
wbBrowser.Navigate('about:blank');
Doc := wbBrowser.Document;
Doc.Clear;
Doc.Write(HTMLCode);
Doc.Close;
end;
回答2:
your Qustions:
First, when I insert links (...) into the HTML code, the browser will alter the code, appending 'about:' in front of my URLs.
Second: it is slower than the first procedure (the one with temp file).
Can I load HTML code in browser without navigating first to 'about:blank'?
Answers:
- Yes it's possible without change to the link !
- No, it is not slower !
- Yes,it is possible, no need to Navigate first to about:blank
We start with code and the first procedure (only to show where the about: ...) comes from.
{$R *.DFM}
var
Doc: IHTMLDocument2;
TempFile: string;
xBody : IHTMLElement;
xLoaded : Boolean;
onlyOnce: Boolean;
procedure TForm1.WB_LoadHTML(HTMLCode: string);
var
sl: TStringList;
ms: TMemoryStream;
begin
xLoaded := False;
WebBrowser.Navigate('about:blank');
while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
Application.ProcessMessages;
if Assigned(WebBrowser.Document) then
begin
sl := TStringList.Create;
try
ms := TMemoryStream.Create;
try
sl.Text := HTMLCode;
sl.SaveToStream(ms);
ms.Seek(0, 0);
(WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));
finally
ms.Free;
end;
finally
sl.Free;
Doc := WebBrowser.Document as IHTMLDocument2;
end;
end;
end;
procedure TForm1.LoadHTMLBtnClick(Sender: TObject);
begin
WB_LoadHTML(Memo1.Text);
end;
procedure TForm1.LoadFileBtnClick(Sender: TObject);
begin
Memo1.Lines.LoadFromFile('G:\Programme\Apache Group\Apache\htdocs\bearbeiten1.html');
end;
We have created 2 files (are identical) only script differs to get an alert at load.
bearbeiten1.html
<script type="text/javascript">
alert ("bearbeiten1.html");
</script>
bearbeiten3.html
<script type="text/javascript">
alert ("bearbeiten3.html");
</script>
With click on Load File we load the "bearbeiten1.html" file
and with WB_LoadHTML we load it into Memory.
we get URL : about:blank
and the alert
now we create a link:
we select the blue part and click createlink
The link is created
and also the new "Doc.body.innerHTML"
procedure TForm1.createlinkBtnClick(Sender: TObject);
begin
Doc.execCommand('createlink', false,'bearbeiten3.html');
Memo1.Text := Doc.body.innerHTML;
end;
So far so good ! But will it work...? No
After a click on the link all we get is a blank site with URL:
Now we try the new EditText() code
procedure TForm1.EditText(CONST HTMLPath: string);
begin
TempFile := HTMLPath;
xLoaded := False;
WebBrowser.Navigate(TempFile);
Doc := WebBrowser.Document as IHTMLDocument2;
if Doc <> nil then xLoaded := True;
end;
procedure TForm1.EditTextBtnClick(Sender: TObject);
begin
EditText('G:\Programme\Apache Group\Apache\htdocs\bearbeiten1.html');
end;
With click on Load File we load the "bearbeiten1.html" file again and with EditTextBtnClick we load it direct. Looks much better! Will it work ...?
Let's click the link ! We get the alert !! from Nr. ...3.html"
and the .html file is loaded without problem.
To your other problem
if Doc <> NIL
then Doc.Body.SetAttribute('contentEditable', 'true', 0);
//crash here when I load complex html files
You did it at the wrong place the body is only available after the site is loaded !!
So I put it in the event WebBrowserNavigateComplete2
Only a fast solution can be improved
procedure TForm1.WebBrowserNavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if xLoaded = True then begin
xBody := Doc.Get_body;
if xBody <> nil then begin
xBody.SetAttribute('contentEditable', 'true', 0);
Memo1.Text := Doc.body.innerHTML;
xLoaded := False;
end;
end;
label2.Caption := URL;
end;
The complete code.
type
TForm1 = class(TForm)
WebBrowser: TWebBrowser;
Label1: TLabel;
Label2: TLabel;
Memo1: TMemo;
LoadHTMLBtn: TButton;
LoadFileBtn: TButton;
EditTextBtn: TButton;
createlinkBtn: TButton;
innerHTMLBtn: TButton;
procedure LoadHTMLBtnClick(Sender: TObject);
procedure LoadFileBtnClick(Sender: TObject);
procedure EditTextBtnClick(Sender: TObject);
procedure createlinkBtnClick(Sender: TObject);
procedure WebBrowserNavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure innerHTMLBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure WB_LoadHTML(HTMLCode: string);
procedure EditText(CONST HTMLPath: string);
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
Doc: IHTMLDocument2;
TempFile: string;
xBody : IHTMLElement;
xLoaded : Boolean;
onlyOnce: Boolean;
procedure TForm1.WB_LoadHTML(HTMLCode: string);
var
sl: TStringList;
ms: TMemoryStream;
begin
xLoaded := False;
WebBrowser.Navigate('about:blank');
while WebBrowser.ReadyState < READYSTATE_INTERACTIVE do
Application.ProcessMessages;
if Assigned(WebBrowser.Document) then
begin
sl := TStringList.Create;
try
ms := TMemoryStream.Create;
try
sl.Text := HTMLCode;
sl.SaveToStream(ms);
ms.Seek(0, 0);
(WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));
finally
ms.Free;
end;
finally
sl.Free;
Doc := WebBrowser.Document as IHTMLDocument2;
end;
end;
end;
procedure TForm1.LoadHTMLBtnClick(Sender: TObject);
begin
WB_LoadHTML(Memo1.Text);
end;
procedure TForm1.LoadFileBtnClick(Sender: TObject);
begin
Memo1.Lines.LoadFromFile('G:\Programme\Apache Group\Apache\htdocs\bearbeiten1.html');
end;
procedure TForm1.EditText(CONST HTMLPath: string);
begin
TempFile := HTMLPath;
xLoaded := False;
WebBrowser.Navigate(TempFile);
if onlyOnce then WebBrowser.Navigate(TempFile);
onlyOnce := False;
Doc := WebBrowser.Document as IHTMLDocument2;
if Doc <> nil then xLoaded := True;
end;
procedure TForm1.EditTextBtnClick(Sender: TObject);
begin
EditText('G:\Programme\Apache Group\Apache\htdocs\bearbeiten1.html');
end;
procedure TForm1.createlinkBtnClick(Sender: TObject);
begin
Doc.execCommand('createlink', false,'bearbeiten3.html');
Memo1.Text := Doc.body.innerHTML;
end;
procedure TForm1.WebBrowserNavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
if xLoaded then begin
xBody := Doc.Get_body;
if xBody <> nil then begin
xBody.SetAttribute('contentEditable', 'true', 0);
Memo1.Text := Doc.body.innerHTML;
xLoaded := False;
end;
end;
label2.Caption := URL;
end;
procedure TForm1.innerHTMLBtnClick(Sender: TObject);
begin
Memo1.Text := Doc.body.innerHTML;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
onlyOnce := True;
end;
end.
UPDATE:
I forgot to set the Tempfile Path in the code (copy paste error).
Also FormCreate added.
and only one time load the TempFile twice! (see code)
Important in the head tag of the TempFile must be a link
bearbeiten1.html same as bearbeiten3.html only alert ("bearbeiten3.html");
must be adapted !!
bearbeiten1.html
<head>
<link href="file:///G:\Programme\Apache Group\Apache\htdocs\maor.css" rel="stylesheet" media="screen">
</head>
<body leftmargin="0" marginheight="0" marginwidth="0" topmargin="0" bgcolor="#1F2E53">
<script type="text/javascript">
alert ("bearbeiten1.html");
</script>
<table width="100%" border="0" cellspacing="0" cellpadding="0" >
<tr height="211">
<td width="2%" height="211"></td>
<td valign="top" width="36%" height="211">
<table width="448" border="0" cellspacing="0" cellpadding="0">
<tr height="21">
<td width="8" height="21"></td>
<td class="FormControlrechts" width="150" height="21"></td>
<td width="23" height="21"></td>
<td class="FormControl" width="213" height="21">
<p unselectable="on">Select any portion of the following blue text</p>
<p id="p1" style="color= #3366CC">My favorite Web site. Don't forget to click the button! createlink</p>
</td>
</tr>
</table>
</table>
</body>
maor.css
body {}
p {}
td {}
h1 { color: #f5c391; font-weight: normal; font-size: 20px; font-family: verdana, serif; margin-bottom: 0.2em }
h2 { color: #eaeaea; font-weight: normal; font-size: 16px; margin-top: 0; margin-bottom: 0 }
form { margin-top: 0px }
a:link { font-weight:bold; color:#36f; text-decoration:none; }
a:visited { font-weight:bold; color:silver; text-decoration:none; }
a:focus { font-weight:bold; color:#d4d4d4; text-decoration:underline; }
a:hover { font-weight:bold; color:#c0c0c0; text-decoration:none; }
a:active { font-weight:bold; color:lime; text-decoration:underline; }
textarea, input { font-size: 8pt }
select, option { font-size: 9pt }
td { color: #333; font-size: 9pt; font-family: verdana, sans-serif }
td.FormControl { color: #ffe78b; font-size: small; padding-top: 5px; padding-bottom: 5px; border-right: 1px solid #5dafb0; border-bottom: 1px solid #5dafb0 }
td.FormControlrechts { color: #a88664; font-size: 8pt; text-align: right; padding-top: 5px; padding-bottom: 5px; border-top: #5dafb0; border-right: #5dafb0; border-bottom: 1px solid #5dafb0; border-left: #5dafb0 }
.class { }
回答3:
The simplest way to display HTML code in Delphi:
WebBrowser1.Navigate('about:'+yourHTMLcode);
来源:https://stackoverflow.com/questions/39773033/which-is-the-best-way-to-load-a-string-html-code-in-twebbrowser