// Способ первый
TForm1 = class(TForm)
  MainMenu1: TMainMenu;
  HelpItem1: TMenuItem;
  Help1: TMenuItem;
  File: TMenuItem;
  Save: TMenuItem;
  {...}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ModifyMenu(MainMenu1.Handle, 0 {Порядковый номер выравниваемого пункта верхнего уровня},
             MF_BYPOSITION or MF_POPUP or MF_HELP, HelpItem1.Handle, 
             Pchar(HelpItem1.Caption));
end;

// Способ второй
procedure TForm1.FormCreate(Sender: TObject);
var
  mii: TMenuItemInfo;
  MainMenu: HMENU;
  Buffer: array[0..79] of Char;
begin
  MainMenu := Self.Menu.Handle;

  // GET Help Menu Item Info
  mii.cbSize := SizeOf(mii);
  mii.fMask := MIIM_TYPE;
  mii.dwTypeData := Buffer;
  mii.cch := SizeOf(Buffer);
  GetMenuItemInfo(MainMenu, HelpMenuItem.Command {выравниваемый пункт верхнего уровня}, False, mii) ;

  // SET Help Menu Item Info
  mii.fType := mii.fType or MFT_RIGHTJUSTIFY;
  SetMenuItemInfo(MainMenu, HelpMenuItem.Command {выравниваемый пункт верхнего уровня}, False, mii) ;
end;

procedure TForm1.ExtendSysMenu(HNDL: THandle; AddMenu: TMainMenu);
var
  i: Integer;
begin
  // Проверяем ссылка на объект
  if (AddMenu = nil) or (HNDL = 0) then
    Exit;
  // Добавляем разделитель
  AppendMenu(GetSystemMenu(HNDL, False), MF_SEPARATOR, 0, '');
  with AddMenu do
    for i := 0 to Items.Count-1 do
      AppendMenu(GetSystemMenu( HNDL, False),
                 MF_POPUP, Items[i].Handle,
                 PChar(Items[i].Caption));
end;

// На форме должно находиться MainMenu
procedure TForm1.FormCreate(Sender: TObject);
begin
  ExtendSysMenu(Application.Handle, MainMenu1);
  ExtendSysMenu(Form1.Handle, MainMenu1);
end;

// Hint, назначенный Item, можно показать в StatusBar:

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure AppHint(Sender: TObject);
  public
    { Public declarations }
  end;

procedure TForm1.AppHint(Sender: TObject);
begin
  StatusBar1.SimpleText := Application.Hint;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnHint := AppHint;
