为了实现在自己的程序中显示HTML文档,我们一般采用IE(Internet Explorer本文中简称为IE)发行时附带的一个ActiveX控件WebBrowser。这个控件使用和IE相同的内核,功能强大,并从Delphi5开始,正式得到Inprise公司的支持,取代了原来的那个THTML控件,成为Delphi中显示HTML文档的首选控件。
{ IPersistStream interface } {$EXTERNALSYM IPersistStream} IPersistStream = interface(IPersist) ['{00000109-0000-0000-C000-000000000046}'] function IsDirty: HResult; stdcall; // 最后一次存盘后是否被修改 function Load(const stm: IStream): HResult; stdcall; // 从流中载入 function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall; // 保存到流 function GetSizeMax(out cbSize: Largeint): HResult; stdcall; // 取得保存所需空间大小 end; { IPersistStreamInit interface } {$EXTERNALSYM IPersistStreamInit} IPersistStreamInit = interface(IPersistStream) ['{7FD52380-4E07-101B-AE2D-08002B2EC713}'] function InitNew: HResult; stdcall; // 初始化 end; |
procedure SetHtml(const WebBrowser: TWebBrowser; const Html: string); var Stream: IStream; hHTMLText: HGLOBAL; psi: IPersistStreamInit; begin if not Assigned(WebBrowser.Document) then Exit; hHTMLText := GlobalAlloc(GPTR, Length(Html) + 1); if 0 = hHTMLText then RaiseLastWin32Error; CopyMemory(Pointer(hHTMLText), PChar(Html), Length(Html)); OleCheck(CreateStreamOnHGlobal (hHTMLText, True, Stream)); try OleCheck(WebBrowser.Document. QueryInterface(IPersistStreamInit, psi)); try OleCheck(psi.InitNew); OleCheck(psi.Load(Stream)); finally psi := nil; end; finally Stream := nil; end; end; |
function GetHtml(const WebBrowser: TWebBrowser): string; const BufSize = $10000; var Size: Int64; Stream: IStream; hHTMLText: HGLOBAL; psi: IPersistStreamInit; begin if not Assigned(WebBrowser.Document) then Exit; OleCheck(WebBrowser.Document.QueryInterface (IPersistStreamInit, psi)); try //OleCheck(psi.GetSizeMax(Size)); hHTMLText := GlobalAlloc(GPTR, BufSize); if 0 = hHTMLText then RaiseLastWin32Error; OleCheck(CreateStreamOnHGlobal(hHTMLText, True, Stream)); try OleCheck(psi.Save(Stream, False)); Size := StrLen(PChar(hHTMLText)); SetLength(Result, Size); CopyMemory(PChar(Result), Pointer(hHTMLText), Size); finally Stream := nil; end; finally psi := nil; end; end; |
procedure ShowBlankPage(WebBrowser: TWebBrowser); var URL: OleVariant; begin URL := 'about:blank'; WebBrowser.Navigate2(URL); end; |