Как воздействовать на контекстное меню? , "отменить","вырезать","копировать",...

Здравствуйте. У меня такой вопрос - как "воздействовать" на стандартное меню, которое появляется при нажатии правой кнопки мыши в поле для ввода текста ("отменить","вырезать","копировать" и т.д.), например, в TEdit, TF1Book. В смысле, запретить/разрешить 1 из пуктов. По идее, надо ловить какое-то сообщение, но не знаю, какое. Думал - WM_CONTEXTMENU, WM_INITMENUPOPUP, нет, не то

Цитата

The EnableMenuItem function enables, disables, or grays the specified menu item.

BOOL EnableMenuItem(

HMENU hMenu, // handle to menu
UINT uIDEnableItem, // menu item to enable, disable, or gray
UINT uEnable // menu item flags
);

Эта функция получает хэндл меню и разрешает/запрещает его пункты. Как мне получить HMENU, если это не моё меню, т. е. в программе я его не создаю?

vet, HMENU родного меню EDIT'а, имхо ты никак не получишь. Можешь просто задать свое PopupMenu для TEdit'а

Edit1.PopupMenu:=PopupMenu1;

и делать с ним все, что душа пожелает.

Цитата Krid @ 10.02.05, 03:01

vet, HMENU родного меню EDIT'а, имхо ты никак не получишь.

Да ну брось ты, нет ничего не возможного

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus;
 
type
  TForm1 = class(TForm)
    Edit1: TEdit;
  private
    procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
  end;
 
var
  Form1: TForm1;
 
implementation
 
var
 HookHandle: DWORD = 0;
 
{$R *.dfm}
 
function MsgProc(Code: Integer; WParam: Integer; LParam: PCWPStruct): Integer; stdcall;
var
  Menu: HMENU;
  ItemCount, I: Integer;
begin
  if (Code = HC_ACTION) then
    case LPARAM.message of
      WM_MENUSELECT:
      begin
        Menu := LParam^.lParam; // Вот он хэндл меню
        ItemCount := GetMenuItemCount(Menu);
        for I := 0 to ItemCount - 1 do
          EnableMenuItem(Menu, GetMenuItemID(Menu, I), MF_DISABLED or MF_GRAYED);
        UnhookWindowsHookEx(HookHandle);
        HookHandle := 0;
      end;
      $01E2: // это типа заставляем реагировать на WM_MENUSELECT до появления окна...
        SendMessage(LPARAM.HWND, $1E5, 0, 0);
    end;
  MsgProc := CallNextHookEx(HookHandle, Code, WPARAM, DWORD(LPARAM));
end;
 
procedure TForm1.WMContextMenu(var Message: TWMContextMenu);
begin
  if HookHandle <> 0 then UnhookWindowsHookEx(HookHandle);
  HookHandle := SetWindowsHookEx(WH_CALLWNDPROC, @MsgProc, 0, GetCurrentThreadId);
end;
 
end.

Я и сам потом понял, что поспешил с выводами. Все-таки не надо забывать про подпись Song'а
Вот еще вариант

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
var
 fb:boolean=true;
 
function NewEditProc(wnd:HWND; uMsg:UINT; wParam:WPARAM; lParam:LPARAM):integer; stdcall;
const
 MN_SELECTITEM = $1E5;
begin
 case uMsg of
 WM_ENTERIDLE: if (wParam=MSGF_MENU) and fb then
               begin SendMessage(lParam, MN_SELECTITEM, 0, 0); fb:=false end;
 WM_MENUSELECT:
      begin
        if (lParam=0) and (HIWORD(DWORD(wParam))=word(-1)) then fb:=true else
        if fb then
        begin
         // извращаемся над меню  
         EnableMenuItem(lParam, GetMenuItemID(lParam, 2), MF_DISABLED or MF_GRAYED);
         DeleteMenu(lParam,1,MF_BYPOSITION);
         DeleteMenu(lParam,5,MF_BYPOSITION);
        end
      end;
 end;
   result:=CallWindowProc(Pointer(GetWindowLong(wnd,GWL_USERDATA)),wnd,uMsg,wParam,lParam)
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
 SetWindowLong(Edit1.Handle,GWL_USERDATA,SetWindowLong(Edit1.Handle, GWL_WNDPROC, LPARAM(@NewEditProc)))
