Dapatkan Url dari Hyperlink di Dokumen TWebBrowser

Dalam sebagian besar situasi, Anda menggunakan TWebBrowser untuk menampilkan dokumen HTML kepada pengguna - sehingga membuat versi Anda sendiri dari browser Web (Internet Explorer). Perhatikan bahwa TWebBrowser juga dapat menampilkan dokumen Word, misalnya.

Fitur Browser yang sangat bagus adalah untuk menampilkan informasi tautan, misalnya, di bilah status, ketika mouse mengarahkan kursor ke sebuah tautan dalam dokumen.

TWebBrowser tidak memaparkan acara seperti "OnMouseMove". Bahkan jika peristiwa semacam itu akan ada itu akan dipecat untuk komponen TWebBrowser - BUKAN untuk dokumen yang ditampilkan di dalam TWebBrowser.

Untuk memberikan informasi seperti itu (dan banyak lagi, seperti yang akan Anda lihat sebentar lagi) dalam aplikasi Delphi Anda menggunakan komponen TWebBrowser, teknik yang disebut "acara tenggelam"Harus diimplemetasikan.

Untuk menavigasi ke halaman web menggunakan komponen TWebBrowser yang Anda panggil Menavigasi metode. Itu Dokumen properti dari TWebBrowser mengembalikan sebuah

Untuk mendapatkan atribut "href" (tautan) dari tag "a" di dalam dokumen, sementara mouse melayang di atas dokumen, Anda perlu bereaksi pada peristiwa "onmousemove" pada IHTMLDocument2.

Karena kami tertarik pada atribut HREF dari elemen A - untuk menampilkan URL tautan yang mouse telah lewat, kami akan menenggelamkan acara "onmousemove".

Seperti yang dijelaskan di atas, kami melampirkan ke acara onmousemove dari dokumen di acara OnDocumentComplete dari TWebBrowser:

satuan Unit 1;
antarmuka
menggunakan
Windows, Pesan, SysUtils, Varian, Kelas, Grafik, Kontrol, Formulir,
Dialog, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
Tipe
TObjectProcedure = prosedurdariobyek;
TEventObject = kelas(TInterfacedObject, IDispatch)
pribadi
FOnEvent: TObjectProcedure;
terlindung
fungsi GetTypeInfoCount (out Count: Integer): HResult; stdcall;
fungsi GetTypeInfo (Indeks, LocaleID: Integer; out TypeInfo): HResult; stdcall;
fungsi GetIDsOfNames (const IID: TGUID; Nama: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
fungsi Invoke (DispID: Integer; const IID: TGUID; Lokalale: Integer; Bendera: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
publik
konstruktor Membuat(const OnEvent: TObjectProcedure);
Properti OnEvent: TObjectProcedure baca FOnEvent tulis FOnEvent;
akhir;
TForm1 = kelas(TForm)
WebBrowser1: TWebBrowser;
elementInfo: TMemo;
prosedur WebBrowser1SebelumNavigasi2 (ASender: TObject; const pDisp: IDispatch; var URL, Bendera, TargetFrameName, PostData, Header: OleVariant; var Batalkan: WordBool);
prosedur WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
prosedur FormCreate (Pengirim: TObject);
pribadi
prosedur Document_OnMouseOver;
publik
{ Publik deklarasi}
akhir;
var
Form1: TForm1;
htmlDoc: IHTMLDocument2;
penerapan
{$ R * .dfm}
prosedur TForm1.Document_OnMouseOver;
var
elemen: IHTMLElement;
mulai
jika htmlDoc = nolkemudian Keluar;
elemen: = htmlDoc.parentWindow.event.srcElement;
elementInfo. Bersih;
jika LowerCase (element.tagName) = 'a' kemudian
mulai
elementInfo. Garis. Tambahkan ('Info LINK ...');
elementInfo. Garis. Tambah (Format ('HREF:% s', [element.getAttribute ('href', 0)]));
akhir
lainjika LowerCase (element.tagName) = 'img' kemudian
mulai
elementInfo. Garis. Tambahkan ('Info IMAGE ...');
elementInfo. Garis. Tambah (Format ('SRC:% s', [element.getAttribute ('src', 0)]));
akhir
lain
mulai
elementInfo. Garis. Tambah (Format ('TAG:% s', [element.tagName]));
akhir;
akhir; (* Document_OnMouseOver *)
prosedur TForm1.FormCreate (Pengirim: TObject);
mulai
WebBrowser1.Navigate (' http://delphi.about.com') ;
elementInfo. Bersih;
elementInfo. Garis. Tambahkan ('Gerakkan mouse Anda di atas dokumen ...');
akhir; (* FormCreate *)
prosedur TForm1.WebBrowser1BeforeNavigate2 (ASender: TObject; const pDisp: IDispatch; var URL, Bendera, TargetFrameName, PostData, Header: OleVariant; var Batalkan: WordBool);
mulai
htmlDoc: = nol;
akhir; (* WebBrowser1SebelumNavigasi2 *)
prosedur TForm1.WebBrowser1DocumentComplete (ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
mulai
jika Ditugaskan (WebBrowser1.Document) kemudian
mulai
htmlDoc: = WebBrowser1.Document sebagai IHTMLDocument2;
htmlDoc.onmouseover: = (TEventObject. Buat (Document_OnMouseOver) sebagai IDispatch);
akhir;
akhir; (* WebBrowser1DocumentComplete *)
{TEventObject}
konstruktor TEventObject. Membuat(const OnEvent: TObjectProcedure);
mulai
mewarisi Membuat;
FOnEvent: = OnEvent;
akhir;
fungsi TEventObject. GetIDsOfNames (const IID: TGUID; Nama: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
mulai
Hasil: = E_NOTIMPL;
akhir;
fungsi TEventObject. GetTypeInfo (Indeks, LocaleID: Integer; out TypeInfo): HResult;
mulai
Hasil: = E_NOTIMPL;
akhir;
fungsi TEventObject. GetTypeInfoCount (out Count: Integer): HResult;
mulai
Hasil: = E_NOTIMPL;
akhir;
fungsi TEventObject. Invoke (DispID: Integer; const IID: TGUID; Lokalale: Integer; Bendera: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
mulai
jika (DispID = DISPID_VALUE) kemudian
mulai
jika Ditugaskan (FOnEvent) kemudian FOnEvent;
Hasil: = S_OK;
akhir
lain Hasil: = E_NOTIMPL;
akhir;
akhir.