分割菜单项

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" _
(ByVal hMenu 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 Boolean, _
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 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 MIIM_TYPE = &H10&
Const RGB_STARTNEWCOLUMNWTTHVERTBAR = &H20&
Const MFT_STRING = &H0&

Private Sub Command1_Click()
Dim rv As Long
Dim hSubMenu As Long
Dim mnuItemCount As Long
Dim mInfo As MENUITEMINFO
Dim pad As Long
'获取菜单句柄
hSubMenu = GetSubMenu(GetMenu(Me.hwnd), 0)
'获取子菜单项
mnuItemCount = GetMenuItemCount(hSubMenu)
'将子菜单分成两部分
If mnuItemCount Mod 2 <> 0 Then
pad = 1
Else
pad = 0
End If
'取得当前菜单信息
mInfo.cbSize = Len(mInfo)
mInfo.fMask = MIIM_TYPE
mInfo.fType = MFT_STRING
mInfo.dwTypeData = Space$(256)
mInfo.cch = Len(mInfo.dwTypeData)
rv = GetMenuItemInfo(hSubMenu, (mnuItemCount \ 2) + pad, True, mInfo)
'按新的格式显示菜单
mInfo.fType = RGB_STARTNEWCOLUMNWTTHVERTBAR
mInfo.fMask = MIIM_TYPE
rv = SetMenuItemInfo(hSubMenu, (mnuItemCount \ 2) + pad, True, mInfo)
If rv = 0 Then MsgBox "分割错误"
End Sub

Private Sub Form_Load()
'动态添加8项子菜单项
Dim i As Integer
For i = 1 To 8
Load mnuSplitSub(i)
mnuSplitSub(i).Visible = True
mnuSplitSub(i).Caption = "分割菜单" + Trim(Str(i))
Next i
End Sub