Mahnazmezon

Obtenez l'URL d'un lien hypertexte lorsque la souris se déplace sur un document TWebBrowser

Science
Share

Le composant TWebBrowser Delphi permet d'accéder à la fonctionnalité du navigateur Web à partir de vos applications Delphi.

Dans la plupart des situations, vous utilisez TWebBrowser pour afficher des documents HTML à l'utilisateur, créant ainsi votre propre version du navigateur Web (Internet Explorer). Notez que TWebBrowser peut également afficher des documents Word, par exemple.

Une fonctionnalité très intéressante d'un navigateur est d'afficher des informations de lien, par exemple, dans la barre d'état, lorsque la souris survole un lien dans un document.

TWebBrowser n'expose pas un événement comme "OnMouseMove". Même si un tel événement existait, il serait déclenché pour le composant TWebBrowser - PAS pour le document affiché dans TWebBrowser.

Afin de fournir ces informations (et bien plus, comme vous le verrez dans un instant) dans votre application Delphi en utilisant le composant TWebBrowser, une technique appelée "événements qui coulent"doit être implémenté.

Récepteur d'événements WebBrowser

Pour accéder à une page Web à l'aide du composant TWebBrowser, vous appelez le Naviguer méthode. le Document La propriété de TWebBrowser renvoie un IHTMLDocument2 valeur (pour les documents Web). Cette interface est utilisée pour récupérer des informations sur un document, pour examiner et modifier les éléments HTML et le texte dans le document, et pour traiter les événements associés.

Pour obtenir l'attribut "href" (lien) d'une balise "a" à l'intérieur d'un document, pendant que la souris survole un document, vous devez réagir sur l'événement "onmousemove" de IHTMLDocument2.

Voici les étapes pour collecter les événements du document actuellement chargé:

  1. Plongez les événements du contrôle WebBrowser dans le DocumentComplete événement déclenché par le TWebBrowser. Cet événement est déclenché lorsque le document est entièrement chargé dans le navigateur Web.
  2. Dans DocumentComplete, récupérez l'objet document WebBrowser et déposez l'interface HtmlDocumentEvents.
  3. Gérez l'événement qui vous intéresse.
  4. Vider l'évier à l'intérieur BeforeNavigate2 - c'est lorsque le nouveau document est chargé dans le navigateur Web.

Document HTML OnMouseMove

Puisque nous nous intéressons à l'attribut HREF d'un élément A - afin d'afficher l'URL d'un lien sur lequel la souris est passée, nous coulerons l'événement "onmousemove".

La procédure pour obtenir la balise (et ses attributs) "sous" la souris peut être définie comme:

 var   htmlDoc: IHTMLDocument2;… procédure TForm1.Document_OnMouseOver; var    élément: IHTMLElement; commencer    si htmlDoc = néant ensuite Sortie; élément: = htmlDoc.parentWindow.event.srcElement; elementInfo.Clear;    si LowerCase (element.tagName) = 'a' puis    commencer      ShowMessage ('Link, HREF:' + element.getAttribute ('href', 0)]);    fin    autre si LowerCase (element.tagName) = 'img' ensuite    commencer      ShowMessage ('IMAGE, SRC:' + element.getAttribute ('src', 0)]);    fin    autre    commencer      elementInfo.Lines.Add (Format ('TAG:% s', [element.tagName]));    fin; fin; (* Document_OnMouseOver *)

Comme expliqué ci-dessus, nous nous attachons à l'événement onmousemove d'un document dans l'événement OnDocumentComplete d'un TWebBrowser:

 procédure TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); commencer    si Attribué (WebBrowser1.Document) ensuite    commencer      htmlDoc: = WebBrowser1.Document comme IHTMLDocument2; htmlDoc.onmouseover: = (TEventObject.Create (Document_OnMouseOver) comme IDispatch);    fin; fin; (* WebBrowser1DocumentComplete *)

Et c'est là que se posent les problèmes! Comme vous pouvez le deviner, l'événement "onmousemove" n'est * pas * un événement habituel - tout comme ceux avec lesquels nous avons l'habitude de travailler dans Delphi.

Le "onmousemove" attend un pointeur sur une variable de type VARIANT de type VT_DISPATCH qui reçoit l'interface IDispatch d'un objet avec une méthode par défaut qui est invoquée lorsque l'événement se produit.

Pour attacher une procédure Delphi à "onmousemove", vous devez créer un wrapper qui implémente IDispatch et déclenche votre événement dans sa méthode Invoke.

