分栏式程序菜单（1---003）

1、在菜单编辑器中创建菜单时，“库位代码”----“ 责任单位”间的10个菜单项的名称均为base,索引从0到9

2、“初盘输入”---“商品借出”间的10个菜单项的名称均为mov,索引从0到9

3、“库存查询”---“ 库存报表”间的10个菜单项的名称均为search,索引从0到9

4、代码如下：

'以下代码是通过VB菜单的“外接程序”--->“API浏览器”添加的

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Long, lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As String
    cch As Long
End Type
Const MF_MENUBARBREAK = &H20&   '换列并有分列线
Const MF_STRING = &H0&          '菜单项是字符串

'“API浏览器”中没有，直接添加
Const MFS_DEFAULT = &H1000&     '指定为缺省,　应该类似与缺省按钮
Const MIIM_ID = &H2
Const MIIM_SUBMENU = &H4
Const MIIM_TYPE = &H10
Const MIIM_DATA = &H20

'窗体激活时发生的事件
Private Sub Form_Activate()
    Dim mnuItemInfo As MENUITEMINFO, hMenu As Long, hSubMenu As Long
    Dim BuffStr As String * 80  '变量BuffStr只能存80个字符
    hMenu = GetMenu(Me.hwnd) '获得窗体菜单句柄
    hSubMenu = GetSubMenu(hMenu, 0) '获得子菜单句柄
    BuffStr = Space(80) '80个空格
    With mnuItemInfo
        .cbSize = Len(mnuItemInfo)
        .dwTypeData = BuffStr & Chr(0)
        .fType = MF_STRING
        .cch = Len(mnuItemInfo.dwTypeData)
        .fState = MFS_DEFAULT
        .fMask = MIIM_ID Or MIIM_DATA Or MIIM_TYPE Or MIIM_SUBMENU
    End With
    If GetMenuItemInfo(hSubMenu, 0, True, mnuItemInfo) = 0 Then
        MsgBox "GetMenuItemInfo failed. Error:" & Err.LastDllError, , "Error"
    Else
        mnuItemInfo.fType = mnuItemInfo.fType Or MF_MENUBARBREAK
        If SetMenuItemInfo(hSubMenu, 12, True, mnuItemInfo) = 0 Then            '设置菜单为二列菜单
            MsgBox "SetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
        Else
            mnuItemInfo.fType = mnuItemInfo.fType Or MF_MENUBARBREAK
            If SetMenuItemInfo(hSubMenu, 24, True, mnuItemInfo) = 0 Then      '设置菜单为三列菜单
                MsgBox "SetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
            End If
        End If
    End If
     DrawMenuBar (Me.hwnd)     '重画菜单
End Sub