Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

Перехватить WM_CONTEXTMENU в TWebBrowser

Delphi , Интернет и Сети , Браузер

Перехватить WM_CONTEXTMENU в TWebBrowser
Звонок в офис провайдера интернет:
- Алло! Это интернет?
- Да, слушаем Вас!
- Соедините с 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'; 
begin 
 case nCode < 0 of 
   True: 
     Result := CallNextHookEx(HookID, nCode, wParam, lParam) 
     else 
       case 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); 
           end 
           else 
             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); 
begin 
 if HookID <> 0 then 
   UnHookWindowsHookEx(HookID); 
end; 

Здесь по замыслу автора меню подменяется своим, но у меня не сработало (почему, не  разбирался):

// Для преобразования кликов правой кнопкой в клики левой,  раскомментировать

// {$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.

Предлагаю свой вариант, взято с Королевства, но немного переделано из-за глюкавости. Для использования достаточно подключить юнит в Uses и все (Исправлены глюки, которые досаждали)!


unit WbPopup;

interface

implementation

uses 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 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;
         if (TWebBrowser(WC).PopupMenu<>nil) and (WP=WM_RBUTTONUP) then
          begin
           if 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);

finalization
try
 UnhookWindowsHookEx(HMouseHook);
 Sleep(100);
 CloseHandle(HMouseHook);
except

end;
end.

Я бы рад помочь вам с вашим вопросом.

Код, который вы предоставили, является попыткой перехватить сообщение WM_CONTEXTMENU (также известное как правый клик) в компоненте TWebBrowser и предотвратить отображение стандартного контекстного меню. Цель - показать пользовательский контекстный меню вместо него.

Код использует Windows Hooks для достижения этого, конкретно hook WH_MOUSE. Когда происходит событие правого клика, он проверяет, является ли окно под курсором экранной инстанцией TWebBrowser и предотвращает отображение стандартного контекстного меню возвращая HC_SKIP.

Однако, у вашего оригинального кода есть несколько проблем:

  1. Переменная HookID не объявлена как глобальная переменная, что означает, что она будет потеряна, когда процедура выйдет из области видимости.
  2. Вызов UnHookWindowsHookEx не правильно реализован в событии FormDestroy.

Вот обновленная версия вашего кода, которая решает эти проблемы:

unit WbPopup;
interface
uses Windows, Controls, Messages, ShDocVw, Forms;
var
  HMouseHook: THandle;
  Pop: Boolean;
function MouseProc(nCode: Integer; wParam, lParam: Longint): Longint; stdcall;
begin
  Result := CallNextHookEx(HMouseHook, nCode, wParam, lParam);
  if nCode = HC_ACTION then
    begin
      // ... (rest of the code remains the same)
end;
initialization
HMouseHook := SetWindowsHookEx(WH_MOUSE, @MouseProc, HInstance, GetCurrentThreadID);
finalization
try
  UnhookWindowsHookEx(HMouseHook);
  Sleep(100); // wait for any pending messages to be processed
finally
  CloseHandle(HMouseHook);
end;
implementation
end.

В обновленном коде:

  1. Переменная HMouseHook объявлена как глобальная переменная, что обеспечивает доступ к ней в течение всего периода выполнения программы.
  2. Вызов UnHookWindowsHookEx правильно реализован в секции finalization.

В отношении вашего второго вопроса о том, почему пользовательский контекстный меню не отображается, я подозреваю, что это может быть вызвано тем, что вы пытаетесь отобразить пользовательский контекстный меню изнутри компонента TWebBrowser. Свойство PopupMenu компонента TWebBrowser используется для отображения стандартного браузера контекстного меню. Чтобы отобразить пользовательский контекстный меню, вам нужно создать свой собственный контекстный меню и обрабатывать его события вручную.

Надеюсь, это поможет! Если у вас есть какие-либо дальнейшие вопросы или проблемы, пожалуйста, не стесняйтесь обращаться.

Перехват WM_CONTEXTMENU в TWebBrowser: блокировка и изменение контекстного меню веб-браузера.


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Браузер ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-08-19 13:29:56
2024-11-21 12:24:37/0.0064730644226074/1