Te enseñaremos a obtener la URL de un hipervínculo en un documento de TWebBrowser

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

 

En la mayoría de las situaciones usted utiliza el TWebBrowser para mostrar documentos HTML al usuario - creando así su propia versión del navegador Web (Internet Explorer). Tenga en cuenta que el 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 ratón pasa el ratón por encima de un enlace en un documento.

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

Para poder proporcionar tal información (y mucho más, como verás en un momento) en tu aplicación Delphi usando el componente TWebBrowser, se debe implementar una técnica llamada "hundimiento de eventos".

 

Navegador Web Event Sink

Para navegar a una página web utilizando el componente TWebBrowser, llame al método Navigate. La propiedad Document del TWebBrowser devuelve un valor IHTMLDocument2 (para documentos web). Esta interfaz se utiliza para recuperar información sobre un documento, 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 ratón pasa por encima de un documento, es necesario reaccionar ante el evento "onmousemove" del documento IHTMLDocument2.

 

Aquí están los pasos para hundir eventos para el documento actualmente cargado:

 

  1. Hunde los eventos del control WebBrowser en el evento DocumentComplete planteado por el TWebBrowser. Este evento se dispara cuando el documento está completamente cargado en el explorador web.
  2. Dentro de DocumentComplete, recupera el objeto de documento de WebBrowser y hunde la interfaz HtmlDocumentEvents.
  3. Gestione el evento que le interese.
  4. Limpie el sumidero en el BeforeNavigate2, es decir, cuando el nuevo documento se carga en el navegador web.

 

Documento HTML OnMouseMove

Dado que estamos interesados en el atributo HREF de un elemento A - para mostrar la URL de un enlace sobre el que se encuentra el ratón, hundiremos el evento "onmousemove".

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

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*)

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

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*)

 

Y aquí es donde surgen los problemas! Como puedes adivinar, el evento "onmousemove" no es *normal* - como los que estamos acostumbrados a trabajar en Delphi.

 

El "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 por defecto que se invoca cuando ocurre el evento.

Para adjuntar un procedimiento Delphi a "onmousemove" es necesario crear una envoltura que implemente IDispatch y levante su evento en su método Invoke.

 

Aquí está la interfaz TEventObject:

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;

 

He aquí 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 ratón.

Ejemplo de hundimiento de eventos de documentos de TWebBrowser

Download

Drop a TWebBrowser ("WebBrowser1") on a Form ("Form1"). Add a TMemo ("elementInfo")...

unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;

type
   TObjectProcedure = procedure of object;

   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;

   TForm1 = class(TForm)
     WebBrowser1: TWebBrowser;
     elementInfo: TMemo;
     procedure WebBrowser1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; varCancel: WordBool) ;
     procedure WebBrowser1DocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant) ;
     procedure FormCreate(Sender: TObject) ;
   private
     procedure Document_OnMouseOver;
   public
     { Public declarations }
   end;

var
   Form1: TForm1;

   htmlDoc : IHTMLDocument2;

implementation

{$R *.dfm}

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
     elementInfo.Lines.Add('LINK info...') ;
     elementInfo.Lines.Add(Format('HREF : %s',[element.getAttribute('href',0)])) ;
   end
   else if LowerCase(element.tagName) = 'img' then
   begin
     elementInfo.Lines.Add('IMAGE info...') ;
     elementInfo.Lines.Add(Format('SRC : %s',[element.getAttribute('src',0)])) ;
   end
   else
   begin
     elementInfo.Lines.Add(Format('TAG : %s',[element.tagName])) ;
   end;
end(*Document_OnMouseOver*)


procedure TForm1.FormCreate(Sender: TObject) ;
begin
   WebBrowser1.Navigate('http://delphi.about.com') ;

   elementInfo.Clear;
   elementInfo.Lines.Add('Move your mouse over the document...') ;
end(*FormCreate*)

procedure TForm1.WebBrowser1BeforeNavigate2(ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Headers: OleVariant; varCancel: WordBool) ;
begin
   htmlDoc := nil;
end; (*WebBrowser1BeforeNavigate2*)

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject; constpDisp: IDispatch; var URL: OleVariant) ;
begin
   if Assigned(WebBrowser1.Document) then
   begin
     htmlDoc := WebBrowser1.Document as IHTMLDocument2;

     htmlDoc.onmouseover := (TEventObject.Create(Document_OnMouseOver) asIDispatch) ;
   end;
end(*WebBrowser1DocumentComplete*)


{ TEventObject }

constructor TEventObject.Create(const OnEvent: TObjectProcedure) ;
begin
   inherited Create;
   FOnEvent := OnEvent;
end;

function TEventObject.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
begin
   Result := E_NOTIMPL;
end;

function TEventObject.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult;
begin
   Result := E_NOTIMPL;
end;

function TEventObject.GetTypeInfoCount(out Count: Integer): HResult;
begin
   Result := E_NOTIMPL;
end;

function TEventObject.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
   if (DispID = DISPID_VALUE) then
   begin
     if Assigned(FOnEvent) then FOnEvent;
     Result := S_OK;
   end
   else Result := E_NOTIMPL;
end;

end.

(0 votes)