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