Voici l'interface TEventObject:

 TEventObject = classe(TInterfacedObject, IDispatch) privé    FOnEvent: TObjectProcedure; protégé    une fonction GetTypeInfoCount (en dehors Nombre: Entier): HResult; stdcall;    une fonction GetTypeInfo (Index, LocaleID: Integer; en dehors TypeInfo): HResult; stdcall;    une fonction GetIDsOfNames (const IID: TGUID; Noms: pointeur; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;    une fonction Invoke (DispID: Integer; const IID: TGUID; LocaleID: Entier; Drapeaux: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; Publique    constructeur Créer(const OnEvent: TObjectProcedure);    propriété OnEvent: TObjectProcedure lis FOnEvent écrire FOnEvent;    fin;

Voici comment implémenter le transfert d'événements pour un document affiché par le composant TWebBrowser - et obtenir les informations d'un élément HTML sous la souris.

Exemple de transfert d'événement de document TWebBrowser

Télécharger

Déposez un TWebBrowser ("WebBrowser1") sur un formulaire ("Form1"). Ajouter un TMemo ("elementInfo")…

unité Unité 1;
interface
les usages
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogues, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
type
   TObjectProcedure = procédure de objet;
   TEventObject = classe(TInterfacedObject, IDispatch)
   privé
     FOnEvent: TObjectProcedure;
   protégé
     une fonction GetTypeInfoCount (sur Count: Integer): HResult; stdcall;
     une fonction GetTypeInfo (Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
     une fonction GetIDsOfNames (const IID: TGUID; Noms: pointeur; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
     une fonction Invoke (DispID: Integer; const IID: TGUID; LocaleID: Entier; Drapeaux: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
   Publique
     constructeur Créer(const OnEvent: TObjectProcedure);
     propriété OnEvent: TObjectProcedure lire FOnEvent écrire FOnEvent;
   fin;
   TForm1 = classe(TForm)
     WebBrowser1: TWebBrowser;
     elementInfo: TMemo;
     procédure WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, drapeaux, TargetFrameName, PostData, en-têtes: OleVariant; var Annuler: WordBool);
     procédure WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
     procédure FormCreate (expéditeur: TObject);
   privé
     procédure Document_OnMouseOver;
   Publique
     Publique déclarations
   fin;
var
   Form1: TForm1;
   htmlDoc: IHTMLDocument2;
la mise en oeuvre
$ R * .dfm
procédure TForm1.Document_OnMouseOver;
var
   élément: IHTMLElement;
commencer
   si htmlDoc = néant ensuite Sortie;
   élément: = htmlDoc.parentWindow.event.srcElement;
   elementInfo.Clear;
   si LowerCase (element.tagName) = 'a' ensuite
   commencer
     elementInfo.Lines.Add ('LINK info…');
     elementInfo.Lines.Add (Format ('HREF:% s', [element.getAttribute ('href', 0)]));
   fin
   autre si LowerCase (element.tagName) = 'img' ensuite
   commencer
     elementInfo.Lines.Add ('IMAGE info…');
     elementInfo.Lines.Add (Format ('SRC:% s', [element.getAttribute ('src', 0)])));
   fin
   autre
   commencer
     elementInfo.Lines.Add (Format ('TAG:% s', [element.tagName]));
   fin;
fin; (* Document_OnMouseOver *)
procédure TForm1.FormCreate (expéditeur: TObject);
commencer
   WebBrowser1.Navigate ('http://delphi.about.com');
   elementInfo.Clear;
   elementInfo.Lines.Add ('Déplacez votre souris sur le document ...');
fin; (* FormCreate *)
procédure TForm1.WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, drapeaux, TargetFrameName, PostData, en-têtes: OleVariant; var Annuler: WordBool);
commencer
   htmlDoc: = néant;
fin; (* WebBrowser1BeforeNavigate2 *)
procédure TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
commencer
   si Attribué (WebBrowser1.Document) ensuite
   commencer
     htmlDoc: = WebBrowser1.Document comme IHTMLDocument2;
     htmlDoc.onmouseover: = (TEventObject.Create (Document_OnMouseOver) comme IDispatch);
   fin;
fin; (* WebBrowser1DocumentComplete *)
TEventObject
constructeur TEventObject.Create (const OnEvent: TObjectProcedure);
commencer
   hérité Créer;
   FOnEvent: = OnEvent;
fin;
une fonction TEventObject.GetIDsOfNames (const IID: TGUID; Noms: pointeur; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
commencer
   Résultat: = E_NOTIMPL;
fin;
une fonction TEventObject.GetTypeInfo (Index, LocaleID: Integer; out TypeInfo): HResult;
commencer
   Résultat: = E_NOTIMPL;
fin;
une fonction TEventObject.GetTypeInfoCount (out Count: Integer): HResult;
commencer
   Résultat: = E_NOTIMPL;
fin;
une fonction TEventObject.Invoke (DispID: Integer; const IID: TGUID; LocaleID: Entier; Drapeaux: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
commencer
   si (DispID = DISPID_VALUE) ensuite
   commencer
     si Attribué (FOnEvent) ensuite FOnEvent;
     Résultat: = S_OK;
   fin
   autre Résultat: = E_NOTIMPL;
fin;
fin.

Science
×