end;
 
end.

Цитата Krid @ 10.02.05, 21:05

WM_ENTERIDLE: if (wParam=MSGF_MENU) and fb then
begin SendMessage(lParam, MN_SELECTITEM, 0, 0); fb:=false end;

во-во, это как раз та ж, о которой я так недавно говорил

Она самая
Это окно можно еще WinEventHook'ом достать, но это еще бОльшая ж.

Спасибо за помощь, значит, я в правильном направлении думал (WM_CONTEXTMENU). Работает, второй вариант ещё не пробовал. Ещё вопрос насчёт $01E2 - что это, в Messages такого нет?

А не подскажите как отследить движение мышки на компоненте PopupMenu? Интересует именно то, что нужно узнать над каким Item' ом он находится, т.к. у Item' ов нет свойства OnMouseMove.

Перехват сообщения WM_MENUSELECT (проще через хук как в #5), плюс код определения MenuItem по ItemID - можно взять из исходника TPopupList.WndProc в модуле menus.pas

Цитата leo @ 30.03.13, 14:17

Перехват сообщения WM_MENUSELECT (проще через хук как в #5), плюс код определения MenuItem по ItemID - можно взять из исходника TPopupList.WndProc в модуле menus.pas

Есть небольшой опыт, но он почему-то работает только с MainMenu, В чём проблема может быть?

unit main;
 
interface
uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, Menus, StdCtrls;
 
type
   TForm1 = class(TForm)
     lbl1: TLabel;
     suiPopupMenu1: TsuiPopupMenu;
   private
     procedure WmMenuSelect (var Message: TMessage); message WM_MENUSELECT;
   end;
 
var
   Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ TForm1 }
 
procedure TForm1.WmMenuSelect(var Message: TMessage);
var
   Item: TMenuItem;
   I: Integer;
begin
   Item := suiPopyupMenu1.FindItem(Message.LParam, fkHandle);
   if Assigned(Item) then
     for I := 0 to Item.Count - 1 do
       if Item.Items[I].Command = Message.WParamLo then
         lbl1.Caption:= Item.Items[I].Caption); //Записываем выбранный Item
end;
 
end.

Цитата eclipse_99 @ 30.03.13, 14:31

В чём проблема может быть?

В том, что родительским окном для всех PopupMenu является не форма, а PopupList.Window. Поэтому нужно либо подменять его WndProc через SetWindowLong, либо проще - использовать хук SetWindowHookEx

Код в #5\WM_CONTEXTMENU не работает при первом ПКМ на TEdit.
Но работает при ПКМ на самой форме.
Delphi XE3...

Сообщение отредактировано: BugMeNot - 31.03.13, 18:50

Цитата BugMeNot @ 31.03.13, 18:49

Код в #5\WM_CONTEXTMENU

Зачем тебе вообще WM_CONTEXTMENU? С ним такая же проблема, как и WM_MENUSELECT - шлется родительскому окну меню, которое не обязано быть именно формой.

Можно просто установить хук в FormCreate и снять в FormDestroy, а "включать\выключать" его установкой доп.глобальной переменной HookOn:boolean - если установлена, то что-то делаешь в процедуре хука, если нет, то сразу вызываешь CallNextHookEx

По мотивам этой темы добавил в системное меню TMemo пункт для изменения шрифта.
Но почемуто ни в какую не отлавливается WM_COMMAND ни на мой пункт, ни вообще ни на один виндовский пункт меню.

var
  Hook: HHOOK = 0;
  MemoPopupMenu: Boolean = False;
 
