几个WebBrowser相关的函数(转)

{  去掉 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 ;

转自: 陆鸟工作室(http://www.cnblogs.com/iinsnian/archive/2008/06/10/1216460.html)

转载于:https://www.cnblogs.com/Handll/archive/2010/01/15/1648795.html