How to trigger action when use mouse middle click on TPopupMenu's items?

Question

We use mouse left click to trigger actions in menu items of TPopupMenu. How to trigger different action on mouse middle click in these menu items? In other word, mouse left and middle click on TPopupmenu's menu items are both different action.

Answer 1

The global Menus.PopupList variable keeps track of all PopupMenus and handles all massages send to them. You can override this PopupList with your own instance, as follows:

type
  TMyPopupList = class(TPopupList)
  private
    FMenuItem: TMenuItem;
  protected
    procedure WndProc(var Message: TMessage); override;
  end;

{ TMyPopupList }

procedure TMyPopupList.WndProc(var Message: TMessage);
var
  FindKind: TFindItemKind;
  I: Integer;
  Item: Integer;
  Action: TBasicAction;
  Menu: TMenu;
begin
  case Message.Msg of
    WM_MENUSELECT:
      with TWMMenuSelect(Message) do
      begin
        FindKind := fkCommand;
        if MenuFlag and MF_POPUP <> 0 then
          FindKind := fkHandle;
        for I := 0 to Count - 1 do
        begin
          if FindKind = fkHandle then
          begin
            if Menu <> 0 then
              Item := GetSubMenu(Menu, IDItem)
            else
              Item := -1;
          end
          else
            Item := IDItem;
          FMenuItem := TPopupMenu(Items[I]).FindItem(Item, FindKind);
          if FMenuItem <> nil then
            Break;
        end;
      end;
    WM_MBUTTONUP:
      if FMenuItem <> nil then
      begin
        GetMenuItemSecondAction(FMenuItem, Action);
        Menu := FMenuItem.GetParentMenu;
        if Action <> nil then
        begin
          Menu := FMenuItem.GetParentMenu;
          SendMessage(Menu.WindowHandle, WM_IME_KEYDOWN, VK_ESCAPE, 0);
          Action.Execute;
          Exit;
        end;
      end;
  end;
  inherited WndProc(Message);
end;

initialization
  PopupList.Free;
  PopupList := TMyPopupList.Create;

The GetMenuItemSecondAction routine you have to write yourself. Maybe this answer provides some help about adding your own actions to a component.

Note that the code under WM_MENUSELECT is simply copied from Menus.TPopupList.WndProc. You could also retrieve the MenuItem in the WM_MBUTTONUP handling by using MenuItemFromPoint.

But as the many comments have already said: think twice (or more) before implementing this UI functionality.

Answer 2

You are not notified of such an event. If you were there would be an entry for middle mouse button click in the list of menu notifications.

So perhaps you could use some sort of hack behind the back of the menu system if you really want to do this. However, as discussed in the comments, there are good reasons for thinking that your proposed UI may not be very appropriate.

Answer 3

If the middle click is not a suitable choice, how about using some key combination with mouse click like Ctrl-Click, to trigger another action? The TPopupMenu doesn't have any event related to customized click.

That is preferred over a middle mouse button click.

And then it is much simpler. Just check in your action execute handler if the CTRL button is pressed:

procedure TForm1.Action1Execute(Sender: TObject);
begin
  if (GetKeyState(VK_CONTROL) and $8000 = 0) then
    // process normal click
  else
    // process ctrl click
end;

Answer 4

I try to combine 2 answers from author NGLN and come out with the following.

Define a new class inherit from TPopupList:

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

procedure TMyPopupList.WndProc(var Message: TMessage);
var H: HWND;
begin
  case Message.Msg of
    WM_MBUTTONDOWN: begin
      H := FindWindow(PChar('#32768'), nil);
      SendMessage(H, WM_IME_KEYDOWN, VK_RETURN, 0);
    end;
  end;
  inherited WndProc(Message);
end;

initialization
  PopupList.Free;
  PopupList := TMyPopupList.Create;
end.

The Item1Click is an OnClick event handler of TMenuItem that perform based on mouse click:

procedure TForm1.Item1Click(Sender: TObject);
begin
  if (GetKeyState(VK_MBUTTON) and $80 > 0) then
    Caption := 'Middle Click'
  else
    Caption := 'Normal Click';
end;

Note: #32768 is the default window class name for a pop-up menu, see MSDN documentation.