Add a submenu to the system menu of a program

Problem/Question/Abstract:

I'm trying to insert a submenu into my application's system menu. Anyone have a code example of adding a submenu and menu items underneath that new submenu?

Answer:

Here's some sample code to play with:

{ ... }

procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
{ ... }

const
  SC_ITEM = $FF00; {Should be a multiple of 16}

procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
  {See if this is a command we added}
  if (Msg.CmdType and $FFF0) = SC_ITEM then
  begin
    ShowMessage('Item command received');
    Msg.Result := 0;
  end
  else
    inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  MenuItemInfo: TMenuItemInfo;
  PopupMenu: HMENU;
  Result: Boolean;
  SysMenu: HMenu;
begin
  {Create the popup menu}
  PopupMenu := CreatePopupMenu;
  Assert(PopupMenu <> 0);
  {Insert an item into it}
  FillChar(MenuItemInfo, SizeOf(MenuItemInfo), 0);
  with MenuItemInfo do
  begin
    cbSize := SizeOf(MenuItemInfo);
    fMask := MIIM_TYPE or MIIM_ID;
    fType := MFT_STRING;
    wID := SC_ITEM;
    dwTypeData := PChar('Item');
    cch := 4; {'Item' is 4 chars}
  end;
  Result := InsertMenuItem(PopupMenu, 0, True, MenuItemInfo);
  Assert(Result, 'InsertMenuItem failed');
  {Insert the popup into the system menu}
  FillChar(MenuItemInfo, SizeOf(MenuItemInfo), 0);
  with MenuItemInfo do
  begin
    cbSize := SizeOf(MenuItemInfo);
    fMask := MIIM_SUBMENU or MIIM_TYPE;
    fType := MFT_STRING;
    hSubMenu := PopupMenu;
    dwTypeData := PChar('SubMenu');
    cch := 7; {'SubMenu' is 7 chars}
  end;
  SysMenu := GetSystemMenu(Handle, False);
  Assert(SysMenu <> 0);
  Result := InsertMenuItem(SysMenu, GetMenuItemCount(SysMenu), True, MenuItemInfo);
  Assert(Result, 'InsertMenuItem failed');
end;