Získajte webovú adresu hypertextového odkazu v dokumente TWebBrowser

Vo väčšine situácií použijete TWebBrowser na zobrazenie dokumentov HTML používateľovi, čím vytvoríte svoju vlastnú verziu webového prehľadávača (Internet Explorer). Upozorňujeme, že TWebBrowser môže napríklad zobrazovať napríklad aj dokumenty programu Word.

Veľmi príjemnou vlastnosťou prehliadača je zobrazenie informácií o prepojení, napríklad v stavovom riadku, keď myš prejde nad odkaz v dokumente.

TWebBrowser nevystavuje udalosť ako „OnMouseMove“. Aj keby takáto udalosť existovala, bola by spustená pre komponent TWebBrowser - NIE pre dokument zobrazený vo vnútri TWebBrowser.

S cieľom poskytnúť tieto informácie (a oveľa viac, ako uvidíte za chvíľu) vo vašej aplikácii Delphi pomocou komponentu TWebBrowser, technika nazývaná „udalosti klesajú„musí byť vykonaná.

Na navigáciu na webovú stránku pomocou komponentu TWebBrowser, ktorý voláte Navigácia metóda. dokument Vlastnosť TWebBrowser vracia IHTMLDocument2 hodnota (pre webové dokumenty). Toto rozhranie sa používa na získavanie informácií o dokumente, na preskúmanie a úpravu prvkov HTML a textu v dokumente a na spracovanie súvisiacich udalostí.

instagram viewer

Ak chcete do atribútu „href“ (link) značky „a“ ​​vložiť dokument, zatiaľ čo kurzor myši nad dokumentom, musíte reagovať na udalosť „onmousemove“ IHTMLDocument2.

Pretože nás zaujíma atribút HREF prvku A - aby sme ukázali URL odkazu, na ktorý myš skončila, ponoríme udalosť „onmousemove“.

Ako je vysvetlené vyššie, pripájame sa k jedinej udalosti dokumentu v udalosti OnDocumentComplete TWebBrowser:

jednotka Lekcia 1;
rozhranie
použitie
Windows, Správy, SysUtils, Varianty, Triedy, Grafika, Ovládacie prvky, Formuláre,
Dialógy, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
typ
TObjectProcedure = procedúrazobjekt;
TEventObject = trieda(TInterfacedObject, IDispatch)
súkromné
FOnEvent: TObjectProcedure;
chránený
funkcie GetTypeInfoCount (počet mimo: celé číslo): HResult; STDCALL;
funkcie GetTypeInfo (Index, LocaleID: Celé číslo; mimo TypeInfo): HResult; STDCALL;
funkcie GetIDsOfNames (const IID: TGUID; Mená: Ukazovateľ; NameCount, LocaleID: Celé číslo; DispID: Ukazovateľ): HResult; STDCALL;
funkcie Vyvolať (DispID: celé číslo; const IID: TGUID; LocaleID: Celé číslo; Vlajky: Slovo; var params; VarResult, ExcepInfo, ArgErr: Ukazovateľ): HResult; STDCALL;
verejnosť
staviteľ vytvorenie (const OnEvent: TObjectProcedure);
nehnuteľnosť OnEvent: TObjectProcedure prečítané FOnEvent write FOnEvent;
koniec;
TForm1 = trieda(TForm)
WebBrowser1: TWebBrowser;
elementInfo: TMemo;
procedúra WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, príznaky, TargetFrameName, PostData, hlavičky: OleVariant; var Zrušiť: WordBool);
procedúra WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
procedúra FormCreate (odosielateľ: TObject);
súkromné
procedúra Document_OnMouseOver;
verejnosť
{ verejnosť vyhlásenia}
koniec;
var
Forma 1: TForm1;
htmlDoc: IHTMLDocument2;
uskutočnenie
{$ R * .dfm}
procedúra TForm1.Document_OnMouseOver;
var
prvok: IHTMLElement;
začať
ak htmlDoc = nulapotom Východ;
element: = htmlDoc.parentWindow.event.srcElement;
elementInfo. Jasný;
ak LowerCase (element.tagName) = 'a' potom
začať
elementInfo. Linky. Pridať („LINK info ...“);
elementInfo. Linky. Pridať (formát ('HREF:% s', [element.getAttribute ('href', 0)])));
koniec
inakak LowerCase (element.tagName) = 'img' potom
začať
elementInfo. Linky. Pridať ('IMAGE info ...');
elementInfo. Linky. Pridať (formát („SRC:% s“, [element.getAttribute ('src', 0)]));
koniec
inak
začať
elementInfo. Linky. Pridať (formát ('TAG:% s', [element.tagName]));
koniec;
koniec; (* Document_OnMouseOver *)
procedúra TForm1.FormCreate (Sender: TObject);
začať
WebBrowser1.Navigate ( ' http://delphi.about.com') ;
elementInfo. Jasný;
elementInfo. Linky. Pridať ('Presuňte myš nad dokument ...');
koniec; (* FormCreate *)
procedúra TForm1.WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, príznaky, TargetFrameName, PostData, hlavičky: OleVariant; var Zrušiť: WordBool);
začať
htmlDoc: = nula;
koniec; (* WebBrowser1BeforeNavigate2 *)
procedúra TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
začať
ak Priradené (WebBrowser1.Document) potom
začať
htmlDoc: = WebBrowser1.Document ako IHTMLDocument2;
htmlDoc.onmouseover: = (TEventObject. Vytvoriť (Document_OnMouseOver) ako IDispatch);
koniec;
koniec; (* WebBrowser1DocumentComplete *)
{TEventObject}
staviteľ TEventObject. vytvorenie (const OnEvent: TObjectProcedure);
začať
zdedený vytvorenie;
FOnEvent: = OnEvent;
koniec;
funkcie TEventObject. GetIDsOfNames (const IID: TGUID; Mená: Ukazovateľ; NameCount, LocaleID: Celé číslo; DispID: Ukazovateľ): HResult;
začať
Výsledok: = E_NOTIMPL;
koniec;
funkcie TEventObject. GetTypeInfo (Index, LocaleID: Celé číslo; mimo TypeInfo): HResult;
začať
Výsledok: = E_NOTIMPL;
koniec;
funkcie TEventObject. GetTypeInfoCount (počet mimo: celé číslo): HResult;
začať
Výsledok: = E_NOTIMPL;
koniec;
funkcie TEventObject. Vyvolať (DispID: celé číslo; const IID: TGUID; LocaleID: Celé číslo; Vlajky: Slovo; var params; VarResult, ExcepInfo, ArgErr: Ukazovateľ): HResult;
začať
ak (DispID = DISPID_VALUE) potom
začať
ak Priradené (FOnEvent) potom FOnEvent;
Výsledok: = S_OK;
koniec
inak Výsledok: = E_NOTIMPL;
koniec;
koniec.