end;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    {...}
    procedure FormCreate(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseActivate(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y, HitTest: Integer;
      var MouseActivate: TMouseActivate);
  private
    function GetMenuVisible: Boolean;
    procedure SetMenuVisible(const Value: Boolean);
  public
    property MenuVisible: Boolean read GetMenuVisible write SetMenuVisible;
  end;

{...}

procedure TForm1.FormCreate(Sender: TObject);
begin
  KeyPreview := True;
  Menu := nil;
end;

function TForm1.GetMenuVisible: Boolean;
begin
  Result := Assigned(Menu);
end;

procedure TForm1.SetMenuVisible(const Value: Boolean);
begin
  if Value = MenuVisible then
    Exit;

  DisableAlign; // Для предотвращения мерцания
  try
    if Value then
      Menu := MainMenu1
    else
      Menu := nil;

    // При желании можно увеличивать высоту окна при появлении меню и уменьшать его при скрытии.
    // Таким образом установленный пользователем размер рабочей области окна приложения не будет изменяться.
    //if WindowState <> wsMaximized then
    //   Height := Height + GetSystemMetrics(SM_CYMENU) *
    //             (Ord(Value) or Ord(not Value) * -1);
  finally
    EnableAlign; // Для предотвращения мерцания
  end;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_MENU: MenuVisible := not MenuVisible;
    VK_ESCAPE: MenuVisible := False; // Скрытие меню по нажатию ESC
  end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  // Скрытие меню по шелчку мыши на форме
  if MenuVisible then
    MenuVisible := False;
end;

procedure TForm1.FormMouseActivate(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y, HitTest: Integer;
  var MouseActivate: TMouseActivate);
begin
  // Скрытие меню по шелчку мыши на контролах
  if MenuVisible then
    MenuVisible := False;
end;

unit ExPopupList;

interface

uses
  Controls; // for CM_BASE

const
  CM_MENUCLOSED = CM_BASE-1;
  CM_ENTERMENULOOP = CM_BASE-2;
  CM_EXITMENULOOP = CM_BASE-3;

implementation

uses
  Messages, Forms, Menus;

type
  TExPopupList = class(TPopupList)
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

{ TMyPopupList }

procedure TExPopupList.WndProc(var Message: TMessage);

  procedure Send(Msg: Integer);
  begin
    if Assigned(Screen.ActiveForm) then
      Screen.ActiveForm.Perform(Msg, Message.WParam, Message.LParam);
  end;

begin
  case message.Msg of
    WM_ENTERMENULOOP: Send(CM_ENTERMENULOOP);
    WM_EXITMENULOOP: Send(CM_EXITMENULOOP);
    WM_MENUSELECT:
    with TWMMenuSelect(Message) do
      if (MenuFlag = $FFFF) and (Menu = 0) then
        Send(CM_MENUCLOSED);
  end;
  inherited;
end;

initialization
  PopupList.Free;
  PopupList := TExPopupList.Create;
  // Note: will be freed by Finalization section of Menus unit.

end.

// ====================

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, ExPopupList;

type
  TForm1 = class(TForm)
    Button1: TButton;
    PopupMenu1: TPopupMenu;
    N11: TMenuItem;
    Memo1: TMemo;
  private
    procedure CMMenuClosed(var Msg: TMessage); message CM_MENUCLOSED;
    procedure CMEnterMenuLoop(var Msg: TMessage); message CM_ENTERMENULOOP;
    procedure CMExitMenuLoop(var Msg: TMessage); message CM_EXITMENULOOP;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CMEnterMenuLoop(var Msg: TMessage);
begin
  Memo1.Lines.add('Enter menu loop');
end;

procedure TForm1.CMExitMenuLoop(var Msg: TMessage);
begin
  Memo1.Lines.add('Exit menu loop');
end;

procedure TForm1.CMMenuClosed(var Msg: TMessage);
begin
  Memo1.Lines.add('Menu closed');
end;

end.

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  p: TPoint;
begin
  p := ClientToScreen(Point(X, Y));
  TrackPopupMenu(PopupMenu1.Handle, TPM_RIGHTALIGN, p.X, p.Y, 0, PopupList.Window, nil);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Info: TMenuInfo;
begin
  FillChar(Info, SizeOf(Info), 0);
  Info.cbSize := SizeOf(Info);
  Info.fMask := MIM_APPLYTOSUBMENUS or MIM_BACKGROUND;
  Info.hbrBack := GetStockObject(WHITE_BRUSH);
  SetMenuInfo(MainMenu1.Handle, Info);
  // SetMenuInfo(PopupMenu1.Handle, Info);
  DrawMenuBar(Handle);
end;

// Способ первый
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  p: TPoint;
begin
  p := ClientToScreen(Point(X, Y));
  if Button = mbRight then
    PopupMenu1.Popup(p.X, p.Y);
end;

// Способ второй
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  p: TPoint;
begin
  p := ClientToScreen(Point(X, Y));
  TrackPopupMenu(PopupMenu1.Handle, TPM_TOPALIGN or TPM_LEFTALIGN, p.X, p.Y, 0, PopupList.Window, nil);
end;

// Способ первый
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  // Подходит только для PopupMenu
  SendMessage(PopupList.Window, WM_CANCELMODE, 0, 0);
end;

// Способ второй
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  EndMenu;
end;