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

        
        



        







        
          
            
            评论这张
          
        


          
            
              
            
            转发至微博