IFIX实现右键菜单的代码




直接赋值下面程序到一个新建画面中测试,根据实际需求更改菜单要求
 
 
Option Explicit
'相关API函数定义
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal hwnd As Long, ByVal lptpm As Any) 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 GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Const GW_HWNDNEXT = 2
'鼠标坐标
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Dim hwnd As Long
Dim hSubMenu As Long
Dim hMainMenu As Long
' 菜单类型
'-----------------------------------------------------------
Const MF_INSERT = &H0&
Const MF_CHANGE = &H80&
Const MF_APPEND = &H100&
Const MF_DELETE = &H200&
Const MF_REMOVE = &H1000&
Const MF_BYCOMMAND = &H0&
Const MF_BYPOSITION = &H400&
Const MF_SEPARATOR = &H800&
Const MF_ENABLED = &H0&
Const MF_GRAYED = &H1&
Const MF_DISABLED = &H2&
Const MF_UNCHECKED = &H0&
Const MF_CHECKED = &H8&
Const MF_USECHECKBITMAPS = &H200&
Const MF_STRING = &H0&
Const MF_BITMAP = &H4&
Const MF_OWNERDRAW = &H100&
Const MF_POPUP = &H10&
Const MF_MENUBARBREAK = &H20&
Const MF_MENUBREAK = &H40&
Const MF_UNHILITE = &H0&
Const MF_HILITE = &H80&
Const MF_SYSMENU = &H2000&
Const MF_HELP = &H4000&
Const MF_MOUSESELECT = &H8000&
Const TPM_LEFTBUTTON = &H0&
Const TPM_RIGHTBUTTON = &H2&
Const TPM_LEFTALIGN = &H0&
Const TPM_CENTERALIGN = &H4&
Const TPM_RIGHTALIGN = &H8&
Const TPM_RETURNCMD = &H100&
Private Sub CFixPicture_Close()
    '注销菜单
    DestroyMenu hSubMenu
    DestroyMenu hMainMenu
End Sub
Private Sub CFixPicture_Initialize()
'菜单初始化设置
    Dim ParentHWnd As Long
    Dim ChildHWnd As Long
    Dim ChildDocHWnd As Long
    Dim ChildWindow As Long
    ' 找到当前画面的句柄
    ParentHWnd = FindWindowPartial("*工作台*", "*")
    ChildHWnd = FindWindowEx(ParentHWnd, &O0, "MDIClient", "")
    ChildDocHWnd = FindWindowEx(ChildHWnd, &O0, vbNullString, Me.PictureName)
    ChildWindow = FindWindowEx(ChildDocHWnd, &O0, vbNullString, vbNullString)
    hwnd = ChildWindow
    ' 创建主菜单
    hMainMenu = CreatePopupMenu()
    AppendMenu hMainMenu, MF_STRING, 1, "菜单 - 1"
    AppendMenu hMainMenu, MF_STRING, 2, "菜单 - 2"
    AppendMenu hMainMenu, MF_SEPARATOR, 3, ByVal 0& '分隔线
    AppendMenu hMainMenu, MF_STRING, 4, "关于"
    'AppendMenu hMenu, MF_STRING Or MF_GRAYED, 4, "关于" '灰色
    ' 创建子菜单
    hSubMenu = CreatePopupMenu()
    AppendMenu hSubMenu, MF_STRING, 6, "菜单 1 - 1"
    ' 将子菜单加到主菜单中
    AppendMenu hMainMenu, MF_BYPOSITION Or MF_POPUP, hSubMenu, "&子菜单主名"
End Sub
Private Function FindWindowPartial(ByVal Title As String, ByVal Class As String) As Long
'找到窗口句柄
    Dim hWndThis As Long
    hWndThis = FindWindow(vbNullString, vbNullString)
    While hWndThis
        Dim sTitle As String, sClass As String
        sTitle = Space$(255)
        sTitle = Left$(sTitle, GetWindowText(hWndThis, sTitle, Len(sTitle)))
        sClass = Space$(255)
        sClass = Left$(sClass, GetClassName(hWndThis, sClass, Len(sClass)))
        If sTitle Like Title And sClass Like Class Then
            FindWindowPartial = hWndThis
            Exit Function
        End If
        hWndThis = GetWindow(hWndThis, GW_HWNDNEXT)
    Wend
End Function
Private Sub CFixPicture_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Double, ByVal Y As Double)
'点击画面弹出菜单,可以定义其他画面上的对象弹出菜单
    Dim Pt As POINTAPI
    Dim ret As Long
    If Button = 2 Then '1表示左键,2表示右键,3表示中间键
        ' 获得鼠标位置
        GetCursorPos Pt
        ' 显示弹出菜单
        ret = TrackPopupMenuEx(hMainMenu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, Pt.X, Pt.Y, hwnd, ByVal 0&)
        ' 显示选择菜单项,菜单处理程序写在此处
        Select Case ret
            Case 1
                Call MenuProc1
            Case 2
                Call MenuProc2
            Case 4
                Call MenuProc4
            Case 6
                Call MenuProc6
        End Select
    End If
End Sub
Private Sub MenuProc1()
    '菜单点击处理程序
    MsgBox "菜单-1点击!"
End Sub
Private Sub MenuProc2()
    '菜单点击处理程序
    MsgBox "菜单-2点击!"
End Sub
Private Sub MenuProc4()
    '菜单点击处理程序
    MsgBox "关于点击"
End Sub
Private Sub MenuProc6()
    '菜单点击处理程序
    MsgBox "弹出子菜单1-1点击!"
End Sub
Public Sub CFixPicture_CtrlAccent()
'画面“Ctrl+~”事件
    Dim ret As Long
    '显示在左上角
    ret = TrackPopupMenuEx(hMainMenu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, 0, 0, hwnd, ByVal 0&)
    Select Case ret
        Case 1
            Call MenuProc1
        Case 2
            Call MenuProc2
        Case 4
            Call MenuProc4
        Case 6
            Call MenuProc6
    End Select
End Sub
  • 0
    点赞
  • 2
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值