复制菜单

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

lingll

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

阅读量1.2k

点赞数

分类专栏：编程心得文章标签： function hex

本文链接：https://blog.csdn.net/lingll/article/details/487018

版权

编程心得专栏收录该内容

43 篇文章 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