Как динамически создать PopupMenu

Тема в разделе "Delphi", создана пользователем WinHack, 23 ноя 2016.

  1. WinHack
    Хотите создать всплывающее контекстное меню в любой позиции? Например, сверху от кнопки... Это можно сделать при помощи TrackPopupMenuEx.

    popup-menu-on-button.png
    На форме имеется кнопка Button1, для которой будем создавать меню и TMemo (Memo1), в котором будем проверять действие команд меню.

    Исходный код:

    Код:
    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls,
      Forms, Dialogs, StdCtrls, ExtCtrls, Menus;
    
    const
      //наши ID сообщений
      WM_1TEST = WM_USER + 101;
      WM_2TEST = WM_USER + 102;
      WM_3TEST = WM_USER + 103;
    
    type
      TForm1 = class(TForm)
        Button1: TButton;
        Memo1: TMemo;
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      protected
        procedure WMCommand(
                var Msg: TWMCommand); message WM_COMMAND;
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    { TForm1 }
    
    procedure TForm1.WMCommand(var Msg: TWMCommand);
    begin
      case Msg.ItemID of //<- Msg.ItemID содержит WM_USER + x
        WM_1TEST : Memo1.Lines.Add('Command 1');
        WM_2TEST : Memo1.Lines.Add('Command 2');
        WM_3TEST : Memo1.Lines.Add('Command 3');
      end;
      inherited; //<- Важно для Windows-MessageHandling
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    var
      MyPopUpMenu : TPopUpMenu;
      MyMsg : LongBool;
    begin
      MyPopUpMenu := TPopUpMenu.Create(Self);
      MyPopUpMenu.AutoPopup   := FALSE;
      MyPopUpMenu.AutoHotkeys := maManual;
    
      { Создаем пункты меню
        AppendMenu здесь достаточно, если просто обрабатывать OnClickEvent
        можно даже использовать с if или case, если не хотите обрабатывать все
        пункты каждый раз }
      AppendMenu(MyPopUpMenu.Handle
                 , MF_POPUP //<- каждый пункт на отдельной строке
                 // иначе используйте
                 // MF_MENUBREAK для столбцов с пунктами меню (все на одной строке)
                 // MF_MENUBARBREAK для столбцов с разделителем
                 or MF_STRING or MF_UNCHECKED
                 , WM_1TEST  //<- Важно WM_USER+x идентифицирует Msg в WMCommand
                 , 'Test1'); // Заголовок пункта меню
      AppendMenu(MyPopUpMenu.Handle
                 , MF_POPUP or MF_STRING or MF_UNCHECKED
                 , WM_2TEST  //<- Важно WM_USER+x идентифицирует Msg в WMCommand
                 , 'Test2');
      AppendMenu(MyPopUpMenu.Handle
                 , MF_POPUP or MF_STRING or MF_UNCHECKED
                 , WM_3TEST  //<- Важно WM_USER+x идентифицирует Msg в WMCommand
                 , 'Test3');
    
    
      MyMsg := TrackPopupMenuEx(MyPopUpMenu.Handle // PopUpMenu для показа
                      // Определяем точку выравнивания!
                      //  горизонталь         вертикаль
                      , TPM_LEFTALIGN   or TPM_BOTTOMALIGN
                      //в этом случае слева вверху
                      //, TPM_LEFTALIGN   or TPM_TOPALIGN
                      //, TPM_LEFTALIGN   or TPM_VCENTERALIGN
                      //, TPM_RIGHTALIGN  or TPM_BOTTOMALIGN
                      //, TPM_RIGHTALIGN  or TPM_TOPALIGN
                      //, TPM_RIGHTALIGN  or TPM_VCENTERALIGN
                      //, TPM_CENTERALIGN or TPM_BOTTOMALIGN
                      //, TPM_CENTERALIGN or TPM_TOPALIGN
                      //, TPM_CENTERALIGN or TPM_VCENTERALIGN
    
                      //or TPM_VERTICAL or TPM_HORIZONTAL
                      //Вы могли определить область перекрытия PopUpMenu
                      //но Вы должны определить структуру TPMPARAMS(~TRect) (last Param)
                        or TPM_RETURNCMD  //Возвращает идентификатор пункта, по которому щелкнули
                        //or TPM_NONOTIFY //никакое сообщение не посылается
                        or TPM_LEFTBUTTON //выбор левой кнопкой
                        //or TPM_RIGHTBUTTON //выбор правой кнопкай
                        //or TPM_LEFTBUTTON or TPM_RIGHTBUTTON// или обеими
                        or TPM_HORPOSANIMATION or TPM_VERNEGANIMATION
                        //^эти настройки смотрятся лучше всего с TPM_LEFTALIGN и TPM_BOTTOMALIGN
                        //может также быть:
                        //TPM_NOANIMATION
    
                        //or TPM_HORNEGANIMATION or TPM_VERPOSANIMATION
                      , TControl(Sender).ClientOrigin.x //Origin of Menu X
                        //+TControl(Sender).Width //используйте TPM_RIGHTALIGN и TPM_BOTTOMALIGN
                      , TControl(Sender).ClientOrigin.y //начало меню Y
                      //Левая верхняя точка управления, где Вы хотите разместить меню
    
                      , Self.Handle //<- Дескриптор Window/Application
                      , nil); //<- структура TPMPARAMS, nil , заставляем PopUp Menu быть слева и вверху
      if MyMsg then //<- TrackPopUpMenuEx возвращает TRUE если все хорошо
        SendMessage(Self.Handle //<- посылаем сообщение окну
                   , WM_COMMAND //<- Тип сообщения
                   , Integer(MyMsg) //<- Param, т.е. ReturnValue  TrackPopUpMenuEx
                   , 0);
    
      MyPopUpMenu.Free; //<- уничтожаем созданное PopUpMenu
      MyPopUpMenu := nil;
    end;
    
    end.