Перехват меню IE ( TWebBrowser ) и подмена его собственным PopupMenu
| Раздел Сокровищница | рь Серебренников , дата публикации 29 августа 2001г. |
После ответа на вопрос КС о блокировании контекстного меню IE (), получил кучку писем с просьбой выслать модуль, который это делает.
Думаю, такая информация полезна для народа.
Модуль просто подключается к проекту. После этого все меню (TWebBrowser.PopupMenu) начинают работать нормально.
unit WbPopup; interface // Для преобразования кликов правой кнопкой в клики левой, раскомментировать // {$DEFINE __R_TO_L} implementation uses Windows,Controls,Messages,ShDocVw; var HMouseHook:THandle; function MouseProc( nCode: Integer; // hook code WP: wParam; // message identifier LP: lParam // mouse coordinates ):Integer;stdcall; var MHS:TMOUSEHOOKSTRUCT; WC:TWinControl; {$ifdef __R_TO_L} P:TPoint; {$endif} begin Result:=CallNextHookEx(HMouseHook,nCode,WP,LP); if nCode=HC_ACTION then begin MHS:=PMOUSEHOOKSTRUCT(LP)^; if ((WP=WM_RBUTTONDOWN) or (WP=WM_RBUTTONUP)) then begin WC:=FindVCLWindow(MHS.pt); if (WC is TWebBrowser) then begin Result:=1; {$ifdef __R_TO_L} P:=WC.ScreenToClient(MHS.pt); if WP=WM_RBUTTONDOWN then PostMessage(MHS.hwnd,WM_LBUTTONDOWN,0,P.x + P.y shl 16); if WP=WM_RBUTTONUP then PostMessage(MHS.hwnd,WM_LBUTTONUP,0,P.x + P.y shl 16); {$endif} if (TWebBrowser(WC).PopupMenu<>nil) and (WP=WM_RBUTTONUP) then begin TWebBrowser(WC).PopupMenu.PopupComponent:=WC; TWebBrowser(WC).PopupMenu.Popup(MHS.pt.x,MHS.pt.y); end; end; end; end; end; initialization HMouseHook:=SetWindowsHookEx(WH_MOUSE,@MouseProc,HInstance,GetCurrentThreadID); finalization CloseHandle(HMouseHook); end.
