form1.frm

vb 窗体实例 都是自己的例子

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "显示多列菜单"
   ClientHeight    =   2010
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   6285
   LinkTopic       =   "Form1"
   ScaleHeight     =   2010
   ScaleWidth      =   6285
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command5 
      Caption         =   "退出"
      Height          =   375
      Left            =   105
      TabIndex        =   4
      Top             =   1485
      Width           =   5985
   End
   Begin VB.CommandButton Command3 
      Caption         =   "三列菜单"
      Height          =   495
      Left            =   3135
      TabIndex        =   3
      Top             =   915
      Width           =   1455
   End
   Begin VB.CommandButton Command4 
      Caption         =   "四列菜单"
      Height          =   495
      Left            =   4650
      TabIndex        =   2
      Top             =   915
      Width           =   1455
   End
   Begin VB.CommandButton Command2 
      Caption         =   "两列菜单"
      Height          =   495
      Left            =   1620
      TabIndex        =   1
      Top             =   915
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "一列菜单"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   915
      Width           =   1455
   End
   Begin VB.Menu misys 
      Caption         =   "Menu1"
      Begin VB.Menu a1 
         Caption         =   "a1"
      End
      Begin VB.Menu a2 
         Caption         =   "a2"
      End
      Begin VB.Menu a3 
         Caption         =   "a3"
      End
      Begin VB.Menu a4 
         Caption         =   "a4"
      End
      Begin VB.Menu a5 
         Caption         =   "a5"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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_MENUBREAK = &H40&
 Const MF_STRING = &H0&
 Const MF_HELP = &H4000&
 Const MFS_DEFAULT = &H1000&
 Const MIIM_ID = &H2
 Const MIIM_SUBMENU = &H4
 Const MIIM_TYPE = &H10
 Const MIIM_DATA = &H20

Private Declare Function GetMenu Lib "user32" (ByVal hwnd 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 Declare Function DrawMenuBar 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 Sub Command1_Click()
  DrawMenuBar (Me.hwnd)      '创建一列菜单
End Sub

Private Sub Command2_Click()     '创建二列菜单
  Dim mnuItemInfo As MENUITEMINFO, hMenu As Long, hSubMenu As Long
  Dim BuffStr As String * 80
    
  hMenu = GetMenu(Me.hwnd)     '取得窗口菜单句柄
  BuffStr = Space(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
  
  hSubMenu = GetSubMenu(hMenu, 0)     '设置菜单选项
  If GetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then     '获取菜单条目信息
     MsgBox "GetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
    Else
     mnuItemInfo.fType = mnuItemInfo.fType Or MF_MENUBARBREAK
     If SetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then      '设置菜单为二列菜单
        MsgBox "SetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
     End If
  End If
  DrawMenuBar (Me.hwnd)     '重画菜单
End Sub

Private Sub Command3_Click()     '创建三列菜单
  Dim mnuItemInfo As MENUITEMINFO, hMenu As Long, hSubMenu As Long
  Dim BuffStr As String * 80
    
  hMenu = GetMenu(Me.hwnd)    '取得窗口菜单句柄
  BuffStr = Space(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
  
  hSubMenu = GetSubMenu(hMenu, 0)    '设置菜单选项
  If GetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then
     MsgBox "GetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
    Else
     mnuItemInfo.fType = mnuItemInfo.fType Or MF_MENUBARBREAK
     If SetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then      '设置菜单为二列菜单
        MsgBox "SetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
       Else
        mnuItemInfo.fType = mnuItemInfo.fType Or MF_MENUBARBREAK
        If SetMenuItemInfo(hSubMenu, 3, True, mnuItemInfo) = 0 Then      '设置菜单为三列菜单
           MsgBox "SetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
        End If
    End If
  End If
  DrawMenuBar (Me.hwnd)     '重画菜单
End Sub

Private Sub Command4_Click()     '创建四列菜单
  Dim mnuItemInfo As MENUITEMINFO, hMenu As Long, hSubMenu As Long
  Dim BuffStr As String * 80
    
  hMenu = GetMenu(Me.hwnd)    '取得窗口菜单句柄
  BuffStr = Space(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
  
  hSubMenu = GetSubMenu(hMenu, 0)    '设置菜单选项
  If GetMenuItemInfo(hSubMenu, 1, True, mnuItemInfo) = 0 Then
     MsgBox "GetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
    Else
     mnuItemInfo.fType = mnuItemInfo.fType Or MF_MENUBARBREAK
     If SetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then      '设置菜单为二列菜单
        MsgBox "SetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
       Else
        mnuItemInfo.fType = mnuItemInfo.fType Or MF_MENUBARBREAK
        If SetMenuItemInfo(hSubMenu, 3, True, mnuItemInfo) = 0 Then      '设置菜单为三列菜单
           MsgBox "SetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
          Else
           mnuItemInfo.fType = mnuItemInfo.fType Or MF_MENUBARBREAK
           If SetMenuItemInfo(hSubMenu, 4, True, mnuItemInfo) = 0 Then      '设置菜单为四列菜单
              MsgBox "SetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
             Else
            End If
        End If
     End If
  End If
  DrawMenuBar (Me.hwnd)     '重画菜单
End Sub

Private Sub Command5_Click()
  End
End Sub