PHP DM Gate v0.9 » Как перехватить сообщения когда WebBrowser в фокусе. <span class="vd">[Delphi]</span>

Delphin2008 (28.01.08 03:18) [0]

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

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

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

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

<Цитата>
Delphin2008 (28.01.08 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 © (28.01.08 08:22) [2]

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

<Цитата>
Delphin2008 (28.01.08 10:05) [3]

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

То что в VCL реализуется легким движением

initialization
OleInitialize(nil);

в KOL для меня оказывается неподъёмной задачей. Обидно.

<Цитата>
Delphin2008 (28.01.08 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 (29.01.08 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 ловить всё что есть и там уже выяснять браузеру это не браузеру, клава, не клава... Проблема: примерчик бы.

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

<Цитата>
Дмитрий К © (29.01.08 01:12) [6]

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

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

<Цитата>
Дмитрий К © (29.01.08 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://www.delphimaster.ru/cgi-bin/http://pda.delphimaster.net/?id=1201479526&n=10');
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 (29.01.08 02:57) [8]

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

<Цитата>
Delphin2008 (29.01.08 03:16) [9]

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

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

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

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

<Цитата>
Дмитрий К © (29.01.08 04:29) [10]

> Компонент 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://www.delphimaster.ru/cgi-bin/http://pda.delphimaster.net/?id=1201479526&n=10');
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.

<Цитата>
Дмитрий К © (29.01.08 04:37) [11]

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

<Цитата>
Delphin2008 (29.01.08 19:01) [12]

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

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

<Цитата>
~~имя~~ (23.07.08 03:28) [13]

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

<Цитата>