TWebBrowser Delphi组件提供了从Delphi应用程序访问Web浏览器功能的功能。

在大多数情况下，您使用TWebBrowser向用户显示HTML文档，从而创建您自己的（Internet Explorer）Web浏览器版本。请注意，TWebBrowser还可以显示Word文档，例如。

浏览器的一个非常好的功能是显示链接信息，例如，当鼠标悬停在文档中的链接上时，在状态栏中显示链接信息。

TWebBrowser不公开类似“OnMouseMove”的事件。即使存在这样的事件，它也会为TWebBrowser组件触发，而不是为TWebBrowser内部显示的文档触发。

为了在使用TWebBrowser组件的Delphi应用程序中提供此类信息（以及更多信息，稍后您将看到），必须实现一种称为“事件下沉”的技术。

webbrowser事件接收器

要使用TWebBrowser组件导航到网页，请调用navigate方法。TWebBrowser的Document属性返回一个IHTMLDocument2值（对于web文档）。此接口用于检索有关文档的信息，检查和修改文档中的HTML元素和文本，以及处理相关事件。

当鼠标悬停在文档上时，要获取文档中“a”标记的“href”属性（链接），需要对IHTMLDocument2的“onmousemove”事件做出反应。

以下是接收当前加载文档的事件的步骤：

1. 在TWebBrowser引发的DocumentComplete事件中接收WebBrowser控件的事件。将文档完全加载到Web浏览器时触发此事件。
2. 在DocumentComplete内部，检索WebBrowser的文档对象并接收HtmlDocumentEvents接口。
3. 处理你感兴趣的事件。
4. 清除BeforeNavigate2中的接收器-即在Web浏览器中加载新文档时。

MouseMove上的html文档

由于我们对A元素的HREF属性感兴趣-为了显示鼠标悬停的链接的URL，我们将接收“onmousemove”事件。

获取鼠标“下方”标记（及其属性）的过程可定义为：

var htmlDoc : IHTMLDocument2; ... procedure TForm1.Document_OnMouseOver; var element : IHTMLElement; begin if htmlDoc = nil then Exit; element := htmlDoc.parentWindow.event.srcElement; elementInfo.Clear; if LowerCase(element.tagName) = 'a' then begin ShowMessage('Link, HREF : ' + element.getAttribute('href',0)]) ; end else if LowerCase(element.tagName) = 'img' then begin ShowMessage('IMAGE, SRC : ' + element.getAttribute('src',0)]) ; end else begin elementInfo.Lines.Add(Format('TAG : %s',[element.tagName])) ; end; end; (*Document_OnMouseOver*)

如上所述，我们将以下内容附加到TWebBrowser的OnDocumentComplete事件中文档的onmousemove事件：

procedure TForm1.WebBrowser1DocumentComplete( ASender: TObject; const pDisp: IDispatch; var URL: OleVariant) ; begin if Assigned(WebBrowser1.Document) then begin htmlDoc := WebBrowser1.Document as IHTMLDocument2; htmlDoc.onmouseover := (TEventObject.Create(Document_OnMouseOver) as IDispatch) ; end; end; (*WebBrowser1DocumentComplete*)

这就是问题所在！正如您可能猜到的，“onmousemove”事件*不是*一个常见的事件-就像我们在Delphi中使用的那些事件一样。

“onmousemove”需要一个指向VT_DISPATCH类型VARIANT的变量的指针，该变量使用事件发生时调用的默认方法接收对象的IDispatch接口。

为了将Delphi过程附加到“onmousemove”，您需要创建一个包装器，该包装器实现IDispatch并在其Invoke方法中引发事件。

以下是TeventoObject接口：

TEventObject = class(TInterfacedObject, IDispatch) private FOnEvent: TObjectProcedure; protected function GetTypeInfoCount(out Count: Integer): HResult; stdcall; function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall; function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall; function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; public constructor Create(const OnEvent: TObjectProcedure) ; property OnEvent: TObjectProcedure read FOnEvent write FOnEvent; end;

下面介绍如何为TWebBrowser组件显示的文档实现事件下沉，并获取鼠标下方HTML元素的信息。

twebbrowser文档事件下沉示例

下载

在表单（“Form1”）上放置一个TWebBrowser（“WebBrowser1”）。添加TMemo（“elementInfo”）。。。

