Ottieni l'URL di un collegamento ipertestuale in un documento TWebBrowser

Nella maggior parte dei casi si utilizza TWebBrowser per visualizzare documenti HTML all'utente, creando così la propria versione del browser Web (Internet Explorer). Si noti che TWebBrowser può anche visualizzare documenti Word, ad esempio.

Una caratteristica molto utile di un browser è la visualizzazione delle informazioni sui collegamenti, ad esempio, nella barra di stato, quando il mouse passa sopra un collegamento in un documento.

TWebBrowser non espone un evento come "OnMouseMove". Anche se un evento del genere esistesse, verrebbe generato per il componente TWebBrowser, NON per il documento visualizzato all'interno di TWebBrowser.

Per fornire tali informazioni (e molto altro, come vedrai tra poco) nell'applicazione Delphi utilizzando il componente TWebBrowser, una tecnica chiamata "affondamento degli eventi"deve essere implementato.

Per accedere a una pagina Web utilizzando il componente TWebBrowser, si chiama Navigare metodo. Il Documento la proprietà di TWebBrowser restituisce un IHTMLDocument2

Per ottenere l'attributo "href" (link) di un tag "a" all'interno di un documento, mentre il mouse passa sopra un documento, è necessario reagire all'evento "onmousemove" di IHTMLDocument2.

Dato che siamo interessati all'attributo HREF di un elemento A - al fine di mostrare l'URL di un collegamento su cui si trova il mouse, affonderemo l'evento "onmousemove".

Come spiegato sopra, alleghiamo l'evento onmousemove di un documento nell'evento OnDocumentComplete di un TWebBrowser:

unità Unità 1;
interfaccia
usi
Windows, Messaggi, SysUtils, Varianti, Classi, Grafica, Controlli, Moduli,
Finestre di dialogo, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
genere
TObjectProcedure = proceduradioggetto;
TEventObject = classe(TInterfacedObject, IDispatch)
privato
FOnEvent: TObjectProcedure;
protetta
funzione GetTypeInfoCount (out Count: Integer): HResult; stdcall;
funzione GetTypeInfo (Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
funzione GetIDsOfNames (const IID: TGUID; Nomi: puntatore; NameCount, LocaleID: Integer; DispIDs: Puntatore): HResult; stdcall;
funzione Invoke (DispID: Integer; const IID: TGUID; LocaleID: intero; Bandiere: Word; var Parametri; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
pubblico
costruttore Creare(const OnEvent: TObjectProcedure);
proprietà OnEvent: TObjectProcedure leggi FOnEvent scrivi FOnEvent;
fine;
TForm1 = classe(TForm)
WebBrowser1: TWebBrowser;
elementInfo: TMemo;
procedura WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Header: OleVariant; var Annulla: WordBool);
procedura WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
procedura FormCreate (Mittente: TObject);
privato
procedura document_onmouseover;
pubblico
{ Pubblico dichiarazioni}
fine;
var
Form1: TForm1;
htmlDoc: IHTMLDocument2;
implementazione
{$ R * .dfm}
procedura TForm1.Document_OnMouseOver;
var
elemento: IHTMLElement;
inizio
Se htmlDoc = zeropoi Uscita;
element: = htmlDoc.parentWindow.event.srcElement;
elementInfo. Chiaro;
Se LowerCase (element.tagName) = 'a' poi
inizio
elementInfo. Linee. Aggiungi ('LINK info ...');
elementInfo. Linee. Aggiungi (formato ('HREF:% s', [element.getAttribute ('href', 0)]));
fine
altroSe LowerCase (element.tagName) = 'img' poi
inizio
elementInfo. Linee. Aggiungi ('Informazioni IMMAGINE ...');
elementInfo. Linee. Aggiungi (formato ('SRC:% s', [element.getAttribute ('src', 0)]));
fine
altro
inizio
elementInfo. Linee. Aggiungi (formato ('TAG:% s', [element.tagName]));
fine;
fine; (* Document_onmouseover *)
procedura TForm1.FormCreate (Mittente: TObject);
inizio
WebBrowser1.Navigate (' http://delphi.about.com') ;
elementInfo. Chiaro;
elementInfo. Linee. Aggiungi ('Sposta il mouse sul documento ...');
fine; (* FormCreate *)
procedura TForm1.WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Header: OleVariant; var Annulla: WordBool);
inizio
htmlDoc: = zero;
fine; (* WebBrowser1BeforeNavigate2 *)
procedura TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
inizio
Se Assegnato (WebBrowser1.Document) poi
inizio
htmlDoc: = WebBrowser1.Document come IHTMLDocument2;
htmlDoc.onmouseover: = (TEventObject. Crea (Document_OnMouseOver) come IDispatch);
fine;
fine; (* WebBrowser1DocumentComplete *)
{TEventObject}
costruttore TEventObject. Creare(const OnEvent: TObjectProcedure);
inizio
ereditato Creare;
FOnEvent: = OnEvent;
fine;
funzione TEventObject. GetIDsOfNames (const IID: TGUID; Nomi: puntatore; NameCount, LocaleID: Integer; DispIDs: Puntatore): HResult;
inizio
Risultato: = E_NOTIMPL;
fine;
funzione TEventObject. GetTypeInfo (Index, LocaleID: Integer; out TypeInfo): HResult;
inizio
Risultato: = E_NOTIMPL;
fine;
funzione TEventObject. GetTypeInfoCount (out Count: Integer): HResult;
inizio
Risultato: = E_NOTIMPL;
fine;
funzione TEventObject. Invoke (DispID: Integer; const IID: TGUID; LocaleID: intero; Bandiere: Word; var Parametri; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
inizio
Se (DispID = DISPID_VALUE) poi
inizio
Se Assegnato (FOnEvent) poi FOnEvent;
Risultato: = S_OK;
fine
altro Risultato: = E_NOTIMPL;
fine;
fine.