几个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;