Titlebar rightclick menu 1

[mobiusonline]

I would like to add 2 option to the titlebar right click menu of my application. I can not find any details about this anywhere, and am hoping someone might be able to point me in the right direction.

The 2 options I want is 'Settings' and 'About".

I have included a screenshot of another application that has this feature to help clarify what I am looking for.

nerddisk.com/screenshot.png

Thanks,
M

 

[whosrdaddy]

aah, you mean the system menu!

this involves a bit work:

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:

....
// 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;

Cheers,
Daddy

-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!