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