用VB编写一个弹出菜单类

原创 2001年02月01日 17:44:00

'类的名称为cPopupMenu

Option Explicit
'
Private Type POINT
    x As Long
    y As Long
End Type
'
Private Const MF_ENABLED = &H0&
Private Const MF_SEPARATOR = &H800&
Private Const MF_STRING = &H0&
Private Const TPM_RIGHTBUTTON = &H2&
Private Const TPM_LEFTALIGN = &H0&
Private Const TPM_NONOTIFY = &H80&
Private Const TPM_RETURNCMD = &H100&
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal sCaption As String) As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, nIgnored As Long) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINT) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Private mSelMenuString As String
Public Property Get SelMenuString() As String
    SelMenuString = mSelMenuString
End Property
'
Public Function Popup(ParamArray param()) As Long
    Dim iMenu As Long
    Dim hMenu As Long
    Dim nMenus As Long
    Dim p As POINT

' get the current cursor pos in screen coordinates
    GetCursorPos p

' create an empty popup menu
    hMenu = CreatePopupMenu()

' determine # of strings in paramarray
    nMenus = 1 + UBound(param)

' put each string in the menu
    For iMenu = 1 To nMenus
' the AppendMenu function has been superseeded by the InsertMenuItem
' function, but it is a bit easier to use.
        If Trim$(CStr(param(iMenu - 1))) = "-" Then
' if the parameter is a single dash, a separator is drawn
            AppendMenu hMenu, MF_SEPARATOR, iMenu, ""
        Else
            AppendMenu hMenu, MF_STRING + MF_ENABLED, iMenu, CStr(param(iMenu - 1))
        End If
    Next iMenu

' show the menu at the current cursor location;
' the flags make the menu aligned to the right (!); enable the right button to select
' an item; prohibit the menu from sending messages and make it return the index of
' the selected item.
' the TrackPopupMenu function returns when the user selected a menu item or cancelled
' the window handle used here may be any window handle from your application
' the return value is the (1-based) index of the menu item or 0 in case of cancelling
    iMenu = TrackPopupMenu(hMenu, TPM_RIGHTBUTTON + TPM_LEFTALIGN + TPM_NONOTIFY + TPM_RETURNCMD, p.x, p.y, 0, GetForegroundWindow(), 0)
    Dim result As Long
    Dim buffer As String
    Const MF_BYPOSITION = &H400&

    buffer = Space(255)
   
    result = GetMenuString(hMenu, (iMenu - 1), buffer, _
                   Len(buffer), MF_BYPOSITION)
    'Debug.Print buffer
    mSelMenuString = Trim(buffer)
' release and destroy the menu (for sanity)
    DestroyMenu hMenu

' return the selected menu item's index
    Popup = iMenu

End Function

'结束

'以下是实例,在Form上添加一个ListBox控件

Option Explicit

Private Sub Form_Load()
    List1.AddItem "Right-Click here for a menu"
End Sub

Private Sub List1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim oMenu As cPopupMenu
    Dim lMenuChosen As Long
'
    If Button = vbRightButton Then
        Set oMenu = New cPopupMenu
'
' Pass in the desired menu, use '-' for a separator
'
        lMenuChosen = oMenu.Popup("Menu 1", "Menu 2", "Menu 3", _
                "-", "Menu 4")
'
        Debug.Print lMenuChosen
        Debug.Print oMenu.SelMenuString
    End If

'
End Sub

MFC中教你怎么编写弹出式菜单

在VS2008中,不能像VC++6.0那样通过Compnents and Controls来自动添加弹出式菜单,需要手动添加。可以采用两种方式创建弹出式菜单。 一、利用现有的菜单资源创建 (1)首...
  • jiadabin
  • jiadabin
  • 2014年03月31日 18:27
  • 1940

MFC基于对话框的程序添加菜单&点击菜单弹出一个新的对话框

基于对话框的应用程序默认是没有菜单的,如果我们想为它添加菜单, 可按以下方法...
  • foreverhuylee
  • foreverhuylee
  • 2014年04月30日 10:48
  • 13294

MATLAB GUI设计之弹出式菜单的使用

弹出式菜单在MATLAB GUI设计中常常出现。比如串口助手、绘制图形等经常见到弹出式菜单如下图所示: 使用方法: 一、准备工作1、从MATLAB GUIDE中拖出一个弹出式菜单 2...
  • kabuto_hui
  • kabuto_hui
  • 2016年03月12日 17:07
  • 11236

关于VB6弹出菜单的问题

写一个小程序, 用VB6随意做下界面,离奇的发现弹出菜单居然没有效果,过程如下 创建一个窗体Form1,用菜单编辑器创建一个弹出菜单 弹出菜单子菜单项在这里名称为mPopup1,事件代码为...
  • prsniper
  • prsniper
  • 2015年11月01日 05:06
  • 1029

一个类似UC右上角的弹出菜单(使用PopupWindow)

  • 2014年03月05日 16:22
  • 984KB
  • 下载

VB的鼠标右键弹出菜单

  • 2008年07月18日 11:06
  • 2KB
  • 下载

[VB 源码] 调用资源管理器右键菜单/弹出文件右键系统菜单-2

“粘贴在窗体(from)中的代码:”我的浏览器.frmPrivate Sub ShellContextMenu(objLB As Control, _                         ...
  • cybersnow
  • cybersnow
  • 2011年07月04日 19:32
  • 1318

当用户单击一个按钮时弹出一个菜单

  • 2011年04月04日 00:51
  • 5KB
  • 下载

如何开发一个弹出菜单的mip组件

为何要进行mip开发,mip是百度推出的针对移动网页加速的一套技术标准。有利于移动网站快速打开,有利于百度搜索排名。因为mip页中不能使用js代码。所以必须进行mip组件开发。下面我要开发一个如下图所...
  • maketoday
  • maketoday
  • 2018年01月06日 19:47
  • 66

在Windows操作系统下使用Visual C++ 6.0编程时,如果点击菜单中的【打开】或者【添加】,或者按快捷键,都会弹出一个对话框,怎么解决?

很多学习编程的同学都遇到这样的问题,在Windows操作系统下使用Visual C++ 6.0编程时,如果点击菜单中的【打开】或者【添加】,或者按快捷键,都会弹出下图的对话框,出现程序崩溃并退出的情况...
  • u013641234
  • u013641234
  • 2014年11月30日 20:30
  • 3487
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:用VB编写一个弹出菜单类
举报原因:
原因补充:

(最多只允许输入30个字)