当前位置: 开源爱好者 » 编程教程 » VB教程 » 正文

VB制作的下拉式菜单

VB制作的窗体下拉式菜单,挺不错吧:

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) '重画菜单
  misys1.Visible = True
End Sub

CopyRight 2018© 开源爱好者 All Rights Reserved 豫ICP备16030607号 隐私声明 网站地图