zoukankan      html  css  js  c++  java
  • VBA 窗体中添加菜单

    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
    Private Declare Function CreateMenu 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 lpNewItem As Any) As Long
    Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
    Private Declare Function CreatePopupMenu Lib "user32" () As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Const GWL_WNDPROC = (-4)
    Private Const MF_STRING = &H0&
    Private Const MF_POPUP = &H10&
    Private Const MF_SEPARATOR = &H800&
    Dim MenuWnd As Long, Dump As Long, PopupMenuID As Long, PopupMenuWnd As Long, MenuID As Long
    
    Private Sub UserForm_Initialize()
        If Val(Application.Version) < 9 Then
            hwnd = FindWindow("ThunderXFrame", Me.Caption)
        Else
            hwnd = FindWindow("ThunderDFrame", Me.Caption)
        End If
        MenuWnd = CreateMenu()
        
        PopupMenuID = CreatePopupMenu()
        
        Dump = AppendMenu(PopupMenuID, MF_STRING, 100, "打开(&O)...")
        Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "文件(&F)")
        
        PopupMenuWnd = CreatePopupMenu()
        
        Dump = AppendMenu(PopupMenuWnd, MF_STRING, 101, "这是一个菜单和文本框结合的例子")
        Dump = AppendMenu(PopupMenuWnd, MF_STRING, 102, "点击一个菜单项,就可以把")
        Dump = AppendMenu(PopupMenuWnd, MF_STRING, 103, "此子菜单里的内容输入到文本框中")
        Dump = AppendMenu(PopupMenuID, MF_POPUP, PopupMenuWnd, "输入内容到文本框")
        
        Dump = AppendMenu(PopupMenuID, MF_SEPARATOR, 109, "")
        Dump = AppendMenu(PopupMenuID, MF_STRING, 200, "1.使2有效")
        Dump = AppendMenu(PopupMenuID, MF_STRING, 201, "2.使1有效")
        EnableMenuItem PopupMenuID, 201, MF_BYCOMMAND Or MF_GRAYED Or MF_DISABLED
        
        Dump = AppendMenu(PopupMenuID, MF_SEPARATOR, 111, "")
        Dump = AppendMenu(PopupMenuID, MF_STRING, 108, "退出(&X)")
        
        PopupMenuID = CreatePopupMenu()
        
        Dump = AppendMenu(PopupMenuID, MF_STRING, 104, "剪切(&T)")
        Dump = AppendMenu(PopupMenuID, MF_STRING, 105, "复制(&C)")
        Dump = AppendMenu(PopupMenuID, MF_STRING, 106, "粘贴(&P)")
        Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "编辑(&E)")
        
        PopupMenuID = CreatePopupMenu()
        
        Dump = AppendMenu(PopupMenuID, MF_STRING, 110, "选项一")
        Dump = AppendMenu(PopupMenuID, MF_STRING, 111, "选项二")
        Dump = AppendMenu(PopupMenuID, MF_STRING, 112, "选项三")
        Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "圆按钮(&R)")
        Dump = CheckMenuRadioItem(PopupMenuID, 110, 112, 110, MF_BYCOMMAND)
        
        PopupMenuID = CreatePopupMenu()
        
        Dump = AppendMenu(PopupMenuID, MF_STRING, 113, "选项一")
        Dump = AppendMenu(PopupMenuID, MF_STRING, 114, "选项二")
        Dump = AppendMenu(PopupMenuID, MF_STRING, 115, "选项三")
        Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "选择按钮(&C)")
        Dump = CheckMenuItem(PopupMenuID, 113, MF_BYCOMMAND Or MF_CHECKED)
        
        PopupMenuID = CreatePopupMenu()
        
        Dump = AppendMenu(PopupMenuID, MF_STRING, 107, "关于(&A)...")
        Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "帮助(&H)")
        
        Dump = SetMenu(hwnd, MenuWnd)
        
        PreWinProc = GetWindowLong(hwnd, GWL_WNDPROC)
        SetWindowLong hwnd, GWL_WNDPROC, AddressOf MsgProcess
        
    End Sub
    
    Private Sub UserForm_Terminate()
        DestroyMenu MenuWnd
        DestroyMenu PopupMenuID
        DestroyMenu PopupMenuWnd
        SetWindowLong hwnd, GWL_WNDPROC, PreWinProc
    End Sub

    摘自:http://club.excelhome.net/thread-480017-1-1.html,感谢大佬的付出!

  • 相关阅读:
    MouseArea重叠导致按键没响应
    【技术贴】VS2005不能新建项目不能新建网站。提示Microsoft visual studio
    【技术贴】解决虚拟机xp安装雨林木风ylmf os的linux鼠标失效鼠标不准确鼠标定位不正常的根本
    【转】不错的黑客和编程教程资源下载
    【技术贴】网页部分图片显示x红叉,网页图片不显示,网页图片显示异常,网页图片打不开。
    【转】极品免费网站空间申请:000webhost.com免费1.5G美国空间PHP+MySQL
    【转】虚拟机VMware安装ubuntu以及安装vmtools
    技术贴】QQ空间打开缓慢,无法编辑日志,由于您当前网络不稳定导致QQ空间打开异常的解决办法。
    【技术贴】看网页时把图片设为桌面背景后的背景图片存放在那里啊存放路径。
    【技术贴】解决虚拟机xp安装雨林木风ylmf os的linux鼠标失效鼠标不准确鼠标定位不正常的根本
  • 原文地址:https://www.cnblogs.com/williamton/p/12880504.html
Copyright © 2011-2022 走看看