几个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(
00);
  
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;



 



posted @ 2008-06-10 01:40  陆岛工作室  阅读(4249)  评论(1编辑  收藏  举报