Как перехватить сообщения когда WebBrowser в фокусе.

← →
Delphin2008 (2008-01-28 03:18) [0]

Компонент TKOLWebBrowser не реагирует на Ctrl+X Delete и т.п. кнопки в формах HTML-страниц.

Удалось добиться "кривой" реализации пересылая сообщения в контролы страниц TKOLWebBrowser из Applet.onMessages, через TranslateAccelerator(Msg), но это работает только когда фокус не на WebBrowser.

Осталось дело за малым перехватывать сообщения когда фокус принадлежит WebBrowser а вот это как раз сделать и не получается.

З.Ы.Идальным конечно было бы корректно инициализировать TKOLWebBrowser чтобы все работало штатно и предсказуемо (как EmbeddedWB например), но это совсем уж не ясно как сделать.

← →
Delphin2008 (2008-01-28 03:23) [1]

Оптравка сообщений так сделана (из DelphiWorld)
var iOIPAO: IOleInPlaceActiveObject; Dispatch: IDispatch; begin if (not www.Busy) then begin if FOleInPlaceActiveObject = nil then begin Dispatch := www.Application; if Dispatch <> nil then begin Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO); if iOIPAO <> nil then FOleInPlaceActiveObject := iOIPAO; end; end; FOleInPlaceActiveObject.TranslateAccelerator(Msg); end; end;

← →
Vladimir Kladov © (2008-01-28 08:22) [2]

Посмотрите на MHIPEdit: в нём та же ситуация. KOL не субклассит автоматически дочерние контролы, соответственно, сообщения которые они ловят напрямую, не перехватваются. Субклассировать надо самим, заменяя оконную процедуру обработки сообщений.

← →
Delphin2008 (2008-01-28 10:05) [3]

Мда... Похоже что я ничего не понимаю...

То что в VCL реализуется легким движением
initialization OleInitialize(nil);
в KOL для меня оказывается неподъёмной задачей. Обидно.

← →
Delphin2008 (2008-01-28 11:58) [4]

С субклассингом совсем туго. Я не понимаю суть совета. Идём так сказать своим путём. Но городуха получилась у меня ещё та.

В общем поставил локальный хук на клавиатуру, Del отловил. Отсылаю по хуку браузеру сообщение - вроде бы работает, но независимо от того где фокус.

Отсюда вопрос, как узнать имеет ли WebBrowser фокус? Стандартные методы вроде Form.ActiveControl врут безбожно.

И ещё. Наметил еще один путь решения сабжа. Сугубо по msdn-у.
Там вроде бы как утверждается что необходимо и достаточно использовать OLEIVERB_UIACTIVATE:
(www.Application as IOleObject).DoVerb(OLEIVERB_UIACTIVATE, (* iVerb *) nil, (* lpMsg *) www, (* pActiveSite *) 0, (* lindex - reserved *) www.Handle, (* hwndParent *) rect); (* display rectangle *)
Но грабли опять те же. Что позволено VCLу, KOLу надо втолковывать по своему. Так и тут на www (* pActiveSite *) не компилит и всё тут.

