平台:德尔福2010

  • 将Tmainmenu放到Form1上
  • 将Tpopupmenu放到form1上
  • 添加mainmenu1和popupmenu项
    (mainmenu-> file-> item1,popupmenu-> popup item1)
  • item1.onRgiht点击显示弹出菜单
  • f9
  • 文件-> item1右键单击,弹出菜单,选择item1 bla bla bla...。
  • object Form1: TForm1
      Left = 0
      Top = 0
      Caption = 'Form1'
      ClientHeight = 222
      ClientWidth = 447
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Tahoma'
      Font.Style = []
      Menu = MainMenu1
      OldCreateOrder = False
      PixelsPerInch = 96
      TextHeight = 13
      object MainMenu1: TMainMenu
        Left = 136
        Top = 64
        object file1: TMenuItem
          Caption = 'file'
          object recentfile1: TMenuItem
            Caption = 'item 1'
          end
        end
      end
      object PopupMenu1: TPopupMenu
        Left = 24
        Top = 136
        object popupitem1: TMenuItem
          Caption = 'popup item'
          OnClick = popupitem1Click
        end
      end
    end
    

    最佳答案

    这是以下示例的菜单结构

    File1           Edit1
      FileItem11      EditItem11
      FileItem21      EditItem21
    

    和两个弹出菜单项。编码:
    type
      TForm1 = class(TForm)
        MainMenu1: TMainMenu;
        File1: TMenuItem;
        FileItem11: TMenuItem;
        FileItem21: TMenuItem;
        Edit1: TMenuItem;
        EditItem11: TMenuItem;
        EditItem21: TMenuItem;
        PopupMenu1: TPopupMenu;
        PopupItem11: TMenuItem;
        PopupItem21: TMenuItem;
        procedure PopupItem11Click(Sender: TObject);
        procedure PopupItem21Click(Sender: TObject);
      private
        FSelectedItem: TMenuItem;
        FTracking: Boolean;
        procedure MenuRButtonUp(var Msg: TMessage); message WM_MENURBUTTONUP;
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    { TForm1 }
    
    procedure TForm1.MenuRButtonUp(var Msg: TMessage);
    var
      Cmd: UINT;
    begin
      if not FTracking then
        FSelectedItem :=
            MainMenu1.FindItem(GetMenuItemID(Msg.LParam, Msg.WParam), fkCommand);
    
      if (not FTracking) and (FSelectedItem <> nil) then begin
        FTracking := True;
        LongBool(Cmd) := TrackPopupMenuEx(PopupMenu1.Handle,
                                TPM_RECURSE or TPM_BOTTOMALIGN or TPM_RETURNCMD,
                                Mouse.CursorPos.X, Mouse.CursorPos.Y, Handle, nil);
        FTracking := False;
        if Cmd <> 0 then
          PopupMenu1.DispatchCommand(Cmd);
      end;
      inherited;
    end;
    
    procedure TForm1.PopupItem11Click(Sender: TObject);
    begin
      Caption := 'Popup Item 1 clicked on ' + FSelectedItem.Caption;
    end;
    
    procedure TForm1.PopupItem21Click(Sender: TObject);
    begin
      // whatever..
      Caption := 'Popup Item 2 clicked on ' + FSelectedItem.Caption;
    end;
    

    关于delphi - 如何检测TMenuItem右键?,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/3788184/

    10-13 01:19