Mahnazmezon

Obțineți URL-ul unui hyperlink atunci când mouse-ul se deplasează peste un document TWebBrowser

Ştiinţă
Share

Componenta TWebBrowser Delphi oferă acces la funcționalitatea browserului Web din aplicațiile dvs. Delphi.

În majoritatea situațiilor, utilizați TWebBrowser pentru a afișa documente HTML utilizatorului, creând astfel propria versiune a browserului Web (Internet Explorer). Rețineți că TWebBrowser poate afișa și documente Word, de exemplu.

O caracteristică foarte drăguță a unui browser este de a afișa informații despre link, de exemplu, în bara de stare, când mouse-ul trece peste o legătură într-un document.

TWebBrowser nu expune un eveniment de genul „OnMouseMove”. Chiar dacă un astfel de eveniment ar exista, acesta ar fi tras pentru componenta TWebBrowser - NU pentru documentul afișat în TWebBrowser.

Pentru a oferi astfel de informații (și multe altele, așa cum veți vedea într-un moment) în aplicația dvs. Delphi folosind componenta TWebBrowser, o tehnică numită "evenimentele se scufundă"trebuie implementat.

WebBrowser Event Sink

Pentru a naviga către o pagină web folosind componenta TWebBrowser la care suni Navigați metodă. Document proprietatea TWebBrowser returnează an IHTMLDocument2 valoare (pentru documente web). Această interfață este utilizată pentru a prelua informații despre un document, pentru a examina și modifica elementele HTML și textul din document și pentru a procesa evenimente conexe.

Pentru a obține atributul (link) al unei etichete „a” în interiorul unui document, în timp ce mouse-ul trece peste un document, trebuie să reacționați la evenimentul „onmousemove” al IHTMLDocument2.

Iată pașii pentru scufundarea evenimentelor pentru documentul încărcat în prezent:

  1. Scufundați evenimentele controlului WebBrowser în DocumentComplete eveniment ridicat de TWebBrowser. Acest eveniment este declanșat atunci când documentul este complet încărcat în browserul Web.
  2. În DocumentComplete, regăsiți obiectul document WebBrowser și scufundați interfața HtmlDocumentEvents.
  3. Gestionează evenimentul de care te interesează.
  4. Ștergeți chiuveta din interior BeforeNavigate2 - atunci când noul document este încărcat în browserul Web.

Document HTML OnMouseMove

Întrucât ne interesează atributul HREF al unui element A - pentru a arăta adresa URL a unei legături, mouse-ul este terminat, vom scufunda evenimentul „onmousemove”.

Procedura pentru a obține eticheta (și atributele ei) „de mai jos” a mouse-ului poate fi definită ca:

 var   htmlDoc: IHTMLDocument2; ... procedură TForm1.Document_OnMouseOver; var    element: IHTMLElement; începe    dacă htmlDoc = zero apoi Ieșire; element: = htmlDoc.parentWindow.event.srcElement; elementInfo.Clear;    dacă LowerCase (element.tagName) = 'a' atunci    începe      ShowMessage ('Link, HREF:' + element.getAttribute ('href', 0)]);    Sfârșit    altfel dacă LowerCase (element.tagName) = 'img' apoi    începe      ShowMessage ('IMAGE, SRC:' + element.getAttribute ('src', 0)]);    Sfârșit    altfel    începe      elementInfo.Lines.Add (Format ('TAG:% s', [element.tagName]));    Sfârșit; Sfârșit; (* Document_OnMouseOver *)

După cum am explicat mai sus, ne atașăm la evenimentul onmousemove al unui document din evenimentul OnDocumentComplete al unui TWebBrowser:

 procedură TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); începe    dacă Atribuit (WebBrowser1.Document) apoi    începe      htmlDoc: = WebBrowser1.Document la fel de IHTMLDocument2; htmlDoc.onmouseover: = (TEventObject.Create (Document_OnMouseOver) la fel de IDispatch);    Sfârșit; Sfârșit; (* WebBrowser1DocumentComplete *)

Și aici apar problemele! După cum s-ar putea ghici evenimentul „onmousemove” nu este * un * eveniment obișnuit - așa cum sunt cei cu care suntem obișnuiți să lucrăm în Delphi.

„Onmousemove” se așteaptă la un indicator la o variabilă de tip VARIANT de tip VT_DISPATCH care primește interfața IDispatch a unui obiect cu o metodă implicită care este invocată atunci când are loc evenimentul.

Pentru a atașa o procedură Delphi la „onmousemove”, trebuie să creați un înveliș care să implementeze IDispatch și să ridice evenimentul dvs. în metoda Invoke.