Неделю уже извёл на сабж. :-(((((

← →
Delphin2008 (2008-01-29 00:57) [5]

Из 6 мессаг 5 мои %-)... Ну что же, иногда приходтся говорить с самим собой. Может все таки кто то подключится? Итожим говоренное.

Обработка клавиш Ctrl-C X Delete и т.д в TWebBrowser у меня вылилась в хук клавы вида

function Hook(nCode: Integer; wParam, lParam: Longint): Longint; stdcall; var szClassName: array[0..255] of Char; var Msg: TMsg; const ie_name = "Internet Explorer_Server"; begin case nCode < 0 of True: Result := CallNextHookEx(Global.HookID, nCode, wParam, lParam) else case wParam of VK_DELETE,VK_INSERT,VK_CONTROL,VK_SHIFT,88,67,86,65: //88-X,67-C,86-V 65-a begin if Global.FOleInPlaceActiveObject <> nil then begin MSG.hwnd:=Global.wwwHandle; If wParam=VK_CONTROL then begin //Ctrl Global.KeyCtrlDown:=not Global.KeyCtrlDown; If Global.KeyCtrlDown then MSG.message:=wm_KeyDown else MSG.message:=wm_KeyUp; end Else If wParam=VK_SHIFT then begin //Shift Global.KeyShiftDown:=not Global.KeyShiftDown; If Global.KeyShiftDown then MSG.message:=wm_KeyDown else MSG.message:=wm_KeyUp; end else If (wParam=VK_DELETE) or (Global.KeyCtrlDown) or(Global.KeyShiftDown) then begin //other Global.KeyDown:=not Global.KeyDown; If Global.KeyDown then MSG.message:=wm_KeyDown else MSG.message:=wm_KeyUp; end else MSG.message:=0; MSG.wParam:=wParam; MSG.lParam:=lParam; Global.FOleInPlaceActiveObject.TranslateAccelerator(Msg); end; end else Result := CallNextHookEx(Global.HookID, nCode, wParam, lParam); end; end; end;

Всё это конечно зорово работает, но когда активны другие контролы клава зеркалится на Ctrl+C в котроле и в TWebBrowsere

Возможные решения таковы:

1) Идеальное. Отловить Messages в TWebBrowser . Проблемы: у контрола нет OnMessages, форма собылия браузера вообще не видит, а перекрытия для браузера WndProc( Msg ) в KOL я как бы не нашел.
2) Голимое. Определить имеет ли фокус TWebBrowser и только тогда давать жить хуку. Проблемы: гы. уже писал. Не знаю как определить имеет ли браузер фокус.
3) То ли в Run то ли в WndFunc ловить всё что есть и там уже выяснять браузеру это не браузеру, клава, не клава... Проблема: примерчик бы.

Мысли, пожелания, замечания и критика приветствуются.

← →
Дмитрий К © (2008-01-29 01:12) [6]

> 1) Идеальное. Отловить Messages в TWebBrowser . Проблемы:
> у контрола нет OnMessages, форма собылия браузера вообще
> не видит, а перекрытия для браузера WndProc( Msg ) в KOL
> я как бы не нашел.

A Set/GetWindowLong с GWL_WNDPROC не подойдет?

← →
Дмитрий К © (2008-01-29 01:52) [7]

Вот код, в котором, по-моему, перекрывается то что нужно. Если нет - прошу сильно не пинать :)
program Project1; uses windows, messages, kol, kolwebbrowser; type PForm1 = ^TForm1; TForm1 = object(TObj) private form, btn1: pcontrol; html: PKOLWebBrowser; procedure btn1Click(Sender: PObj); end; procedure NewForm1(var Result: PForm1; APArent: PControl); begin New(Result, Create); with Result^ do begin form := NewForm(APArent, "WebBrowser"); Applet := form; form.Add2AutoFree(Result); html := NewKOLWebBrowser(form); PControl(html).SetSize(600,500).ResizeParentRight; html.Navigate("http://delphimaster.net/view/11-1201479526/"); btn1 := NewButton(form, "btn1").PlaceUnder.ResizeParentBottom; btn1.OnClick := btn1Click; end; end; var Form1: PForm1; p: Pointer; wbwnd: HWND; function WndProc(wnd: HWND; msg: Cardinal; wParam, lParam: Integer): Integer; stdcall; var s: string; begin s := int2str(msg) + " " + int2str(wParam) + " " + int2str(lParam); SendMessage(form1.form.Handle, wm_setText, 0, integer(pchar(s))); result := CallWindowProc(p,wnd, msg, wParam, lParam); end; { TForm1 } procedure TForm1.btn1Click(Sender: PObj); begin wbwnd := FindWindowEx(html.Handle,0,"Shell DocObject View",nil); wbwnd := FindWindowEx(wbwnd,0,"Internet Explorer_Server",nil); p := Pointer(GetWindowLong(wbwnd,GWL_WNDPROC)); SetWindowLong(wbwnd, GWL_WNDPROC, integer(@wndproc)); end; begin NewForm1(Form1, nil); Run(Applet); end.

← →
Delphin2008 (2008-01-29 02:57) [8]

