Hämta URL till en hyperlänk i ett TWebBrowser-dokument

I de flesta situationer använder du TWebBrowser för att visa HTML-dokument för användaren - och därmed skapa din egen version av (Internet Explorer) webbläsare. Observera att TWebBrowser till exempel också kan visa Word-dokument.

En mycket trevlig funktion i en webbläsare är att visa länkinformation, till exempel i statusfältet, när musen svävar över en länk i ett dokument.

TWebBrowser avslöjar inte en händelse som "OnMouseMove". Även om en sådan händelse skulle existera skulle den avfyras för TWebBrowser-komponenten - INTE för dokumentet som visas i TWebBrowser.

För att ge sådan information (och mycket mer, som du kommer att se på ett ögonblick) i din Delphi-applikation med hjälp av TWebBrowser-komponenten, en teknik som kallas "händelser sjunker"måste genomföras.

För att navigera till en webbsida med hjälp av TWebBrowser-komponenten du kallar Navigera metod. De Dokumentera egenskapen för TWebBrowser returnerar en IHTMLDocument2 värde (för webbdokument). Detta gränssnitt används för att hämta information om ett dokument, för att undersöka och ändra HTML-element och text i dokumentet och för att behandla relaterade händelser.

instagram viewer

För att få "href" -attributet (länken) för en "a" -tagg i ett dokument, medan musen svävar över ett dokument, måste du reagera på "onmousemove" -händelsen i IHTMLDocument2.

Eftersom vi är intresserade av HREF-attributet för ett A-element - för att visa URL till en länk som musen är över kommer vi att sjunka händelsen "onmousemove".

Som förklarats ovan kopplar vi till händelsen onmousemove för ett dokument i OnDocumentComplete-händelsen för en TWebBrowser:

enhet Enhet 1;
gränssnitt
användningar
Windows, meddelanden, SysUtils, varianter, klasser, grafik, kontroller, formulär,
Dialoger, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
typ
TObjectProcedure = proceduravobjekt;
TEventObject = klass(TInterfacedObject, IDispatch)
privat
FOnEvent: TObjectProcedure;
skyddade
fungera GetTypeInfoCount (uträkning: heltal): HResult; stdcall;
fungera GetTypeInfo (index, språk-ID: heltal; ut TypeInfo): HResult; stdcall;
fungera GetIDsOfNames (const IID: TGUID; Namn: Pekare; NameCount, LocaleID: Heltal; DispIDs: Pointer): HResult; stdcall;
fungera Åkalla (DispID: heltal; const IID: TGUID; LokalID: heltal; Flaggor: Word; var params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
offentlig
konstruktör Skapa(const OnEvent: TObjectProcedure);
fast egendom OnEvent: TObjectProcedure läs FOnEvent skriva FOnEvent;
slutet;
TForm1 = klass(TForm)
WebBrowser1: TWebBrowser;
elementInfo: TMemo;
procedur WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, flaggor, TargetFrameName, PostData, rubriker: OleVariant; var Avbryt: WordBool);
procedur WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
procedur FormCreate (avsändare: TObject);
privat
procedur Document_OnMouseOver;
offentlig
{ offentlig deklarationer}
slutet;
var
Form1: TForm1;
htmlDoc: IHTMLDocument2;
genomförande
{$ R * .dfm}
procedur TForm1.Document_OnMouseOver;
var
element: IHTMLElement;
Börja
om htmlDoc = nollsedan Utgång;
element: = htmlDoc.parentWindow.event.srcElement;
elementInfo. Klar;
om LowerCase (element.tagName) = 'a' sedan
Börja
elementInfo. Rader. Lägg till ('LINK info ...');
elementInfo. Rader. Lägg till (Format ('HREF:% s', [element.getAttribute ('href', 0)]));
slutet
annanom LowerCase (element.tagName) = 'img' sedan
Börja
elementInfo. Rader. Lägg till ('IMAGE-information ...');
elementInfo. Rader. Lägg till (Format ('SRC:% s', [element.getAttribute ('src', 0)]));
slutet
annan
Börja
elementInfo. Rader. Lägg till (Format ('TAG:% s', [element.tagName]));
slutet;
slutet; (* Document_OnMouseOver *)
procedur TForm1.FormCreate (avsändare: TObject);
Börja
WebBrowser1.Navigate (' http://delphi.about.com') ;
elementInfo. Klar;
elementInfo. Rader. Lägg till ('Flytta musen över dokumentet ...');
slutet; (* FormCreate *)
procedur TForm1.WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, flaggor, TargetFrameName, PostData, rubriker: OleVariant; var Avbryt: WordBool);
Börja
htmlDoc: = noll;
slutet; (* WebBrowser1BeforeNavigate2 *)
procedur TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
Börja
om Tilldelad (WebBrowser1.Document) sedan
Börja
htmlDoc: = WebBrowser1.Document som IHTMLDocument2;
htmlDoc.onmouseover: = (TEventObject. Skapa (Document_OnMouseOver) som IDispatch);
slutet;
slutet; (* WebBrowser1DocumentComplete *)
{TEventObject}
konstruktör TEventObject. Skapa(const OnEvent: TObjectProcedure);
Börja
ärvt Skapa;
FOnEvent: = OnEvent;
slutet;
fungera TEventObject. GetIDsOfNames (const IID: TGUID; Namn: Pekare; NameCount, LocaleID: Heltal; DispIDs: Pointer): HResult;
Börja
Resultat: = E_NOTIMPL;
slutet;
fungera TEventObject. GetTypeInfo (index, språk-ID: heltal; ut TypeInfo): HResult;
Börja
Resultat: = E_NOTIMPL;
slutet;
fungera TEventObject. GetTypeInfoCount (uträkning: heltal): HResult;
Börja
Resultat: = E_NOTIMPL;
slutet;
fungera TEventObject. Åkalla (DispID: heltal; const IID: TGUID; LokalID: heltal; Flaggor: Word; var params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
Börja
om (DispID = DISPID_VALUE) sedan
Börja
om Tilldelad (FOnEvent) sedan FOnEvent;
Resultat: = S_OK;
slutet
annan Resultat: = E_NOTIMPL;
slutet;
slutet.

instagram story viewer