复制菜单

最新推荐文章于 2022-09-30 22:54:23 发布

原创最新推荐文章于 2022-09-30 22:54:23 发布 · 1.3k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#function #hex

编程心得专栏收录该内容

43 篇文章

订阅专栏

博客展示了CopyMenu函数的代码，该函数用于复制菜单。函数接收源菜单句柄和目标菜单句柄作为参数，处理了源或目标句柄为0的情况，通过循环获取菜单项信息，根据菜单项状态进行不同操作，如创建子菜单、添加分隔符等，最终实现菜单复制。

'---------------------------------------------------------------------------------------
' Procedure : CopyMenu
' DateTime : 2005-9-21 19:17
' Author : Lingll
' Purpose : 复制菜单
'---------------------------------------------------------------------------------------
Public Function CopyMenu(hMnuSrc&, hMnuDest&) As Boolean
On Error Resume Next

Dim rtn As Boolean
Dim i&, tcnt&
Dim tState&, tId&, tString$, tSub&, tNewSub&

If hMnuSrc = 0 Then
CopyMenu = False
Exit Function
End If

If hMnuDest = 0 Then
    hMnuDest = CreatePopupMenu()
    If hMnuDest = 0 Then
        CopyMenu = False
        Exit Function
    End If
Else
    tcnt = GetMenuItemCount(hMnuDest)
    For i = tcnt - 1 To 0 Step -1
        DeleteMenu hMnuDest, i, MF_BYPOSITION
    Next i
End If

tcnt = GetMenuItemCount(hMnuSrc)
For i = 0 To tcnt - 1
    tState = GetMenuState(hMnuSrc, i, MF_BYPOSITION)

    If (tState And MF_POPUP) = MF_POPUP Then
        tString = GetMenuTextVb(hMnuSrc, i)

        tSub = GetSubMenu(hMnuSrc, i)
        tNewSub = CreatePopupMenu()

        Debug.Print Hex(tState)
        tState = (&HFF& And tState)
        Debug.Print Hex(tState)

        AppendMenu hMnuDest, tState, tNewSub, tString
        Call CopyMenu(tSub, tNewSub)
    ElseIf (tState And MF_SEPARATOR) = MF_SEPARATOR Then
        AppendMenu hMnuDest, MF_SEPARATOR, 0, vbNullString
    Else
        tString = GetMenuTextVb(hMnuSrc, i)
        tId = GetMenuItemID(hMnuSrc, i)
        AppendMenu hMnuDest, tState, tId, tString
    End If

Next i