Спасибо, буду пробовать. Пока что вылетает при попытках вызывать в WndProc TranslateAccelerator. Попробую переслать форме и там обработать. Но уже завтра....

← →
Delphin2008 (2008-01-29 03:16) [9]

Ну не удержался попробовал сегодня. И пинать конечно не буду ;-).

Сообщения пересылаются при событиях навигации и некоторых случаях при первом после DocumetComplete выборе контрола на странице. На клаву не реагирует к сожалению, а то было бы вообще в пять строк решение.

Но зато кривенькое решение уже получилось. По полученным сообщениям вкупе с Leave контролов KOL отлавливается передача фокуса а значит можно юзать вышеприведенный хук.

Спасибо ещё раз. Ежели нарою чего-нить краше - отпишусь.

> Компонент TKOLWebBrowser не реагирует на Ctrl+X Delete и
> т.п. кнопки в формах HTML-страниц.

Вот так у меня заработало:
program Project1; uses windows, messages, kol, kolwebbrowser, activex; type PForm1 = ^TForm1; TForm1 = object(TObj) private form, btn1: pcontrol; html: PKOLWebBrowser; FOleInPlaceActiveObject: IOleInPlaceActiveObject; procedure btn1Click(Sender: PObj); end; procedure NewForm1(var Result: PForm1; APArent: PControl); begin New(Result, Create); with Result^ do begin form := NewForm(APArent, "WebBrowser"); Applet := form; form.Add2AutoFree(Result); html := NewKOLWebBrowser(form); PControl(html).SetSize(600,500).ResizeParentRight; html.Navigate("http://delphimaster.net/view/11-1201479526/"); btn1 := NewButton(form, "btn1").PlaceUnder.ResizeParentBottom; btn1.OnClick := btn1Click; end; end; var Form1: PForm1; p: Pointer; wbwnd: HWND; function WndProc(wnd: HWND; msg: Cardinal; wParam, lParam: Integer): Integer; stdcall; const DialogKeys: set of Byte = [VK_LEFT, VK_RIGHT, VK_BACK, VK_UP, VK_DOWN, $30..$39, $41..42, $44..$55, $57, $59..$5A]; var msg1: windows.TMsg; iOIPAO: IOleInPlaceActiveObject; Dispatch: IDispatch; begin msg1.hwnd := wnd; msg1.message := msg; msg1.wParam := wParam; msg1.lParam := lParam; if not form1.html.Busy then begin if form1.FOleInPlaceActiveObject = nil then begin Dispatch := form1.html.Application; if Dispatch <> nil then begin Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO); if iOIPAO <> nil then form1.FOleInPlaceActiveObject := iOIPAO; end; end; if form1.FOleInPlaceActiveObject <> nil then if ((Msg1.message = WM_KEYDOWN) or (Msg1.message = WM_KEYUP)) and (Msg1.wParam in DialogKeys) then else begin form1.FOleInPlaceActiveObject.TranslateAccelerator(Msg1); end; end; result := CallWindowProc(p, wnd, msg, wParam, lParam); end; { TForm1 } procedure TForm1.btn1Click(Sender: PObj); begin wbwnd := FindWindowEx(html.Handle,0,"Shell DocObject View",nil); wbwnd := FindWindowEx(wbwnd,0,"Internet Explorer_Server",nil); p := Pointer(GetWindowLong(wbwnd,GWL_WNDPROC)); SetWindowLong(wbwnd, GWL_WNDPROC, integer(@wndproc)); end; begin NewForm1(Form1, nil); Run(Applet); end.

Только с русскими буквами беда.

← →
Delphin2008 (2008-01-29 19:01) [12]

Супер. Спасибо огромнейшее. Пример работает на ура. Когда переношу в свою прогу рассыпается чё-то, видимо с хуками какие то конфликты возникают. Но это уже детали. Разберусь.

Прямо-таки выручили Вы меня. ЗдОрово ;-).

← →
имя (2008-07-23 03:28) [13]

Удалено модератором

Как перехватить сообщения когда WebBrowser в фокусе. Найти похожие ветки