splitmenu.frm

很好的教程原代码！

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "分 割"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   1800
      TabIndex        =   0
      Top             =   1080
      Width           =   1095
   End
   Begin VB.Menu mnuSplit 
      Caption         =   "分割菜单"
      Begin VB.Menu mnuSplitSub 
         Caption         =   "分割菜单1"
         Index           =   0
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

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