add system menu

来源:互联网 发布:js中对象的定义 编辑:程序博客网 时间:2024/06/07 14:20
procedure AddToSystemMenu(SysMenu : hMenu; Caption : string; CmdId : Integer);

var MenuItemInfo : TMenuItemInfo;
    Index        : Integer;

begin
 FillChar(MenuItemInfo, SizeOf(MenuItemInfo), 0);
 Index:=GetMenuItemCount(SysMenu);
 MenuItemInfo.cbSize := 44;
 if Caption = '-' then
  begin
   MenuItemInfo.fMask := MIIM_TYPE;
   MenuItemInfo.fType := MFT_SEPARATOR;
  end
 else
  begin
   MenuItemInfo.fMask := MIIM_TYPE or MIIM_ID;
   MenuItemInfo.fType := MFT_STRING;
   MenuItemInfo.dwTypeData := PChar(Caption);
   MenuItemInfo.cch := Length(Caption);
   MenuItemInfo.wID := CmdId; // ID must be < $F000
  end;
 InsertMenuItem(SysMenu, Index, True, MenuItemInfo);
end;



this is how to use it:

CODE

....
// own defined functions
const
  INT_FUNC_BASE            = $3000;
  INT_FUNC_ABOUT           = INT_FUNC_BASE + 1;
  INT_FUNC_WINDOWONTOP     = INT_FUNC_BASE + 2;
  STR_FUNC_ABOUT           = '&About...';
  STR_FUNC_WINDOWONTOP     = 'Window &Always On Top';

....

procedure TFrm_main.AdaptSystemMenu;

var SysMenu   : hMenu;

begin
 SysMenu := GetSystemMenu(Handle, False);
 if SysMenu > 0 then
  begin
   AddToSystemMenu(SysMenu, STR_FUNC_WINDOWONTOP, INT_FUNC_WINDOWONTOP);
   AddToSystemMenu(SysMenu, '-', 0); // add separator
   AddToSystemMenu(SysMenu, STR_FUNC_ABOUT, INT_FUNC_ABOUT);
  end;
end;

//to receive events from the system menu, we must implement WMSysCommand

... -> add this line to the private section of your form
    procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND; //needed for system menu items

...

procedure TFrm_main.WMSysCommand(var Msg : TWMSysCommand) ;
begin
 // repost system menu items to call window
 case Msg.CmdType of

  INT_FUNC_ABOUT    : ShowAboutDialog;
  INT_FUNC_WINDOWONTOP:
   begin
    AlwaysOnTop := not AlwaysOnTop;
   end
  else
   inherited; // normal sysmenu handling
 end;
end;
原创粉丝点击