Звонок в офис провайдера интернет:
- Алло! Это интернет?
- Да, слушаем Вас!
- Соедините с www.yahoo.com.
Перехват меню (ТОЛЬКО БЛОКИРОВКА):
var
HookID: THandle;
function MouseProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
var
szClassName: array[0..255] of Char;
const
ie_name = 'Internet Explorer_Server';
begincase nCode < 0 ofTrue:
Result := CallNextHookEx(HookID, nCode, wParam, lParam)
elsecase wParam of
WM_RBUTTONDOWN,
WM_RBUTTONUP:
begin
GetClassName(PMOUSEHOOKSTRUCT(lParam)^.HWND, szClassName, SizeOf(szClassName));
if lstrcmp(@szClassName[0], @ie_name[1]) = 0 then
Result := HC_SKIP
else
Result := CallNextHookEx(HookID, nCode, wParam, lParam);
endelse
Result := CallNextHookEx(HookID, nCode, wParam, lParam);
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
HookID := SetWindowsHookEx(WH_MOUSE, MouseProc, 0, GetCurrentThreadId());
end;
procedure TForm1.FormDestroy(Sender: TObject);
beginif HookID <> 0 then
UnHookWindowsHookEx(HookID);
end;
Здесь по замыслу автора меню подменяется своим, но у меня не сработало (почему, не разбирался):
// Для преобразования кликов правой кнопкой в клики левой, раскомментировать
// {$DEFINE __R_TO_L}implementationuses 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 thenbegin
MHS:=PMOUSEHOOKSTRUCT(LP)^;
if ((WP=WM_RBUTTONDOWN) or (WP=WM_RBUTTONUP)) thenbegin
WC:=FindVCLWindow(MHS.pt);
if (WC is TWebBrowser) thenbegin
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) thenbegin
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.
Предлагаю свой вариант, взято с Королевства,
но немного переделано из-за глюкавости. Для
использования достаточно подключить юнит в
Uses и все (Исправлены глюки, которые
досаждали)!
unit WbPopup;
interfaceimplementationuses Windows,Controls,Messages,ShDocVw, Forms, frmMain;
var
HMouseHook:THandle;
Pop: Boolean;
function MouseProc(
nCode: Integer; // hook code
WP: wParam; // message identifier
LP: lParam // mouse coordinates
):Integer;stdcall;
var MHS:TMOUSEHOOKSTRUCT;
WC:TWinControl;
begin
Result:=CallNextHookEx(HMouseHook,nCode,WP,LP);
if nCode=HC_ACTION thenbegin
MHS:=PMOUSEHOOKSTRUCT(LP)^;
if ((WP=WM_RBUTTONDOWN) or (WP=WM_RBUTTONUP)) thenbegin
WC:=FindVCLWindow(MHS.pt);
if (WC is TWebBrowser) thenbegin
Result:=1;
if (TWebBrowser(WC).PopupMenu<>nil) and (WP=WM_RBUTTONUP) thenbeginif Pop then Exit;
Pop := True;
TWebBrowser(WC).PopupMenu.Popup(MHS.pt.x,MHS.pt.y);
Pop := False;
end;
end;
end;
end;
end;
initialization
HMouseHook:=SetWindowsHookEx(WH_MOUSE,@MouseProc,HInstance,GetCurrentThreadID);
finalizationtry
UnhookWindowsHookEx(HMouseHook);
Sleep(100);
CloseHandle(HMouseHook);
exceptend;
end.
Я бы рад помочь вам с вашим вопросом.
Код, который вы предоставили, является попыткой перехватить сообщение WM_CONTEXTMENU (также известное как правый клик) в компоненте TWebBrowser и предотвратить отображение стандартного контекстного меню. Цель - показать пользовательский контекстный меню вместо него.
Код использует Windows Hooks для достижения этого, конкретно hook WH_MOUSE. Когда происходит событие правого клика, он проверяет, является ли окно под курсором экранной инстанцией TWebBrowser и предотвращает отображение стандартного контекстного меню возвращая HC_SKIP.
Однако, у вашего оригинального кода есть несколько проблем:
Переменная HookID не объявлена как глобальная переменная, что означает, что она будет потеряна, когда процедура выйдет из области видимости.
Вызов UnHookWindowsHookEx не правильно реализован в событии FormDestroy.
Вот обновленная версия вашего кода, которая решает эти проблемы:
unitWbPopup;interfaceusesWindows,Controls,Messages,ShDocVw,Forms;varHMouseHook:THandle;Pop:Boolean;functionMouseProc(nCode:Integer;wParam,lParam:Longint):Longint;stdcall;beginResult:=CallNextHookEx(HMouseHook,nCode,wParam,lParam);ifnCode=HC_ACTIONthenbegin// ... (rest of the code remains the same)end;initializationHMouseHook:=SetWindowsHookEx(WH_MOUSE,@MouseProc,HInstance,GetCurrentThreadID);finalizationtryUnhookWindowsHookEx(HMouseHook);Sleep(100);// wait for any pending messages to be processedfinallyCloseHandle(HMouseHook);end;implementationend.
В обновленном коде:
Переменная HMouseHook объявлена как глобальная переменная, что обеспечивает доступ к ней в течение всего периода выполнения программы.
Вызов UnHookWindowsHookEx правильно реализован в секции finalization.
В отношении вашего второго вопроса о том, почему пользовательский контекстный меню не отображается, я подозреваю, что это может быть вызвано тем, что вы пытаетесь отобразить пользовательский контекстный меню изнутри компонента TWebBrowser. Свойство PopupMenu компонента TWebBrowser используется для отображения стандартного браузера контекстного меню. Чтобы отобразить пользовательский контекстный меню, вам нужно создать свой собственный контекстный меню и обрабатывать его события вручную.
Надеюсь, это поможет! Если у вас есть какие-либо дальнейшие вопросы или проблемы, пожалуйста, не стесняйтесь обращаться.
Перехват WM_CONTEXTMENU в TWebBrowser: блокировка и изменение контекстного меню веб-браузера.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.