function CallWndProcHook(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
const
  IDChangeMemoFont = 6666;
 
   procedure ModifyMemoMenu(Menu: HMENU);
   begin
         if Menu = 0 then Exit;
//       ShowMessage(IntToStr(GetMenuItemCount(Menu)));
     AppendMenu(Menu, MF_SEPARATOR, 0, nil);
     AppendMenu(Menu, MF_STRING, IDChangeMemoFont, 'Font...');
     MemoPopupMenu := False;
   end;
 
begin
  if code = HC_ACTION then
    with PCWPStruct(lparam)^ do
    case message of
      WM_COMMAND:
//        if hwnd = Form1.mmo1.Parent.Handle then
          with LongRec(wParam) do
            if
//            (Hi = 0) and
            (Lo = IDChangeMemoFont) then
              with TFontDialog.Create(Form1) do
              try
                Font := Form1.mmo1.Font;
                if Execute(Form1.Handle) then
                  Form1.mmo1.Font := Font;
              finally
                Free;
              end;
 
      WM_MENUSELECT:
        if MemoPopupMenu  then
          ModifyMemoMenu(lParam);
 
      WM_CONTEXTMENU:
        if hwnd = Form1.mmo1.Handle then
          MemoPopupMenu := True;
 
      $01E2: // это типа заставляем реагировать на WM_MENUSELECT до появления окна...
        if MemoPopupMenu then
          SendMessage(hwnd, $1E5, 0, 0);
    end;
 
  Result := CallNextHookEx(Hook, code, wparam, lparam);
end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Hook := SetWindowsHookEx(WH_CALLWNDPROC, CallWndProcHook, 0, GetCurrentThreadId);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnhookWindowsHookEx(Hook);
end;

Сообщение отредактировано: BugMeNot - 02.04.13, 15:18

В отличие от дельфийского TPopupMenu, "виндовские" контекстные меню не шлют нотификаций родительскому окну, используюя ф-ю TrackPopupMenu с флагами TPM_NONOTIFY+TPM_RETURNCMD, которая отрабатывает "по тихому" и просто возвращает ID выбранного пункта меню. Поэтому единственный надежный способ определить клик по своему добавленному пункту - это перехватывать саму функцию TrackPopupMenu. Ну или возиться с отлавливанием мышиного клика и определения пункта меню под курсором..

Решено. Оказывается ID меню это код сообщения. Остается подобрать ID, не совпадающий с реально существующими сообщениями, а потом поймать и обработать. Решение подсмотрел в гугле "Modify right-click context menu in standard controls".
Также рекомендуют, постоянно включенным хук не держать.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, AppEvnts;
 
type
  TForm1 = class(TForm)
    Mmo1: TMemo;
    FontDialog1: TFontDialog;
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
var
Hook: HHOOK = 0;
MemoPopupMenu: Boolean = False;
 
function CallWndProcHook(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT stdcall;
var
  idd: integer;
 
procedure ModifyMemoMenu(Menu: HMENU);
begin
if Menu = 0 then Exit;
// ShowMessage(IntToStr(GetMenuItemCount(Menu)));
AppendMenu(Menu, MF_SEPARATOR, 0, nil);
AppendMenu(Menu, MF_STRING, WM_APP Or 111, 'Font...');
MemoPopupMenu := False;
end;
 
begin
  if code = HC_ACTION then
    with PCWPStruct(lparam)^ do
    if ( ( WM_APP and message )  = WM_APP)    then
    begin
     idd := (message xor wm_app);
     if idd = 111 then
        showmessage('Font!!!')
  end
else
  case message of
 
  WM_MENUSELECT:
     if MemoPopupMenu then
      ModifyMemoMenu(lParam);
 
  WM_CONTEXTMENU:
    if hwnd = Form1.mmo1.Handle then
      MemoPopupMenu := True;
 
  $01E2: // это типа заставляем реагировать на WM_MENUSELECT до появления окна...
    if MemoPopupMenu then
      SendMessage(hwnd, $1E5, 0, 0);
end;
 
Result := CallNextHookEx(Hook, code, wparam, lparam);
end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
Hook := SetWindowsHookEx(WH_CALLWNDPROC, CallWndProcHook, 0, GetCurrentThreadId);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
   UnhookWindowsHookEx(Hook);
end;
 
end.

Сообщение отредактировано: SamBellamy - 13.01.20, 18:30

Стандартное заглушите, на правую кнопку поставьте свое

    case WM_CUT:
        return 0;
    case WM_COPY:
        return 0;
    case WM_PASTE:
        return 0;
    case WM_CONTEXTMENU:
        return 0;
    case WM_RBUTTONDOWN:
        TrackPopupMenu(e::hpopupmenuedit, 0, point.x, point.y, 0, hwnd, NULL);