Download de URL van een hyperlink in een TWebBrowser-document

In de meeste situaties gebruikt u de TWebBrowser om HTML-documenten aan de gebruiker weer te geven - waarmee u uw eigen versie van de (Internet Explorer) webbrowser maakt. Merk op dat de TWebBrowser bijvoorbeeld ook Word-documenten kan weergeven.

Een heel leuke functie van een browser is om linkinformatie weer te geven, bijvoorbeeld in de statusbalk, wanneer de muis over een link in een document zweeft.

De TWebBrowser onthult geen gebeurtenis zoals "OnMouseMove". Zelfs als een dergelijke gebeurtenis zou bestaan, zou deze worden geactiveerd voor de component TWebBrowser - NIET voor het document dat wordt weergegeven in de TWebBrowser.

Om dergelijke informatie (en nog veel meer, zoals u zo dadelijk zult zien) in uw Delphi-toepassing te verstrekken met behulp van de TWebBrowser-component, een techniek genaamd "evenementen zinken"moet geïmplementeerd zijn.

Om naar een webpagina te navigeren met behulp van de TWebBrowser-component die u oproept Navigeren methode. De Document eigenschap van de TWebBrowser retourneert een

Om het "href" -attribuut (link) van een "a" -tag in een document te krijgen, terwijl de muis over een document zweeft, moet u reageren op de "onmousemove" -gebeurtenis van het IHTMLDocument2.

Omdat we geïnteresseerd zijn in het HREF-kenmerk van een A-element - om de URL van een link weer te geven waar de muis over is, zullen we de gebeurtenis "onmousemove" laten zinken.

Zoals hierboven uitgelegd, koppelen we aan de gebeurtenis onmousemove van een document in de gebeurtenis OnDocumentComplete van een TWebBrowser:

eenheid Hoofdstuk 1;
koppel
toepassingen
Windows, Berichten, SysUtils, Varianten, Classes, Graphics, Controls, Forms,
Dialogen, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
type
TObjectProcedure = procedurevanvoorwerp;
TEventObject = klasse(TInterfacedObject, IDispatch)
privaat
FOnEvent: TObjectProcedure;
beschermd
functie GetTypeInfoCount (uit Count: Integer): HResult; stdcall;
functie GetTypeInfo (Index, LocaleID: geheel getal; uit TypeInfo): HResult; stdcall;
functie GetIDsOfNames (const IID: TGUID; Namen: Pointer; NameCount, LocaleID: geheel getal; DispIDs: Pointer): HResult; stdcall;
functie Invoke (DispID: Integer; const IID: TGUID; LocaleID: geheel getal; Vlaggen: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
openbaar
constructeur Maken (const OnEvent: TObjectProcedure);
eigendom OnEvent: TObjectProcedure lees FOnEvent schrijf FOnEvent;
einde;
TForm1 = klasse(TForm)
WebBrowser1: TWebBrowser;
elementInfo: TMemo;
procedure WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, vlaggen, TargetFrameName, PostData, Headers: OleVariant; var Annuleren: WordBool);
procedure WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
procedure FormCreate (afzender: TObject);
privaat
procedure Document_OnMouseOver;
openbaar
{ Openbaar verklaringen}
einde;
var
Form1: TForm1;
htmlDoc: IHTMLDocument2;
implementatie
{$ R * .dfm}
procedure TForm1.Document_OnMouseOver;
var
element: IHTMLElement;
beginnen
als htmlDoc = nihilvervolgens Uitgang;
element: = htmlDoc.parentWindow.event.srcElement;
elementinfo. Doorzichtig;
als LowerCase (element.tagName) = 'a' vervolgens
beginnen
elementinfo. Lijnen. Toevoegen ('LINK info ...');
elementinfo. Lijnen. Add (Format ('HREF:% s', [element.getAttribute ('href', 0)]));
einde
andersals LowerCase (element.tagName) = 'img' vervolgens
beginnen
elementinfo. Lijnen. Toevoegen ('IMAGE info ...');
elementinfo. Lijnen. Add (Format ('SRC:% s', [element.getAttribute ('src', 0)]));
einde
anders
beginnen
elementinfo. Lijnen. Add (Format ('TAG:% s', [element.tagName]));
einde;
einde; (* Document_OnMouseOver *)
procedure TForm1.FormCreate (Sender: TObject);
beginnen
WebBrowser1.Navigate (' http://delphi.about.com') ;
elementinfo. Doorzichtig;
elementinfo. Lijnen. Toevoegen ('Beweeg uw muis over het document ...');
einde; (* FormCreate *)
procedure TForm1.WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, vlaggen, TargetFrameName, PostData, Headers: OleVariant; var Annuleren: WordBool);
beginnen
htmlDoc: = nihil;
einde; (* WebBrowser1BeforeNavigate2 *)
procedure TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
beginnen
als Toegewezen (WebBrowser1.Document) vervolgens
beginnen
htmlDoc: = WebBrowser1.Document net zo IHTMLDocument2;
htmlDoc.onmouseover: = (TEventObject. Maken (Document_OnMouseOver) net zo IDispatch);
einde;
einde; (* WebBrowser1DocumentComplete *)
{TEventObject}
constructeur TEventObject. Maken (const OnEvent: TObjectProcedure);
beginnen
geërfd Maken;
FOnEvent: = OnEvent;
einde;
functie TEventObject. GetIDsOfNames (const IID: TGUID; Namen: Pointer; NameCount, LocaleID: geheel getal; DispIDs: Pointer): HResult;
beginnen
Resultaat: = E_NOTIMPL;
einde;
functie TEventObject. GetTypeInfo (Index, LocaleID: geheel getal; uit TypeInfo): HResult;
beginnen
Resultaat: = E_NOTIMPL;
einde;
functie TEventObject. GetTypeInfoCount (uit Count: Integer): HResult;
beginnen
Resultaat: = E_NOTIMPL;
einde;
functie TEventObject. Invoke (DispID: Integer; const IID: TGUID; LocaleID: geheel getal; Vlaggen: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
beginnen
als (DispID = DISPID_VALUE) vervolgens
beginnen
als Toegewezen (FOnEvent) vervolgens FOnEvent;
Resultaat: = S_OK;
einde
anders Resultaat: = E_NOTIMPL;
einde;
einde.