Rufen Sie die URL eines Hyperlinks in einem TWebBrowser-Dokument ab

In den meisten Situationen verwenden Sie den TWebBrowser, um dem Benutzer HTML-Dokumente anzuzeigen und so Ihre eigene Version des Webbrowsers (Internet Explorer) zu erstellen. Beachten Sie, dass der TWebBrowser beispielsweise auch Word-Dokumente anzeigen kann.

Eine sehr schöne Funktion eines Browsers ist die Anzeige von Linkinformationen, beispielsweise in der Statusleiste, wenn Sie mit der Maus über einen Link in einem Dokument fahren.

Der TWebBrowser macht kein Ereignis wie "OnMouseMove" verfügbar. Selbst wenn ein solches Ereignis vorhanden wäre, würde es für die TWebBrowser-Komponente ausgelöst - NICHT für das Dokument, das im TWebBrowser angezeigt wird.

Um solche Informationen (und vieles mehr, wie Sie gleich sehen werden) in Ihrer Delphi-Anwendung mithilfe der TWebBrowser-Komponente bereitzustellen, wird eine Technik namens "Ereignisse sinken"muss implementiert werden.

Um mit der TWebBrowser-Komponente zu einer Webseite zu navigieren, rufen Sie die Navigieren Methode. Das Dokumentieren

Um das "href" -Attribut (Link) eines "a" -Tags in einem Dokument abzurufen, während Sie mit der Maus über ein Dokument fahren, müssen Sie auf das "onmousemove" -Ereignis des IHTMLDocument2 reagieren.

Da wir uns für das HREF-Attribut eines A-Elements interessieren - um die URL eines Links anzuzeigen, über dem sich die Maus befindet, wird das Ereignis "onmousemove" gelöscht.

Wie oben erläutert, hängen wir das Ereignis onmousemove eines Dokuments im Ereignis OnDocumentComplete eines TWebBrowser an:

Einheit Einheit 1;
Schnittstelle
Verwendet
Windows, Nachrichten, SysUtils, Varianten, Klassen, Grafiken, Steuerelemente, Formulare,
Dialoge, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
Art
TObjectProcedure = VerfahrenvonObjekt;
TEventObject = Klasse(TInterfacedObject, IDispatch)
Privat
FOnEvent: TObjectProcedure;
geschützt
Funktion GetTypeInfoCount (out Count: Integer): HResult; stdcall;
Funktion GetTypeInfo (Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
Funktion GetIDsOfNames (const IID: TGUID; Namen: Zeiger; NameCount, LocaleID: Integer; DispIDs: Zeiger): HResult; stdcall;
Funktion Invoke (DispID: Integer; const IID: TGUID; LocaleID: Integer; Flaggen: Wort; var Params; VarResult, ExcepInfo, ArgErr: Zeiger): HResult; stdcall;
Öffentlichkeit
Konstrukteur Erstellen(const OnEvent: TObjectProcedure);
Eigentum OnEvent: TObjectProcedure read FOnEvent write FOnEvent;
Ende;
TForm1 = Klasse(TForm)
WebBrowser1: TWebBrowser;
elementInfo: TMemo;
Verfahren WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Header: OleVariant; var Abbrechen: WordBool);
Verfahren WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
Verfahren FormCreate (Absender: TObject);
Privat
Verfahren Document_OnMouseOver;
Öffentlichkeit
{ Öffentlichkeit Erklärungen}
Ende;
var
Form1: TForm1;
htmlDoc: IHTMLDocument2;
Implementierung
{$ R * .dfm}
Verfahren TForm1.Document_OnMouseOver;
var
Element: IHTMLElement;
Start
wenn htmlDoc = Nulldann Ausgang;
element: = htmlDoc.parentWindow.event.srcElement;
elementInfo. Klar;
wenn LowerCase (element.tagName) = 'a' dann
Start
elementInfo. Linien. Add ('LINK info ...');
elementInfo. Linien. Add (Format ('HREF:% s', [element.getAttribute ('href', 0)]));
Ende
sonstwenn LowerCase (element.tagName) = 'img' dann
Start
elementInfo. Linien. Add ('IMAGE info ...');
elementInfo. Linien. Add (Format ('SRC:% s', [element.getAttribute ('src', 0)]));
Ende
sonst
Start
elementInfo. Linien. Add (Format ('TAG:% s', [element.tagName]));
Ende;
Ende; (* Document_OnMouseOver *)
Verfahren TForm1.FormCreate (Absender: TObject);
Start
WebBrowser1.Navigate (' http://delphi.about.com') ;
elementInfo. Klar;
elementInfo. Linien. Hinzufügen ('Bewegen Sie die Maus über das Dokument ...');
Ende; (* FormCreate *)
Verfahren TForm1.WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData, Header: OleVariant; var Abbrechen: WordBool);
Start
htmlDoc: = Null;
Ende; (* WebBrowser1BeforeNavigate2 *)
Verfahren TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
Start
wenn Zugewiesen (WebBrowser1.Document) dann
Start
htmlDoc: = WebBrowser1.Document wie IHTMLDocument2;
htmlDoc.onmouseover: = (TEventObject. Erstellen (Document_OnMouseOver) wie IDispatch);
Ende;
Ende; (* WebBrowser1DocumentComplete *)
{TEventObject}
Konstrukteur TEventObject. Erstellen(const OnEvent: TObjectProcedure);
Start
vererbt Erstellen;
FOnEvent: = OnEvent;
Ende;
Funktion TEventObject. GetIDsOfNames (const IID: TGUID; Namen: Zeiger; NameCount, LocaleID: Integer; DispIDs: Zeiger): HResult;
Start
Ergebnis: = E_NOTIMPL;
Ende;
Funktion TEventObject. GetTypeInfo (Index, LocaleID: Integer; out TypeInfo): HResult;
Start
Ergebnis: = E_NOTIMPL;
Ende;
Funktion TEventObject. GetTypeInfoCount (out Count: Integer): HResult;
Start
Ergebnis: = E_NOTIMPL;
Ende;
Funktion TEventObject. Invoke (DispID: Integer; const IID: TGUID; LocaleID: Integer; Flaggen: Wort; var Params; VarResult, ExcepInfo, ArgErr: Zeiger): HResult;
Start
wenn (DispID = DISPID_VALUE) dann
Start
wenn Zugewiesen (FOnEvent) dann FOnEvent;
Ergebnis: = S_OK;
Ende
sonst Ergebnis: = E_NOTIMPL;
Ende;
Ende.