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

По мотивам этой темы добавил в системное меню 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);