Звонок в офис провайдера интернет:
- Алло! Это интернет?
- Да, слушаем Вас!
- Соедините с 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 раздела Интернет и Сети Браузер может быть полезна для разработчиков на Delphi и FreePascal.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.