第一单元；界面使用窗口、消息、系统、变体、类、图形、控件、窗体、对话框、OLECTRL、SHDocVw、MSHTML、ActiveX、STDCTRL；类型TObjectProcedure=对象的过程；TEventObject=class（TInterfacedObject，IDispatch）private FOnEvent:TObjectProcedure；受保护的函数GetTypeInfoCount（out Count:Integer）：HResult；stdcall；函数GetTypeInfo（Index，LocaleID:Integer；out-TypeInfo）：HResult；stdcall；函数GetIDsOfNames（const IID:TGUID；name:Pointer；NameCount，LocaleID:Integer；DispIDs:Pointer）：HResult；stdcall；函数调用（DispID:Integer；const IID:TGUID；LocaleID:Integer；Flags:Word；var参数；VarResult、ExcepInfo、ArgErr:Pointer）：HResult；stdcall；公共构造函数创建（const-OnEvent:TObjectProcedure）；属性OnEvent:TObjectProcedure read FOnEvent write FOnEvent；终止TForm1=类别（TForm）WebBrowser1:TwebbBrowser；elementInfo:TMemo；过程WebBrowser1BeforeNavigate2（ASender:ToObject；const pDisp:IDispatch；变量URL、标志、TargetFrameName、PostData、标题：OleVariant；变量Cancel:WordBool）；过程WebBrowser1文档完成（ASender:TObject；const-pDisp:IDispatch；var-URL:OleVariant）；过程表单创建（发送方：ToObject）；私人程序文件；公开{公开声明}结束；var Form1:TForm1；htmlDoc:IHTMLDocument2；实施{$R*.dfm}程序TForm1.Document_OnMouseOver；var元素：IHTMLElement；如果htmlDoc=nil，则开始，然后退出；元素：=htmlDoc.parentWindow.event.srcElement；elementInfo.Clear；如果小写（element.tagName）=“a”，则开始elementInfo.Lines.Add（'LINK info…'）；elementInfo.Lines.Add（格式（'HREF:%s'，[element.getAttribute（'HREF'，0）]）；如果小写（element.tagName）=“img”，则结束else，然后开始elementInfo.Lines.Add（'IMAGE info…'）；elementInfo.Lines.Add（格式（'SRC:%s'，[element.getAttribute（'SRC'，0）]）；end else begin elementInfo.Lines.Add（格式（'TAG:%s'，[element.tagName]）；终止终止（*Document_OnMouseOver*）程序TForm1.FormCreate（发送方：TObject）；开始WebBrowser1。导航（'http://delphi.about.com') ; elementInfo.Clear；elementInfo.Lines.Add（'将鼠标移到文档上…'）；终止（*FormCreate*）过程TForm1.WebBrowser1BeforeNavigate2（ASender:TObject；const-pDisp:IDispatch；var-URL、标志、TargetFrameName、PostData、Headers:OleVariant；var-Cancel:WordBool）；开始htmlDoc:=nil；终止（*WebBrowser1BeforeNavigate2*）程序TForm1.WebBrowser1DocumentComplete（ASender:ToObject；const pDisp:IDispatch；var URL:OleVariant）；如果已分配，则开始（WebBrowser1.Document），然后开始htmlDoc:=WebBrowser1.Document作为IHTMLDocument2；htmlDoc.onmouseover:=（TEventObject.Create（Document_onmouseover）作为IDispatch）；终止终止（*WebBrowser1DocumentComplete*）{TEventObject}构造函数TEventObject.Create（const-OnEvent:TObjectProcedure）；开始创造；FOnEvent:=OnEvent；终止函数TEventObject.GetIDsOfNames（const IID:TGUID；name:Pointer；NameCount，LocaleID:Integer；DispIDs:Pointer）：HResult；开始结果：=E_NOTIMPL；终止函数TEventObject.GetTypeInfo（索引，LocaleID:Integer；out-TypeInfo）：HResult；开始结果：=E_NOTIMPL；终止函数TEventObject.GetTypeInfoCount（out Count:Integer）：HResult；开始结果：=E_NOTIMPL；终止函数TEventObject.Invoke（DispID:Integer；const IID:TGUID；LocaleID:Integer；Flags:Word；var参数；VarResult，ExcepInfo，ArgErr:Pointer）：HResult；如果开始（DispID=DispID_值），则开始（如果已分配）（FOnEvent），然后开始FOnEvent；结果：=S_正常；结束其他结果：=E_NOTIMPL；终止终止