Obtenez l'URL d'un lien hypertexte dans un document TWebBrowser

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 mis en œuvre.

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

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 à l'événement "onmousemove" de IHTMLDocument2.

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 se trouve, nous allons couler l'événement "onmousemove".

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

unité Unité 1;
interface
les usages
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogues, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
type
TObjectProcedure = procéduredeobjet;
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éantensuite Sortie;
élément: = htmlDoc.parentWindow.event.srcElement;
elementInfo. Clair;
si LowerCase (element.tagName) = 'a' ensuite
commencer
elementInfo. Lignes. Add ('LINK info ...');
elementInfo. Lignes. Add (Format ('HREF:% s', [element.getAttribute ('href', 0)]));
fin
autresi LowerCase (element.tagName) = 'img' ensuite
commencer
elementInfo. Lignes. Add ('IMAGE info ...');
elementInfo. Lignes. Add (Format ('SRC:% s', [element.getAttribute ('src', 0)]));
fin
autre
commencer
elementInfo. Lignes. 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. Clair;
elementInfo. Lignes. Ajouter ('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. Créer (Document_OnMouseOver) comme IDispatch);
fin;
fin; (* WebBrowser1DocumentComplete *)
{TEventObject}
constructeur TEventObject. Créer(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 (sur 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.