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

На форме имеется кнопка 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.