Iată interfața TEventObject:

 TEventObject = clasă(TInterfacedObject, IDispatch) privat    FOnEvent: TObjectProcedure; protejat    funcţie GetTypeInfoCount (afară Count: Integer): HResult; stdcall;    funcţie GetTypeInfo (Index, LocaleID: Integer; afară TypeInfo): HResult; stdcall;    funcţie GetIDsOfNames (const IID: TGUID; Nume: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;    funcţie Invoca (DispID: Integer; const IID: TGUID; LocaleID: Integer; Steaguri: Cuvânt; var params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; public    constructor Crea(const OnEvent: TObjectProcedure);    proprietate OnEvent: TObjectProcedure citit FOnEvent scrie FOnEvent;    Sfârșit;

Iată cum să implementați scufundarea de evenimente pentru un document afișat de componenta TWebBrowser - și obțineți informațiile unui element HTML sub mouse.

Exemplu de scufundare la evenimentul TWebBrowser

Descarca

Aruncați un TWebBrowser („WebBrowser1”) pe un formular („Form1”). Adăugați un TMemo („elementInfo”)…

unitate Unitatea 1;
interfață
utilizări
   Windows, mesaje, SysUtils, variante, clase, grafică, controale, formulare,
   Dialoguri, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
tip
   TObjectProcedure = procedură de obiect;
   TEventObject = clasă(TInterfacedObject, IDispatch)
   privat
     FOnEvent: TObjectProcedure;
   protejat
     funcţie GetTypeInfoCount (contorizare: Integer): HResult; stdcall;
     funcţie GetTypeInfo (Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
     funcţie GetIDsOfNames (const IID: TGUID; Nume: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
     funcţie Invoca (DispID: Integer; const IID: TGUID; LocaleID: Integer; Steaguri: Cuvânt; var params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
   public
     constructor Crea(const OnEvent: TObjectProcedure);
     proprietate OnEvent: TObjectProcedure citeste FOnEvent scrie FOnEvent;
   Sfârșit;
   TForm1 = clasă(TForm)
     WebBrowser1: TWebBrowser;
     elementInfo: TMemo;
     procedură WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, Steaguri, TargetFrameName, PostData, Anteturi: OleVariant; var Anulați: WordBool);
     procedură WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
     procedură FormCreate (Expeditor: TObject);
   privat
     procedură Document_OnMouseOver;
   public
     Public declarații
   Sfârșit;
var
   Form1: TForm1;
   htmlDoc: IHTMLDocument2;
punerea în aplicare
$ R * .dfm
procedură TForm1.Document_OnMouseOver;
var
   element: IHTMLElement;
începe
   dacă htmlDoc = zero apoi Ieșire;
   element: = htmlDoc.parentWindow.event.srcElement;
   elementInfo.Clear;
   dacă LowerCase (element.tagName) = 'a' apoi
   începe
     elementInfo.Lines.Add ('INFORMAȚII LINK ...');
     elementInfo.Lines.Add (Format ('HREF:% s', [element.getAttribute ('href', 0)]));
   Sfârșit
   altfel dacă LowerCase (element.tagName) = 'img' apoi
   începe
     elementInfo.Lines.Add ('INFORMAȚII IMAGINE ...');
     elementInfo.Lines.Add (Format ('SRC:% s', [element.getAttribute ('src', 0)]));
   Sfârșit
   altfel
   începe
     elementInfo.Lines.Add (Format ('TAG:% s', [element.tagName]));
   Sfârșit;
Sfârșit; (* Document_OnMouseOver *)
procedură TForm1.FormCreate (Expeditor: TObject);
începe
   WebBrowser1.Navigate („http://delphi.about.com”);
   elementInfo.Clear;
   elementInfo.Lines.Add ('Mutați mouse-ul peste document ...');
Sfârșit; (* FormCreate *)
procedură TForm1.WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, Steaguri, TargetFrameName, PostData, Anteturi: OleVariant; var Anulați: WordBool);
începe
   htmlDoc: = zero;
Sfârșit; (* WebBrowser1BeforeNavigate2 *)
procedură TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
începe
   dacă Atribuit (WebBrowser1.Document) apoi
   începe
     htmlDoc: = WebBrowser1.Document la fel de IHTMLDocument2;
     htmlDoc.onmouseover: = (TEventObject.Create (Document_OnMouseOver) la fel de IDispatch);
   Sfârșit;
Sfârșit; (* WebBrowser1DocumentComplete *)
TEventObject
constructor TEventObject.Create (const OnEvent: TObjectProcedure);
începe
   mostenit Crea;
   FOnEvent: = OnEvent;
Sfârșit;
funcţie TEventObject.GetIDsOfNames (const IID: TGUID; Nume: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
începe
   Rezultat: = E_NOTIMPL;
Sfârșit;
funcţie TEventObject.GetTypeInfo (Index, LocaleID: Integer; out TypeInfo): HResult;
începe
   Rezultat: = E_NOTIMPL;
Sfârșit;
funcţie TEventObject.GetTypeInfoCount (în afara numărului: număr întreg): HResult;
începe
   Rezultat: = E_NOTIMPL;
Sfârșit;
funcţie TEventObject.Invoke (DispID: Integer; const IID: TGUID; LocaleID: Integer; Steaguri: Cuvânt; var params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
începe
   dacă (DispID = DISPID_VALUE) apoi
   începe
     dacă Atribuit (FOnEvent) apoi FOnEvent;
     Rezultat: = S_OK;
   Sfârșit
   altfel Rezultat: = E_NOTIMPL;
Sfârșit;
Sfârșit.

Ştiinţă
×