Mahnazmezon

Skaffa en hyperlänksadress när musen rör sig över ett TWebBrowser-dokument

Vetenskap
Share

TWebBrowser Delphi-komponenten ger åtkomst till webbläsarfunktionaliteten från dina Delphi-applikationer.

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.

WebBrowser-händelsevask

För att navigera till en webbsida med 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.

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

Här är stegen för att sjunka händelser för det för närvarande laddade dokumentet:

  1. Sänk WebBrowser-kontrollens händelser i Document händelse som tas upp av TWebBrowser. Den här händelsen avfyras när dokumentet är fullastat i webbläsaren.
  2. Inuti DocumentComplete, hämta WebBrowser-dokumentobjektet och sjunka HtmlDocumentEvents-gränssnittet.
  3. Hantera det evenemang du är intresserad av.
  4. Rensa handfat i in BeforeNavigate2 - det är när det nya dokumentet laddas i webbläsaren.

HTML-dokument OnMouseMove

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

Proceduren för att få taggen (och dess attribut) "nedanför" musen kan definieras som:

 var   htmlDoc: IHTMLDocument2; ... procedur TForm1.Document_OnMouseOver; var    element: IHTMLElement; Börja    om htmlDoc = noll sedan Utgång; element: = htmlDoc.parentWindow.event.srcElement; elementInfo.Clear;    om LowerCase (element.tagName) = 'a' då    Börja      ShowMessage ('Länk, HREF:' + element.getAttribute ('href', 0)]);    slutet    annan om LowerCase (element.tagName) = 'img' sedan    Börja      ShowMessage ('IMAGE, SRC:' + element.getAttribute ('src', 0)]);    slutet    annan    Börja      elementInfo.Lines.Add (Format ('TAG:% s', [element.tagName]));    slutet; slutet; (* Document_OnMouseOver *)

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

 procedur TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); Börja    om Delad (WebBrowser1.Document) sedan    Börja      htmlDoc: = WebBrowser1.Document som IHTMLDocument2; htmlDoc.onmouseover: = (TEventObject.Create (Document_OnMouseOver) som IDispatch);    slutet; slutet; (* WebBrowser1DocumentComplete *)

Och det är här problemen uppstår! Som du kanske gissar att "onmousemove" -händelsen är * inte * en vanlig händelse - liksom de som vi är vana att arbeta med i Delphi.

"Onmousemove" förväntar sig en pekare till en variabel av typen VARIANT av typen VT_DISPATCH som tar emot IDispatch-gränssnittet för ett objekt med en standardmetod som anropas när händelsen inträffar.

För att ansluta en Delphi-procedur till "onmousemove" måste du skapa ett omslag som implementerar IDispatch och höjer ditt evenemang i sin Invoke-metod.

Här är TEventObject-gränssnittet:

 TEventObject = klass(TInterfacedObject, IDispatch) privat    FOnEvent: TObjectProcedure; skyddade    fungera GetTypeInfoCount (ut Rä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äsa FOnEvent skriva FOnEvent;    slutet;

Så här implementerar du händelsefall för ett dokument som visas av TWebBrowser-komponenten - och få informationen om ett HTML-element under musen.

Exempel på TWebBrowser-dokumenthändelse

Ladda ner

Släpp en TWebBrowser ("WebBrowser1") på ett formulär ("Form1"). Lägg till en TMemo ("elementInfo") ...

enhet Enhet 1;
gränssnitt
användningar
   Windows, meddelanden, SysUtils, varianter, klasser, grafik, kontroller, formulär,
   Dialoger, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
typ
   TObjectProcedure = procedur av objekt;
   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 = noll sedan Utgång;
   element: = htmlDoc.parentWindow.event.srcElement;
   elementInfo.Clear;
   om LowerCase (element.tagName) = 'a' sedan
   Börja
     elementInfo.Lines.Add ('LINK-information ...');
     elementInfo.Lines.Add (Format ('HREF:% s', [element.getAttribute ('href', 0)]));
   slutet
   annan om LowerCase (element.tagName) = 'img' sedan
   Börja
     elementInfo.Lines.Add ('BILDINFORMATION ...');
     elementInfo.Lines.Add (Format ('SRC:% s', [element.getAttribute ('src', 0)]));
   slutet
   annan
   Börja
     elementInfo.Lines.Add (Format ('TAG:% s', [element.tagName]));
   slutet;
slutet; (* Document_OnMouseOver *)
procedur TForm1.FormCreate (avsändare: TObject);
Börja
   WebBrowser1.Navigate ('http://delphi.about.com');
   elementInfo.Clear;
   elementInfo.Lines.Add ('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 Delad (WebBrowser1.Document) sedan
   Börja
     htmlDoc: = WebBrowser1.Document som IHTMLDocument2;
     htmlDoc.onmouseover: = (TEventObject.Create (Document_OnMouseOver) som IDispatch);
   slutet;
slutet; (* WebBrowser1DocumentComplete *)
TEventObject
konstruktör TEventObject.Create (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-typInfo): HResult;
Börja
   Resultat: = E_NOTIMPL;
slutet;
fungera TEventObject.GetTypeInfoCount (uträkning: heltal): HResult;
Börja
   Resultat: = E_NOTIMPL;
slutet;
fungera TEventObject.Invoke (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 Delad (FOnEvent) sedan FOnEvent;
     Resultat: = S_OK;
   slutet
   annan Resultat: = E_NOTIMPL;
slutet;
slutet.

Vetenskap
×