My FAQ,最新最全的IT技术教程
最新100篇 | 推荐100篇 | 专题100篇 | 排行榜 | 搜索 | 在线API文档 | 网通镜像
首 页 | 程序开发 | 操作系统 | 软件应用 | 图形图象 | 网络应用 | 精文荟萃 | 教育认证 | 硬件维护 | 未整理篇 | 站长教程
ASP JS PHP工程 ASP.NET 网站建设 UML J2EESUN .NET VC VB VFP 网络维护 数据库 DB2 SQL2000 Oracle Mysql
服务器 Win2000 Office C DreamWeaver FireWorks Flash PhotoShop 上网宝典 CorelDraw 协议大全 网络安全 微软认证
硬件维护  CPU  主板  硬盘  内存  显卡  显示器  键盘鼠标  声卡音箱  打印机  机箱电源  BIOS  网卡  C#  Java  Delphi  vs.net2005
  当前位置:> 程序开发 > 编程语言 > Visual Basic > 用户界面
动态创建菜单,添加菜单,执行自己的菜单事件
作者:jennyvenus 时间:2001-11-01 10:41 出处:互联网 责编:MyFAQ
              摘要:动态创建菜单,添加菜单,执行自己的菜单事件

(仅供参考)

动态创建菜单,鼠标右键弹出菜单,执行对应鼠标事件
'窗体
Option Explicit
Private Sub Form_Load()
    hMenu = CreateMenu()
    hmenupopup = CreatePopupMenu()
    result = AppendMenu(hmenupopup, MF_STRING, 300, "&New")
    result = AppendMenu(hmenupopup, MF_STRING, 301, "&Save")
    result = AppendMenu(hmenupopup, MF_STRING, 302, "Save &As...")
    result = AppendMenu(hMenu, MF_POPUP, hmenupopup, "&File")
    oldwinproc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
    SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf OnMenu
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim r As RECT
    Dim p As POINTAPI
    If Button = vbRightButton Then
        GetCursorPos p
        TrackPopupMenu hmenupopup, 0, p.x, p.y, 0, Me.hWnd, r
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SetWindowLong Me.hWnd, GWL_WNDPROC, oldwinproc
End Sub
'模块
Option Explicit

Public Declare Function CreateMenu Lib "user32" () As Long
Public 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
Public 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, lprc As RECT) As Long
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Const MF_STRING = &H0&
Public Const MF_POPUP = &H10&
Public Const WM_USER = &H400
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Public Type POINTAPI
        x As Long
        y As Long
End Type
Public Const GWL_WNDPROC = (-4)
Public hMenu As Long
Public hmenupopup As Long
Public result As Long
Public oldwinproc As Long
Public Const WM_COMMAND = &H111

Public Function OnMenu(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case wMsg
        Case WM_COMMAND
            Select Case wParam
                Case 300
                    MsgBox "u select new", vbInformation, "hello, world!"
                Case 301
                    MsgBox "u select save", vbInformation, "hello, world!"
                Case 302
                    MsgBox "u select save as", vbInformation, "hello, world!"
            End Select
    End Select
    OnMenu = CallWindowProc(oldwinproc, hWnd, wMsg, wParam, lParam)
End Function

关闭本页
 
首页 | 投资与合作 | 服务条款 | 隐私政策 | 收藏本站 | 设为首页 | 新用户注册 | 免责声明 | 使用帮助
Copyright ©2005-2008 myfaq.com.cn All rights reserved. www.myfaq.com.cn 版权所有