几个WebBrowser相关的函数


本文整理自网络,侵删。

 

TWebBrowser 编程相关的函数。


{ 去掉 TWebBrowser 的边框 }
procedure WB_Set3DBorderStyle(Sender: TWebBrowser; bValue: Boolean);

{ WebBrowser 从内存中读取 HTML 文件}
procedure WebBrowserLoadFromStream(WebBrowser: TWebBrowser; Stream: TStream);
procedure NavigateLoadFromStream(WebBrowser: TWebBrowser; Stream: TStream);

{ WebBrowser 从字符中读取 HTML 文件}
procedure WebBrowserLoadFromText(WebBrowser: TWebBrowser; HtmlText: String);


{ WebBrowser 保存成 Html 文件 }
function WebBrowserSaveHTMLCode(WebBrowser: TWebBrowser; const FileName: TFileName): Boolean;

{ HTML 保存成流 }
procedure SaveDocumentSourceToStream(Document: IDispatch; Stream: TStream);

uses Axctrls, ActiveX, MSHTML, OleCtrls, SHDocVw


{ WB_Set3DBorderStyle }

procedure WB_Set3DBorderStyle(Sender: TWebBrowser; bValue: Boolean);
var
Document: IHTMLDocument2;
Element: IHTMLElement;
StrBorderStyle: string;
begin
//去掉边框
try
Document := TWebBrowser(Sender).Document as IHTMLDocument2;
if Assigned(Document) then
begin
Element := Document.Body;
if Element <> nil then
begin
case BValue of
False: StrBorderStyle := 'none';
True: StrBorderStyle := '';
end;
Element.Style.BorderStyle := StrBorderStyle;
end;
end;
except
//..
end;
end;


{ WebBrowserLoadFromText }

procedure WebBrowserLoadFromText(WebBrowser: TWebBrowser; HtmlText: String);
var
v: Variant;
IDoc: IHTMLDocument2;
begin
WebBrowser.Navigate('about:blank');
repeat
Application.ProcessMessages;
Sleep(0);
until WebBrowser.ReadyState = READYSTATE_COMPLETE;

IDoc := WebBrowser.Document as IHTMLDocument2;
try
IDoc.designMode:='on';
while IDoc.readyState<>'complete' do
Application.ProcessMessages;
v:=VarArrayCreate([0,0],VarVariant);
v[0]:= HtmlText;
IDoc.write(PSafeArray(System.TVarData(v).VArray));
IDoc.designMode:='off';
while IDoc.readyState<>'complete' do
Application.ProcessMessages;
finally
IDoc := nil;
end;
end;

{ NavigateLoadFromStream }

procedure NavigateLoadFromStream(WebBrowser: TWebBrowser; Stream: TStream);
begin
Stream.Seek(0, 0);
if Assigned(WebBrowser.Document) then
(WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(Stream));
end;

{ WebBrowserLoadFromStream }

procedure WebBrowserLoadFromStream(WebBrowser: TWebBrowser; Stream: TStream);
begin
WebBrowser.Navigate('about:blank');

repeat
Application.ProcessMessages;
Sleep(0);
until WebBrowser.ReadyState = READYSTATE_COMPLETE;

NavigateLoadFromStream(WebBrowser, Stream);
end;

{ WebBrowserSaveHTMLCode }

function WebBrowserSaveHTMLCode(WebBrowser: TWebBrowser; const FileName: TFileName): Boolean;
var
ps: IPersistStreamInit;
fs: TFileStream;
sa: IStream;
begin
ps := WebBrowser.Document as IPersistStreamInit;
fs := TFileStream.Create(FileName, fmCreate);
try
sa := TStreamAdapter.Create(fs, soReference) as IStream;
Result := Succeeded(ps.Save(sa, True));
finally
fs.Free;
end;
end;


{ SaveDocumentSourceToStream }

procedure SaveDocumentSourceToStream(Document: IDispatch; Stream: TStream);
var
PersistStreamInit: IPersistStreamInit;
StreamAdapter: IStream;
begin
Stream.Size := 0;
Stream.Position := 0;
if Document.QueryInterface(IPersistStreamInit, PersistStreamInit) = S_OK then
begin
StreamAdapter := TStreamAdapter.Create(Stream, soReference);
PersistStreamInit.Save(StreamAdapter, False);
StreamAdapter := nil;
end;
end;

相关阅读 >>

Delphi exe文件自效验

Delphi 自我复制源码

Delphi创建证书密钥库文件

Delphi package

Delphi 简单判断程序30秒没有键盘和鼠标动作

Delphi cxgrid中回车键光标移到下列

Delphi获取当前计算机所有盘符

Delphi ifdef 另类用法

tstringgrid 添加鼠标拖动功能

Delphi 更改消息对话框中的按钮标题

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...