1. Catch SHIFT key during menu item selection?
2. How to dynamically create popup menus inside other popups?
3. How do I add a bitmap to a MENU ...
4. How do I dynamically add a MenuItem to a Menu?
5. Hooking a procedure on to a dynamically created popup menu
6. Too long menus

Catch SHIFT key during menu item selection?

From: "Rodney E Geraghty" <gerarod@ibm.net>

procedure TForm1.Menu11Click(Sender: TObject);
begin
  {Check if Shift key is down}
  if HiWord(GetKeyState(VK_SHIFT)) <> 0 then
    Label1.Caption := 'Shift'
  else
    {Check if Ctrl key is down}
    if HiWord(GetKeyState(VK_CONTROL)) <> 0 then
      Label1.Caption := 'Control'
    else
      {Check if Alt key is down}
      if HiWord(GetKeyState(VK_MENU)) <> 0 then
        Label1.Caption := 'Alt'
      else
        Label1.Caption := 'None';
end;

How to dynamically create popup menus inside other popups?

From: Chris Jobson <chrisj@rcp.co.uk>

procedure TForm1.PopupMenu2Popup(Sender: TObject);
var
  mi, msub: TmenuItem;
begin
  with (Sender as TPopupMenu) do begin
    // Delete all items

   // while Items.Count > 0 do Items.delete(0);
   // Old version had resource leak. Leak plugged by Andrew Stewart (astewart@Strobes.co.nz)
    while Items.Count > 0 do Items[0].Free;

    // Create ordinary item "First"
    mi := TMenuItem.Create(self);
    with mi do begin
      Caption := 'First';
      OnClick := MyClick;
    end;
    Items.Insert(0, mi);

    // Create a submenu "Sub" with two items "Sub1" and
    // "Sub2"
    mi := TMenuItem.Create(self);
    with mi do begin
      Caption := 'Sub';
      msub := TMenuItem.Create(self);
      with msub do begin
        Caption := 'Sub1';
        OnClick := MyClick;
      end;
      Insert(0, msub);

      msub := TMenuItem.Create(self);
      with msub do begin
        Caption := 'Sub2';
        OnClick := MyClick;
      end;
      Insert(1, msub);
    end;
    Items.Insert(1, mi);
  end;
end;

procedure TForm1.MyClick(Sender: TObject);
begin
  beep;
end;

How do I add a bitmap to a MENU ...

From: kclaeys@innet.be (Kurt Claeys)

var
   Bmp1 : TPicture;

...

Bmp1 := TPicture.Create;
Bmp1.LoadFromFile('c:\where\b1.BMP');
SetMenuItemBitmaps(	MenuItemTest.Handle,
			0,
			MF_BYPOSITION,
			Bmp1.Bitmap.Handle,
			Bmp1.Bitmap.Handle);
...

Load a .BMP from somewhere into the picture.

Use the SetMenuItemBitmaps API call to connect the Picture to the Menu with these parameters :

1. MenuItemTest is the name given to the horizontal Menuitem
2. 0,1 ... is the position of the item on which you want to place the bitmap. (start counting with 0)

The first of the two bitmap-handles is the one for the bitmap displayed for the unchecked menuitem.

The second is the one for the checked menuitem. These can be the same or not.

All this can by coded in the .Create of a form.

Result : It works, but only the right-top of the bitmap is displayed. Rest us to change the height and/or width of the menuitem according to the bitmap

How do I dynamically add a MenuItem to a Menu?

Solution 1

From: Jeff Lawton <jlawton@groupz.net>

New Top Level Item:

procedure tform1.addmainitem(s:string);
var 
  newitem : Tmenuitem;
begin
  newitem:=tmenuitem.create(Mainmenu1);
  newitem.caption:=s;
  {if you want to assign an onclick
  newitem.onclick:=Dynamenuclick; }
  {add it to the top level menu}
  mainmenu1.items.insert(mainmenu1.items.count,newitem);
  removemenu1.enabled:=true;
  addmenuitem1.enabled:=true;
end;

procedure tform1.addsubitem(s:string; to : integer);
var
  newitem, toitem : Tmenuitem;
begin
  {to = top level menu to add item to}
  toitem:=mainmenu1.items[to];
  newitem:=tmenuitem.create(toitem);
  newitem.caption:=s;
  {if you want to assign an onclick
  newitem.onclick:=Dynamenuclick; }
  toitem.onclick:=nil;
  toitem.insert(toitem.count,newitem);
  removemenuitem1.enabled:=true;  
end;

Solution 2

From: janij@dystopia.fi (Jani Järvinen)

function NewMenu(Owner: TComponent; const AName: string; Items: array
of TMenuItem): TMainMenu;
function NewPopupMenu(Owner: TComponent; const AName: string;
   Alignment: TPopupAlignment; AutoPopup: Boolean; Items: array of 
   TMenuitem): TPopupMenu;
function NewSubMenu(const ACaption: string; hCtx: Word; const AName:
   string; Items: array of TMenuItem): TMenuItem;
function NewItem(const ACaption: string; AShortCut: TShortCut;
   AChecked, AEnabled: Boolean; AOnClick: TNotifyEvent; hCtx: Word;
   const AName: string): TMenuItem;
function NewLine: TMenuItem;

Hooking a procedure on to a dynamically created popup menu

This is what I've done fo far

 Procedure TTypeOfFrame.CreateAPopUpMenu;
 var
   NewItem: TMenuItem;
   FDragEnabledPopUpMenu : TPopUpMenu;
 begin
    NewItem := TMenuItem.Create(Self);
    NewItem.Caption := 'Drag';
    FDragEnabledPopUpMenu:= TPopUpmenu.Create(Self);
    with FDragEnabledPopUpMenu do
      begin
        Items.Add(NewItem);
      end;
 end;

To hook a procedure to this new item, you must create a procedure inside an object (define a private method for the form), like this:

  procedure MyClick(Sender : TObject);

   NewItem := TMenuItem.Create(Self);
   NewItem.Caption := 'Drag';
   NewItem.OnClick := MyClick;

Too long menus

It will vary the number of menu items per column depending on the screen resolution. It appears to work quite well. The following code assumes that there is a menu item called mnuView, and a OnClick procedure called HandleMenuClick..

procedure TfrmMain.LoadViewMenu;
var
  itemNum: integer;
  mnu: TMenuItem;
  menuItemHeight: integer;
  itemsPerColumn: integer;
begin
  {remove any existing menu items from the View menu}
  while mnuView.Count > 0 do begin
    {freeing an item apparently deletes it from the menu}
    mnuView.Items[0].Free;
  end;

  {find the height of each menu item. The 2 was chosen after some
experimentation}
  menuItemHeight := GetSystemMetrics(SM_CYMENU) + 2;

  {calculate the number of items per column}
  itemsPerColumn := screen.height div menuItemHeight;

  {create the items}
  for itemNum := 0 to 99 do begin
    mnu := TMenuItem.Create(self);
    mnu.caption := 'Item ' + inttostr(itemNum);

    {start a new column if necessary}
    if (itemNum mod itemsPerColumn = 0) and (itemNum>0) then begin
      mnu.break := mbBarBreak;
    end;

    {assign the method which handles the menu}
    mnu.OnClick := HandleMenuClick; 

    mnuView.Add(mnu);
  end;
end;