В повечето ситуации използвате TWebBrowser за показване на HTML документи на потребителя, като по този начин създавате своя собствена версия на (Internet Explorer) уеб браузър. Обърнете внимание, че TWebBrowser може също така да показва документи на Word, например.
Много приятна характеристика на браузъра е да показва информация за връзката, например, в лентата на състоянието, когато мишката се задържи върху връзка в документ.
TWebBrowser не излага събитие като "OnMouseMove". Дори и да съществува такова събитие, то би се задействало за компонента TWebBrowser - НЕ за документа, който се показва вътре в TWebBrowser.
За да предоставите такава информация (и много повече, както ще видите след малко) във вашето приложение Delphi, използвайки компонента TWebBrowser, техника, наречена „събития потъват"трябва да се изпълни.
За да отидете до уеб страница с помощта на компонента TWebBrowser, на който се обаждате Навигация метод. Най- документ собственост на TWebBrowser връща IHTMLDocument2 стойност (за уеб документи). Този интерфейс се използва за извличане на информация за документ, за разглеждане и промяна на HTML елементи и текст в документа и за обработка на свързани събития.
За да получите атрибута (връзка) "href" на маркер "a" вътре в документ, докато мишката се задържи върху документ, трябва да реагирате на събитието "onmousemove" на IHTMLDocument2.
Тъй като се интересуваме от атрибута HREF на елемент A - за да покажем URL адреса на връзка, с която мишката е приключила, ще потопим събитието „onmousemove“.
Както беше обяснено по-горе, ние прикрепяме към събитието onmousemove на документ в събитието OnDocumentComplete на TWebBrowser:
мерна единица Unit1;
интерфейс
употреби
Windows, Съобщения, SysUtils, Варианти, Класове, Графика, Контроли, Форми,
Диалози, OleCtrls, SHDocVw, MSHTML, ActiveX, StdCtrls;
Тип
TObjectProcedure = процедуранаобект;
TEventObject = клас(TInterfacedObject, IDispatch)
частен
FOnEvent: TObjectProcedure;
защитени
функция GetTypeInfoCount (брой на брой: Целочисление): HResult; stdcall;
функция GetTypeInfo (Index, LocaleID: Integer; изход TypeInfo): HResult; stdcall;
функция GetIDsOfNames (конст IID: TGUID; Имена: указател; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
функция Invoke (DispID: Integer; конст IID: TGUID; LocaleID: Целочислено; Флагове: Word; Var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
обществен
конструктор Създаване (конст OnEvent: TObjectProcedure);
Имот OnEvent: TObjectProcedure чете FOnEvent пише FOnEvent;
край;
TForm1 = клас(TForm)
WebBrowser1: TWebBrowser;
elementInfo: TMemo;
процедура WebBrowser1BeforeNavigate2 (ASender: TObject; конст pDisp: IDispatch; Var URL, Флагове, TargetFrameName, PostData, Заглавки: OleVariant; Var Отказ: WordBool);
процедура WebBrowser1DocumentComplete (ASender: TObject; конст pDisp: IDispatch; Var URL адрес: OleVariant);
процедура FormCreate (подател: TObject);
частен
процедура Document_OnMouseOver;
обществен
{ обществен декларации}
край;
Var
Форма1: TForm1;
htmlDoc: IHTMLDocument2;
изпълнение
{$ R * .dfm}
процедура TForm1.Document_OnMouseOver;
Var
елемент: IHTMLElement;
започвам
ако htmlDoc = нулатогава Exit;
елемент: = htmlDoc.parentWindow.event.srcElement;
elementInfo. Ясно;
ако LowerCase (element.tagName) = 'a' тогава
започвам
elementInfo. Зума. Добавяне („ВРЪЗКА с информация ...“);
elementInfo. Зума. Добавяне (Формат ('HREF:% s', [element.getAttribute ('href', 0)]));
край
ощеако LowerCase (element.tagName) = 'img' тогава
започвам
elementInfo. Зума. Добавяне („Информация за IMAGE ...“);
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; конст pDisp: IDispatch; Var URL, Флагове, TargetFrameName, PostData, Заглавки: OleVariant; Var Отказ: WordBool);
започвам
htmlDoc: = нула;
край; (* WebBrowser1BeforeNavigate2 *)
процедура TForm1.WebBrowser1DocumentComplete (ASender: TObject; конст pDisp: IDispatch; Var URL адрес: OleVariant);
започвам
ако Присвоен (WebBrowser1.Document) тогава
започвам
htmlDoc: = WebBrowser1.Document като IHTMLDocument2;
htmlDoc.onmouseover: = (TEventObject. Създаване (Document_OnMouseOver) като ID изпращане);
край;
край; (* WebBrowser1DocumentComplete *)
{TEventObject}
конструктор TEventObject. Създаване (конст OnEvent: TObjectProcedure);
започвам
наследен Създаване;
FOnEvent: = OnEvent;
край;
функция TEventObject. GetIDsOfNames (конст IID: TGUID; Имена: указател; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
започвам
Резултат: = E_NOTIMPL;
край;
функция TEventObject. GetTypeInfo (Index, LocaleID: Integer; изход TypeInfo): HResult;
започвам
Резултат: = E_NOTIMPL;
край;
функция TEventObject. GetTypeInfoCount (брой на брой: Целочисление): HResult;
започвам
Резултат: = E_NOTIMPL;
край;
функция TEventObject. Invoke (DispID: Integer; конст IID: TGUID; LocaleID: Целочислено; Флагове: Word; Var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
започвам
ако (DispID = DISPID_VALUE) тогава
започвам
ако Присвоен (FOnEvent) тогава FOnEvent;
Резултат: = S_OK;
край
още Резултат: = E_NOTIMPL;
край;
край.