几个WebBrowser相关的函数--原创

作者: 陆岛工作室



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