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

Советы » Браузер » Перехватить WM_CONTEXTMENU в TWebBrowser

Перехват меню (ТОЛЬКО БЛОКИРОВКА):

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

.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com