На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! user posted image
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.

Соблюдайте общие правила форума

Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как запустить программу/файл? (и дождаться ее завершения)
5. Как перехватить API-функции, поставить hook? (перехват сообщений от мыши, клавиатуры - внедрение в удаленное адресное прстранство)
... (продолжение следует) ...

Внимание:
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки - бан.
Мат в разделе - бан на три месяца...

Полезные ссылки:
user posted image MSDN Library user posted image FAQ раздела user posted image Поиск по разделу user posted image Как правильно задавать вопросы


Выразить свое отношение к модераторам раздела можно здесь: user posted image Rouse_, user posted image Krid

Модераторы: Rouse_, Krid
  
> Как воздействовать на контекстное меню?, "отменить","вырезать","копировать",...
    Здравствуйте. У меня такой вопрос - как "воздействовать" на стандартное меню, которое появляется при нажатии правой кнопки мыши в поле для ввода текста ("отменить","вырезать","копировать" и т.д.), например, в 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'а
          ExpandedWrap disabled
            Edit1.PopupMenu:=PopupMenu1;

          и делать с ним все, что душа пожелает.
          Кто рано встает, тому целый день спать хочется
            Цитата Krid @
            vet, HMENU родного меню EDIT'а, имхо ты никак не получишь.

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

            ExpandedWrap disabled
              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.
            user posted image
            В русском языке есть слова, их там много.
            Когда их составляешь вместе, получается предложение, где есть сказуемое, подлежащее и прочая светотень.
            В нём переставь местоимение, сказуемое и подлежащее, и появится интонация!
              :yes:
              Я и сам потом понял, что поспешил с выводами. Все-таки не надо забывать про подпись Song:)
              Вот еще вариант
              ExpandedWrap disabled
                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 @
                WM_ENTERIDLE: if (wParam=MSGF_MENU) and fb then
                begin SendMessage(lParam, MN_SELECTITEM, 0, 0); fb:=false end;

                во-во, это как раз та ж, о которой я так недавно говорил :lol:
                  Она самая :)
                  Это окно можно еще WinEventHook'ом достать, но это еще бОльшая ж. :)
                  Кто рано встает, тому целый день спать хочется
                    Спасибо за помощь, значит, я в правильном направлении думал (WM_CONTEXTMENU). Работает, второй вариант ещё не пробовал. Ещё вопрос насчёт $01E2 - что это, в Messages такого нет?
                      А не подскажите как отследить движение мышки на компоненте PopupMenu? Интересует именно то, что нужно узнать над каким Item' ом он находится, т.к. у Item' ов нет свойства OnMouseMove.
                        Перехват сообщения WM_MENUSELECT (проще через хук как в #5), плюс код определения MenuItem по ItemID - можно взять из исходника TPopupList.WndProc в модуле menus.pas
                          Цитата leo @
                          Перехват сообщения WM_MENUSELECT (проще через хук как в #5), плюс код определения MenuItem по ItemID - можно взять из исходника TPopupList.WndProc в модуле menus.pas

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

                          ExpandedWrap disabled
                            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 @
                            В чём проблема может быть?

                            В том, что родительским окном для всех PopupMenu является не форма, а PopupList.Window. Поэтому нужно либо подменять его WndProc через SetWindowLong, либо проще - использовать хук SetWindowHookEx
                              Код в #5\WM_CONTEXTMENU не работает при первом ПКМ на TEdit.
                              Но работает при ПКМ на самой форме.
                              Delphi XE3...
                              Сообщение отредактировано: BugMeNot -
                                Цитата BugMeNot @
                                Код в #5\WM_CONTEXTMENU

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

                                Можно просто установить хук в FormCreate и снять в FormDestroy, а "включать\выключать" его установкой доп.глобальной переменной HookOn:boolean - если установлена, то что-то делаешь в процедуре хука, если нет, то сразу вызываешь CallNextHookEx
                                  По мотивам этой темы добавил в системное меню TMemo пункт для изменения шрифта.
                                  Но почемуто ни в какую не отлавливается WM_COMMAND ни на мой пункт, ни вообще ни на один виндовский пункт меню.
                                  ExpandedWrap disabled
                                    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 -
                                    В отличие от дельфийского TPopupMenu, "виндовские" контекстные меню не шлют нотификаций родительскому окну, используюя ф-ю TrackPopupMenu с флагами TPM_NONOTIFY+TPM_RETURNCMD, которая отрабатывает "по тихому" и просто возвращает ID выбранного пункта меню. Поэтому единственный надежный способ определить клик по своему добавленному пункту - это перехватывать саму функцию TrackPopupMenu. Ну или возиться с отлавливанием мышиного клика и определения пункта меню под курсором..
                                      Решено. Оказывается ID меню это код сообщения. Остается подобрать ID, не совпадающий с реально существующими сообщениями, а потом поймать и обработать. Решение подсмотрел в гугле "Modify right-click context menu in standard controls".
                                      Также рекомендуют, постоянно включенным хук не держать.


                                      ExpandedWrap disabled
                                        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 -
                                      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                                      0 пользователей:


                                      Рейтинг@Mail.ru
                                      [ Script Execution time: 0,1353 ]   [ 17 queries used ]   [ Generated: 15.07.20, 16:45 GMT ]