Mahnazmezon

Verkrijg de URL van een hyperlink wanneer de muis over een TWebBrowser-document beweegt

Wetenschap
Share

De component TWebBrowser Delphi biedt toegang tot de webbrowserfunctionaliteit vanuit uw Delphi-applicaties.

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 erg 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.

WebBrowser Event Sink

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 IHTMLDocument2 waarde (voor webdocumenten). Deze interface wordt gebruikt om informatie over een document op te halen, om de HTML-elementen en tekst in het document te onderzoeken en te wijzigen, en om gerelateerde gebeurtenissen te verwerken.

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.

Hier zijn de stappen om gebeurtenissen voor het momenteel geladen document te laten zinken:

  1. Verzink de gebeurtenissen van het WebBrowser-besturingselement in de DocumentComplete evenement opgevoed door de TWebBrowser. Deze gebeurtenis wordt geactiveerd wanneer het document volledig in de webbrowser wordt geladen.
  2. Haal in DocumentComplete het documentobject van WebBrowser op en laat de interface HtmlDocumentEvents zinken.
  3. Behandel het evenement waarin u geïnteresseerd bent.
  4. Maak de gootsteen in de in BeforeNavigate2 - dat is wanneer het nieuwe document in de webbrowser wordt geladen.

HTML-document OnMouseMove

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.

De procedure om de tag (en de bijbehorende attributen) "onder" de muis te krijgen, kan als volgt worden gedefinieerd:

 var   htmlDoc: IHTMLDocument2;… procedure TForm1.Document_OnMouseOver; var    element: IHTMLElement; beginnen    als htmlDoc = nul vervolgens Uitgang; element: = htmlDoc.parentWindow.event.srcElement; elementInfo.Clear;    als LowerCase (element.tagName) = 'a' dan    beginnen      ShowMessage ('Link, HREF:' + element.getAttribute ('href', 0)]);    einde    anders als LowerCase (element.tagName) = 'img' vervolgens    beginnen      ShowMessage ('IMAGE, SRC:' + element.getAttribute ('src', 0)]);    einde    anders    beginnen      elementInfo.Lines.Add (Formaat ('TAG:% s', [element.tagName]));    einde; einde; (* Document_OnMouseOver *)

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

 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.Create (Document_OnMouseOver) net zo IDispatch);    einde; einde; (* WebBrowser1DocumentComplete *)

En dit is waar de problemen zich voordoen! Zoals je zou kunnen raden, is het "onmousemove" -evenement * geen * een gewoon evenement - net als die waarmee we in Delphi gewend zijn te werken.

De "onmousemove" verwacht een pointer naar een variabele van het type VARIANT van het type VT_DISPATCH die de IDispatch-interface van een object ontvangt met een standaardmethode die wordt opgeroepen wanneer de gebeurtenis plaatsvindt.

Om een ​​Delphi-procedure aan "onmousemove" te koppelen, moet je een wrapper maken die IDispatch implementeert en je evenement verhoogt in de Invoke-methode.

Hier is de TEventObject-interface:

 TEventObject = klasse(TInterfacedObject, IDispatch) privaat    FOnEvent: TObjectProcedure; beschermde    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    bouwer Create (const OnEvent: TObjectProcedure);    eigendom OnEvent: TObjectProcedure lezen FOnEvent schrijven FOnEvent;    einde;

Hier leest u hoe u gebeurteniszinken implementeert voor een document dat wordt weergegeven door de component TWebBrowser - en krijg de info van een HTML-element onder de muis.

Voorbeeld van het zinken van documentgebeurtenissen bij TWebBrowser

Download

Zet een TWebBrowser ("WebBrowser1") neer op een formulier ("Form1"). Voeg een TMemo ("elementInfo") toe ...

eenheid Hoofdstuk 1;
koppel
toepassingen
   Windows, Berichten, SysUtils, Varianten, Classes, Graphics, Controls, Forms,
   Dialogen, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
type
   TObjectProcedure = procedure van voorwerp;
   TEventObject = klasse(TInterfacedObject, IDispatch)
   privaat
     FOnEvent: TObjectProcedure;
   beschermde
     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
     bouwer Create (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 = nul vervolgens Uitgang;
   element: = htmlDoc.parentWindow.event.srcElement;
   elementInfo.Clear;
   als LowerCase (element.tagName) = 'a' vervolgens
   beginnen
     elementInfo.Lines.Add ('LINK info ...');
     elementInfo.Lines.Add (Format ('HREF:% s', [element.getAttribute ('href', 0)]));
   einde
   anders als LowerCase (element.tagName) = 'img' vervolgens
   beginnen
     elementInfo.Lines.Add ('IMAGE info…');
     elementInfo.Lines.Add (Format ('SRC:% s', [element.getAttribute ('src', 0)]));
   einde
   anders
   beginnen
     elementInfo.Lines.Add (Formaat ('TAG:% s', [element.tagName]));
   einde;
einde; (* Document_OnMouseOver *)
procedure TForm1.FormCreate (Sender: TObject);
beginnen
   WebBrowser1.Navigate ('http://delphi.about.com');
   elementInfo.Clear;
   elementInfo.Lines.Add ('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: = nul;
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.Create (Document_OnMouseOver) net zo IDispatch);
   einde;
einde; (* WebBrowser1DocumentComplete *)
TEventObject
bouwer TEventObject.Create (const OnEvent: TObjectProcedure);
beginnen
   geërfd aanmaken;
   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: geheel getal; 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.

Wetenschap
×