Λάβετε την διεύθυνση URL μιας υπερ-σύνδεσης σε ένα έγγραφο TWebBrowser

Στις περισσότερες περιπτώσεις, χρησιμοποιείτε το TWebBrowser για να εμφανίσετε έγγραφα HTML στον χρήστη - δημιουργώντας έτσι τη δική σας έκδοση του προγράμματος περιήγησης ιστού (Internet Explorer). Σημειώστε ότι ο TWebBrowser μπορεί επίσης να εμφανίσει έγγραφα του Word, για παράδειγμα.

Ένα πολύ ωραίο χαρακτηριστικό ενός προγράμματος περιήγησης είναι η εμφάνιση πληροφοριών συνδέσμων, για παράδειγμα, στη γραμμή κατάστασης, όταν το ποντίκι κινείται πάνω από έναν σύνδεσμο σε ένα έγγραφο.

Ο TWebBrowser δεν εκθέτει ένα συμβάν όπως "OnMouseMove". Ακόμα κι αν υπάρχει ένα τέτοιο συμβάν, θα εκτοξευθεί για το στοιχείο TWebBrowser - ΟΧΙ για το έγγραφο που εμφανίζεται μέσα στο TWebBrowser.

Προκειμένου να παρέχετε αυτές τις πληροφορίες (και πολύ περισσότερο, όπως θα δείτε σε λίγο) στην εφαρμογή Delphi χρησιμοποιώντας το στοιχείο TWebBrowser, μια τεχνική που ονομάζεται "τα γεγονότα βυθίζονται"πρέπει να εφαρμοστεί.

Για να μεταβείτε σε μια ιστοσελίδα χρησιμοποιώντας το στοιχείο TWebBrowser που καλείτε Κυβερνώ

Για να αποκτήσετε το χαρακτηριστικό "href" μιας ετικέτας "a" μέσα σε ένα έγγραφο, ενώ το ποντίκι βρίσκεται πάνω από ένα έγγραφο, πρέπει να αντιδράσετε στο συμβάν "onmousemove" του IHTMLDocument2.

Δεδομένου ότι μας ενδιαφέρει το χαρακτηριστικό HREF ενός στοιχείου Α - για να δείξει τη διεύθυνση URL ενός συνδέσμου, το ποντίκι τελείωσε, θα βυθίσουμε το γεγονός "onmousemove".

Όπως εξηγείται παραπάνω, επισυνάπτουμε στο συμβάν onmousemove ενός εγγράφου στο συμβάν OnDocumentComplete ενός TWebBrowser:

