Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  3 670

•  TDictionary Custom Sort  5 800

•  Fast Watermark Sources  5 603

•  3D Designer  8 218

•  Sik Screen Capture  5 913

•  Patch Maker  6 388

•  Айболит (remote control)  6 378

•  ListBox Drag & Drop  5 237

•  Доска для игры Реверси  94 551

•  Графические эффекты  6 570

•  Рисование по маске  5 644

•  Перетаскивание изображений  4 760

•  Canvas Drawing  5 135

•  Рисование Луны  4 863

•  Поворот изображения  4 411

•  Рисование стержней  3 116

•  Paint on Shape  2 360

•  Генератор кроссвордов  3 228

•  Головоломка Paletto  2 551

•  Теорема Монжа об окружностях  3 328

•  Пазл Numbrix  2 200

•  Заборы и коммивояжеры  2 849

•  Игра HIP  1 820

•  Игра Go (Го)  1 740

•  Симулятор лифта  2 072

•  Программа укладки плитки  1 798

•  Генератор лабиринта  2 240

•  Проверка числового ввода  1 925

•  HEX View  2 226

•  Физический маятник  1 911

 
скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Перехватить 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.








Copyright © 2004-2025 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте