Obtenga la URL de un hipervínculo cuando el mouse se mueva sobre un documento TWebBrowser

El componente TWebBrowser Delphi proporciona acceso a la funcionalidad del navegador web desde sus aplicaciones Delphi.

En la mayoría de las situaciones, utiliza TWebBrowser para mostrar documentos HTML al usuario, creando así su propia versión del navegador web (Internet Explorer). Tenga en cuenta que TWebBrowser también puede mostrar documentos de Word, por ejemplo.

Una característica muy agradable de un navegador es mostrar información de enlaces, por ejemplo, en la barra de estado, cuando el mouse se desplaza sobre un enlace en un documento.

El TWebBrowser no expone un evento como "OnMouseMove". Incluso si existiera dicho evento, se dispararía para el componente TWebBrowser, NO para el documento que se muestra dentro del TWebBrowser.

Para proporcionar dicha información (y mucho más, como verá en un momento) en su aplicación Delphi usando el componente TWebBrowser, una técnica llamada "eventos que se hunden"debe implementarse.

WebBrowser Event Sink

Para navegar a una página web utilizando el componente TWebBrowser, llame al Navegar método. los Documento propiedad del TWebBrowser devuelve un IHTMLDocument2 valor (para documentos web). Esta interfaz se utiliza para recuperar información sobre un documento, para examinar y modificar los elementos HTML y el texto dentro del documento, y para procesar eventos relacionados.

Para obtener el atributo "href" (enlace) de una etiqueta "a" dentro de un documento, mientras el mouse se desplaza sobre un documento, debe reaccionar ante el evento "onmousemove" del IHTMLDocument2.

Estos son los pasos para hundir eventos para el documento cargado actualmente:

  1. Hundir los eventos del control WebBrowser en el DocumentComplete evento generado por el TWebBrowser. Este evento se desencadena cuando el documento está completamente cargado en el navegador web.
  2. Dentro de DocumentComplete, recupere el objeto de documento del WebBrowser y hunda la interfaz HtmlDocumentEvents.
  3. Maneja el evento que te interesa.
  4. Limpia el lavabo en el BeforeNavigate2 - es cuando se carga el nuevo documento en el navegador web.

Documento HTML OnMouseMove

Como estamos interesados ​​en el atributo HREF de un elemento A, para mostrar la URL de un enlace que el mouse ha terminado, hundiremos el evento "onmousemove".

El procedimiento para obtener la etiqueta (y sus atributos) "debajo" del mouse se puede definir como:

 var   htmlDoc: IHTMLDocument2;… procedimiento TForm1.Document_OnMouseOver; var    elemento: IHTMLElement; empezar    Si htmlDoc = nulo luego Salida; elemento: = htmlDoc.parentWindow.event.srcElement; elementInfo.Clear;    Si LowerCase (element.tagName) = 'a' entonces    empezar      ShowMessage ('Enlace, HREF:' + element.getAttribute ('href', 0)]);    final    más Si LowerCase (element.tagName) = 'img' luego    empezar      ShowMessage ('IMAGEN, SRC:' + element.getAttribute ('src', 0)]);    final    más    empezar      elementInfo.Lines.Add (Format ('TAG:% s', [element.tagName]));    final; final; (* Document_OnMouseOver *) 

Como se explicó anteriormente, adjuntamos al evento onmousemove de un documento en el evento OnDocumentComplete de un TWebBrowser:

 procedimiento TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); empezar    Si Asignado (WebBrowser1.Document) luego    empezar      htmlDoc: = WebBrowser1.Document como IHTMLDocument2; htmlDoc.onmouseover: = (TEventObject.Create (Document_OnMouseOver) como IDispatch);    final; final; (* WebBrowser1DocumentComplete *) 

¡Y aquí es donde surgen los problemas! Como puede suponer, el evento "onmousemove" no es * un * evento habitual, como son aquellos con los que estamos acostumbrados a trabajar en Delphi.

"Onmousemove" espera un puntero a una variable de tipo VARIANT de tipo VT_DISPATCH que recibe la interfaz IDispatch de un objeto con un método predeterminado que se invoca cuando se produce el evento.

Para adjuntar un procedimiento Delphi a "onmousemove", debe crear un contenedor que implemente IDispatch y genere su evento en su método Invoke.