μονάδα Μονάδα 1;
διεπαφή
χρήσεις
Windows, Μηνύματα, SysUtils, Παραλλαγές, Μαθήματα, Γραφικά, Έλεγχοι, Μορφές,
Διαλόγους, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls.
τύπος
TObjectProcedure = διαδικασίατουαντικείμενο;
TEventObject = τάξη(TInterfacedObject, IDispatch)
ιδιωτικός
Εφαρμογή: TObjectProcedure;
προστατεύονται
λειτουργία GetTypeInfoCount (εκτός Count: Αισθητήρας): HResult; stdcall;
λειτουργία GetTypeInfo (ευρετήριο, τοπικό αναγνωριστικό: ακέραιο; out TypeInfo): HResult; stdcall;
λειτουργία GetIDsOfNames (const IID: TGUID; Ονόματα: Δείκτης. ΌνομαCount, LocaleID: Ακέραιος αριθμός; DispIDs: Δείκτης): HResult; stdcall;
λειτουργία Επικεφαλίστε (DispID: Ακέραιος; const IID: TGUID; LocaleID: Ακεραίο. Σημαίες: Word; var Params; VarResult, ExcepInfo, ArgErr: Δείκτης): HResult; stdcall;
δημόσιο
κατασκευαστής Δημιουργώ(const OnEvent: TObjectProcedure);
ιδιοκτησία OnEvent: TObjectProcedure ανάγνωση FOnEvent γράψτε FOnEvent;
τέλος;
TForm1 = τάξη(TForm)
WebBrowser1: TWebBrowser;
elementInfo: TMemo;
διαδικασία WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, σημαίες, TargetFrameName, PostData, κεφαλίδες: OleVariant; var Ακύρωση: WordBool);
διαδικασία WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
διαδικασία FormCreate (αποστολέας: TObject);
ιδιωτικός
διαδικασία Document_OnMouseOver;
δημόσιο
{ Δημόσιο δηλώσεις}
τέλος;
var
Μορφή1: TForm1;
htmlDoc: IHTMLDocument2;
εκτέλεση
{$ R * .dfm}
διαδικασία TForm1.Document_OnMouseOver;
var
στοιχείο: IHTMLElement;
ξεκινήσει
αν htmlDoc = μηδένέπειτα Εξοδος;
στοιχείο: = htmlDoc.parentWindow.event.srcElement;
elementInfo. Σαφή;
αν LowerCase (element.tagName) = 'a' έπειτα
ξεκινήσει
elementInfo. Γραμμές. Προσθήκη ('Πληροφορίες LINK ...');
elementInfo. Γραμμές. Προσθήκη (Μορφή ('HREF:% s', [element.getAttribute ('href', 0)]));
τέλος
αλλούαν LowerCase (element.tagName) = 'img' έπειτα
ξεκινήσει
elementInfo. Γραμμές. Προσθήκη ('IMAGE info ...');
elementInfo. Γραμμές. Προσθήκη (Μορφή ('SRC:% s', [element.getAttribute ('src', 0)]));
τέλος
αλλού
ξεκινήσει
elementInfo. Γραμμές. Προσθήκη (Μορφή ('TAG:% s', [element.tagName]));
τέλος;
τέλος; (* Document_OnMouseOver *)
διαδικασία TForm1.FormCreate (αποστολέας: TObject);
ξεκινήσει
WebBrowser1.Navigate (' http://delphi.about.com') ;
elementInfo. Σαφή;
elementInfo. Γραμμές. Προσθήκη ('Μετακινήστε το ποντίκι πάνω στο έγγραφο ...');
τέλος; (* FormCreate *)
διαδικασία TForm1.WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, σημαίες, TargetFrameName, PostData, κεφαλίδες: OleVariant; var Ακύρωση: WordBool);
ξεκινήσει
htmlDoc: = μηδέν;
τέλος; (* WebBrowser1BeforeNavigate2 *)
διαδικασία TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
ξεκινήσει
αν Ανατεθεί (WebBrowser1.Document) έπειτα
ξεκινήσει
htmlDoc: = WebBrowser1.Document όπως και IHTMLDocument2;
htmlDoc.onmouseover: = (TEventObject. Δημιουργία (Document_OnMouseOver) όπως και IDispatch);
τέλος;
τέλος; (* WebBrowser1DocumentComplete *)
{TEventObject}
κατασκευαστής TEventObject. Δημιουργώ(const OnEvent: TObjectProcedure);
ξεκινήσει
κληρονόμησε Δημιουργώ;
FOnEvent: = OnEvent;
τέλος;
λειτουργία TEventObject. GetIDsOfNames (const IID: TGUID; Ονόματα: Δείκτης. ΌνομαCount, LocaleID: Ακέραιος αριθμός; DispIDs: Δείκτης): HResult;
ξεκινήσει
Αποτέλεσμα: = E_NOTIMPL;
τέλος;
λειτουργία TEventObject. GetTypeInfo (ευρετήριο, τοπικό αναγνωριστικό: ακέραιο; out TypeInfo): HResult;
ξεκινήσει
Αποτέλεσμα: = E_NOTIMPL;
τέλος;
λειτουργία TEventObject. GetTypeInfoCount (εκτός Count: Αισθητήρας): HResult;
ξεκινήσει
Αποτέλεσμα: = E_NOTIMPL;
τέλος;
λειτουργία TEventObject. Επικεφαλίστε (DispID: Ακέραιος; const IID: TGUID; LocaleID: Ακεραίο. Σημαίες: Word; var Params; VarResult, ExcepInfo, ArgErr: Δείκτης): HResult;
ξεκινήσει
αν (DispID = DISPID_VALUE) έπειτα
ξεκινήσει
αν Ανατεθεί (FOnEvent) έπειτα FOnEvent;
Αποτέλεσμα: = S_OK;
τέλος
αλλού Αποτέλεσμα: = E_NOTIMPL;
τέλος;
τέλος.