Hent webadressen til et hyperlink i et TWebBrowser-dokument

click fraud protection

I de fleste situationer bruger du TWebBrowser til at vise HTML-dokumenter til brugeren - og dermed oprette din egen version af (Internet Explorer) webbrowser. Bemærk, at for eksempel TWebBrowser også kan vise Word-dokumenter.

En meget flot funktion ved en browser er at vise linkoplysninger, for eksempel i statuslinjen, når musen svæver over et link i et dokument.

TWebBrowser udsætter ikke en begivenhed som "OnMouseMove". Selv hvis en sådan begivenhed ville eksistere, ville den blive fyret for TWebBrowser-komponenten - IKKE for det dokument, der vises inde i TWebBrowser.

For at give sådanne oplysninger (og meget mere, som du vil se et øjeblik) i din Delphi-applikation ved hjælp af TWebBrowser-komponenten, en teknik kaldet "begivenheder synker"skal implementeres.

For at navigere til en webside ved hjælp af den TWebBrowser-komponent, du kalder Navigere metode. Det Dokument egenskaben til TWebBrowser returnerer en IHTMLDocument2 værdi (for webdokumenter). Denne grænseflade bruges til at hente information om et dokument, til at undersøge og ændre HTML-elementerne og teksten i dokumentet og til at behandle relaterede begivenheder.

instagram viewer

For at få "href" -attributten (linket) til et "a" -tag i et dokument, mens musen svæver over et dokument, skal du reagere på "onmousemove" -hændelsen i IHTMLDocument2.

Da vi er interesseret i HREF-attributten for et A-element - for at vise URL'en til et link, hvor musen er ovre, synker vi begivenheden "onmousemove".

Som forklaret ovenfor vedhæfter vi den onmousemove begivenhed for et dokument i OnDocumentComplete-hændelsen i en TWebBrowser:

enhed Enhed 1;
grænseflade
anvendelser
Windows, meddelelser, SysUtils, varianter, klasser, grafik, kontrol, formularer,
Dialoger, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
type
TObjectProcedure = procedureafobjekt;
TEventObject = klasse(TInterfacedObject, IDispatch)
privat
FOnEvent: TObjectProcedure;
beskyttet
fungere GetTypeInfoCount (udtælling: heltal): HResult; stdcall;
fungere GetTypeInfo (indeks, sted-id: heltal; ud TypeInfo): HResult; stdcall;
fungere GetIDsOfNames (const IID: TGUID; Navne: Pointer; NameCount, LocaleID: Heltal; DispIDs: Pointer): HResult; stdcall;
fungere Påkald (DispID: Heltal; const IID: TGUID; LandesID: ​​Heltal; Flag: Ord; Var Parametre; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
offentlig
konstruktør Skab(const OnEvent: TObjectProcedure);
ejendom OnEvent: TObjectProcedure læse FOnEvent skriv FOnEvent;
ende;
TForm1 = klasse(TForm)
WebBrowser1: TWebBrowser;
elementInfo: TMemo;
procedure WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; Var URL, flag, TargetFrameName, PostData, overskrifter: OleVariant; Var Annuller: WordBool);
procedure WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; Var URL: OleVariant);
procedure FormCreate (Afsender: TObject);
privat
procedure Document_OnMouseOver;
offentlig
{ Offentlig erklæringer}
ende;
Var
Form1: TForm1;
htmlDoc: IHTMLDocument2;
implementering
{$ R * .dfm}
procedure TForm1.Document_OnMouseOver;
Var
element: IHTMLElement;
begynde
hvis htmlDoc = nulderefter Afslut;
element: = htmlDoc.parentWindow.event.srcElement;
elementInfo. Klar;
hvis LowerCase (element.tagName) = 'a' derefter
begynde
elementInfo. Linjer. Tilføj ('LINK info ...');
elementInfo. Linjer. Tilføj (Format ('HREF:% s', [element.getAttribute ('href', 0)]));
ende
andethvis LowerCase (element.tagName) = 'img' derefter
begynde
elementInfo. Linjer. Tilføj ('IMAGE-oplysninger ...');
elementInfo. Linjer. Tilføj (Format ('SRC:% s', [element.getAttribute ('src', 0)]));
ende
andet
begynde
elementInfo. Linjer. Tilføj (Format ('TAG:% s', [element.tagName]));
ende;
ende; (* Document_OnMouseOver *)
procedure TForm1.FormCreate (Afsender: TObject);
begynde
WebBrowser1.Navigate (' http://delphi.about.com') ;
elementInfo. Klar;
elementInfo. Linjer. Tilføj ('Flyt musen hen over dokumentet ...');
ende; (* FormCreate *)
procedure TForm1.WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; Var URL, flag, TargetFrameName, PostData, overskrifter: OleVariant; Var Annuller: WordBool);
begynde
htmlDoc: = nul;
ende; (* WebBrowser1BeforeNavigate2 *)
procedure TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; Var URL: OleVariant);
begynde
hvis Tildelt (WebBrowser1.Document) derefter
begynde
htmlDoc: = WebBrowser1.Document som IHTMLDocument2;
htmlDoc.onmouseover: = (TEventObject. Opret (Document_OnMouseOver) som IDispatch);
ende;
ende; (* WebBrowser1DocumentComplete *)
{TEventObject}
konstruktør TEventObject. Skab(const OnEvent: TObjectProcedure);
begynde
arvet Skab;
FOnEvent: = OnEvent;
ende;
fungere TEventObject. GetIDsOfNames (const IID: TGUID; Navne: Pointer; NameCount, LocaleID: Heltal; DispIDs: Pointer): HResult;
begynde
Resultat: = E_NOTIMPL;
ende;
fungere TEventObject. GetTypeInfo (indeks, sted-id: heltal; ud TypeInfo): HResult;
begynde
Resultat: = E_NOTIMPL;
ende;
fungere TEventObject. GetTypeInfoCount (udtælling: heltal): HResult;
begynde
Resultat: = E_NOTIMPL;
ende;
fungere TEventObject. Påkald (DispID: Heltal; const IID: TGUID; LandesID: ​​Heltal; Flag: Ord; Var Parametre; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begynde
hvis (DispID = DISPID_VALUE) derefter
begynde
hvis Tildelt (FOnEvent) derefter FOnEvent;
Resultat: = S_OK;
ende
andet Resultat: = E_NOTIMPL;
ende;
ende.

instagram story viewer