• 软件测试技术
  • 软件测试博客
  • 软件测试视频
  • 开源软件测试技术
  • 软件测试论坛
  • 软件测试沙龙
  • 软件测试资料下载
  • 软件测试杂志
  • 软件测试人才招聘
    暂时没有公告

字号: | 推荐给好友 上一篇 | 下一篇

动态创建菜单,添加菜单,执行自己的菜单事件

发布: 2007-7-01 21:48 | 作者: admin | 来源: | 查看: 19次 | 进入软件测试论坛讨论

领测软件测试网

(仅供参考)

动态创建菜单,鼠标右键弹出菜单,执行对应鼠标事件
´窗体
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


文章来源于领测软件测试网 https://www.ltesting.net/


关于领测软件测试网 | 领测软件测试网合作伙伴 | 广告服务 | 投稿指南 | 联系我们 | 网站地图 | 友情链接
版权所有(C) 2003-2010 TestAge(领测软件测试网)|领测国际科技(北京)有限公司|软件测试工程师培训网 All Rights Reserved
北京市海淀区中关村南大街9号北京理工科技大厦1402室 京ICP备10010545号-5
技术支持和业务联系:info@testage.com.cn 电话:010-51297073

软件测试 | 领测国际ISTQBISTQB官网TMMiTMMi认证国际软件测试工程师认证领测软件测试网