幾個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;