Aquí está la interfaz de TEventObject:

 TEventObject = clase(TInterfacedObject, IDispatch) privado    FOnEvent: TObjectProcedure; protegido    función GetTypeInfoCount (fuera Conteo: entero): HResult; stdcall;    función GetTypeInfo (Index, LocaleID: Integer; fuera TypeInfo): HResult; stdcall;    función GetIDsOfNames (const IID: TGUID; Nombres: puntero; NameCount, LocaleID: Integer; DispIDs: puntero): HResult; stdcall;    función Invocar (DispID: Integer; const IID: TGUID; LocaleID: entero; Banderas: Palabra; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; público    constructor Crear(const OnEvent: TObjectProcedure);    propiedad OnEvent: TObjectProcedure leer Evento escribir Cuarto evento;    final; 

Aquí se explica cómo implementar el hundimiento de eventos para un documento mostrado por el componente TWebBrowser y obtener la información de un elemento HTML debajo del mouse.

Ejemplo de hundimiento de evento de documento TWebBrowser

Descargar

Coloque un TWebBrowser ("WebBrowser1") en un formulario ("Form1"). Agregue un TMemo ("elementInfo") ...

unidad Unidad 1;
interfaz
usos
   Windows, Mensajes, SysUtils, Variantes, Clases, Gráficos, Controles, Formularios,
   Diálogos, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
tipo
   TObjectProcedure = procedimiento de objeto;
   TEventObject = clase(TInterfacedObject, IDispatch)
   privado
     FOnEvent: TObjectProcedure;
   protegido
     función GetTypeInfoCount (recuento: entero): HResult; stdcall;
     función GetTypeInfo (Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
     función GetIDsOfNames (const IID: TGUID; Nombres: puntero; NameCount, LocaleID: Integer; DispIDs: puntero): HResult; stdcall;
     función Invocar (DispID: Integer; const IID: TGUID; LocaleID: entero; Banderas: Palabra; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
   público
     constructor Crear(const OnEvent: TObjectProcedure);
     propiedad OnEvent: TObjectProcedure lee FOnEvent escribe FOnEvent;
   final;
   TForm1 = clase(TForm)
     WebBrowser1: TWebBrowser;
     elementInfo: TMemo;
     procedimiento WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, banderas, TargetFrameName, PostData, encabezados: OleVariant; var Cancelar: WordBool);
     procedimiento WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
     procedimiento FormCreate (remitente: TObject);
   privado
     procedimiento Document_OnMouseOver;
   público
     Público declaraciones
   final;
var
   Form1: TForm1;
   htmlDoc: IHTMLDocument2;
implementación
$ R * .dfm
procedimiento TForm1.Document_OnMouseOver;
var
   elemento: IHTMLElement;
empezar
   Si htmlDoc = nulo luego Salida;
   elemento: = htmlDoc.parentWindow.event.srcElement;
   elementInfo.Clear;
   Si LowerCase (element.tagName) = 'a' luego
   empezar
     elementInfo.Lines.Add ('LINK info ...');
     elementInfo.Lines.Add (Format ('HREF:% s', [element.getAttribute ('href', 0)]));
   final
   más Si LowerCase (element.tagName) = 'img' luego
   empezar
     elementInfo.Lines.Add ('IMAGEN info ...');
     elementInfo.Lines.Add (Format ('SRC:% s', [element.getAttribute ('src', 0)]));
   final
   más
   empezar
     elementInfo.Lines.Add (Format ('TAG:% s', [element.tagName]));
   final;
final; (* Document_OnMouseOver *)
procedimiento TForm1.FormCreate (Remitente: TObject);
empezar
   WebBrowser1.Navigate ('http://delphi.about.com');
   elementInfo.Clear;
   elementInfo.Lines.Add ('Mueva el mouse sobre el documento ...');
final; (* FormCreate *)
procedimiento TForm1.WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, banderas, TargetFrameName, PostData, encabezados: OleVariant; var Cancelar: WordBool);
empezar
   htmlDoc: = nulo;
final; (* WebBrowser1BeforeNavigate2 *)
procedimiento TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
empezar
   Si Asignado (WebBrowser1.Document) luego
   empezar
     htmlDoc: = WebBrowser1.Document como IHTMLDocument2;
     htmlDoc.onmouseover: = (TEventObject.Create (Document_OnMouseOver) como IDispatch);
   final;
final; (* WebBrowser1DocumentComplete *)
TEventObject
constructor TEventObject.Create (const OnEvent: TObjectProcedure);
empezar
   heredado Crear;
   FOnEvent: = OnEvent;
final;
función TEventObject.GetIDsOfNames (const IID: TGUID; Nombres: puntero; NameCount, LocaleID: Integer; DispIDs: puntero): HResult;
empezar
   Resultado: = E_NOTIMPL;
final;
función TEventObject.GetTypeInfo (Index, LocaleID: Integer; out TypeInfo): HResult;
empezar
   Resultado: = E_NOTIMPL;
final;
función TEventObject.GetTypeInfoCount (Out Count: Integer): HResult;
empezar
   Resultado: = E_NOTIMPL;
final;
función TEventObject.Invoke (DispID: Integer; const IID: TGUID; LocaleID: entero; Banderas: Palabra; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
empezar
   Si (DispID = DISPID_VALUE) luego
   empezar
     Si Asignado (FOnEvent) luego Cuarto evento;
     Resultado: = S_OK;
   final
   más Resultado: = E_NOTIMPL;
final;
final.