USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (Menu/Toobar/Coolbar)

Título da Dica:  Criando menus em colunas
Postada em 30/9/2003 por ^HEAVY-METAL^            
Public 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

Public Declare Function GetMenu Lib "user32" _
   (ByVal hwnd As Long) As Long

Public Declare Function GetMenuItemCount Lib "user32" _
   (ByVal hMenu As Long) As Long

Public Declare Function GetSubMenu Lib "user32" _
   (ByVal hMenu As Long, ByVal nPos As Long) As Long

Public Declare Function GetMenuItemInfo Lib "user32" _
    Alias "GetMenuItemInfoA" _
   (ByVal hMenu As Long, ByVal un As Long, _
    ByVal b As Boolean, lpmii As MENUITEMINFO) As Long

Public Declare Function SetMenuItemInfo Lib "user32" _
    Alias "SetMenuItemInfoA" _
   (ByVal hMenu As Long, ByVal uItem As Long, _
    ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long

Public Const MIIM_STATE As Long = &H1
Public Const MIIM_ID As Long = &H2
Public Const MIIM_SUBMENU As Long = &H4
Public Const MIIM_CHECKMARKS As Long = &H8
Public Const MIIM_TYPE As Long = &H10
Public Const MIIM_DATA As Long = &H20

Public Const MFT_RADIOCHECK As Long = &H200
Public Const MFT_STRING As Long = &H0

Public Const RGB_STARTNEWCOLUMNWITHVERTBAR As Long = &H20
Public Const RGB_STARTNEWCOLUMN As Long = &H40
Public Const RGB_EMPTY As Long = &H100
Public Const RGB_VERTICALBARBREAK As Long = &H160
Public Const RGB_SEPARATOR As Long = &H800


Private Sub Command1_Click()
  
  'divides the menu at the last menu
  'item (mnuItemCount - 1)  
   Dim r As Long

   Dim hSubMenu As Long
   Dim mnuItemCount As Long
   Dim mInfo As MENUITEMINFO
  
  'Get the menuitem handle  
   hSubMenu = GetSubMenu(GetMenu(Me.hWnd), 0)
   mnuItemCount = GetMenuItemCount(hSubMenu)
  
  'retrieve the current information For the
  'last item In the menu into an MENUITEMINFO structure.
  'True means MF_BYPOSITION.
   mInfo.cbSize = Len(mInfo)
   mInfo.fMask = MIIM_TYPE
   mInfo.fType = MFT_STRING
   mInfo.dwTypeData = Space$(256)
   mInfo.cch = Len(mInfo.dwTypeData)

   r = GetMenuItemInfo(hSubMenu, mnuItemCount - 1, True, mInfo)
      
  'modify its attributes To the New Type,
  'telling the menu To insert a break before
  'the member In the MENUITEMINFO structure.  
   mInfo.fType = RGB_STARTNEWCOLUMNWITHVERTBAR
    
  'we only want To change the style, so reset fMask  
   mInfo.fMask = MIIM_TYPE
  
   r = SetMenuItemInfo(hSubMenu, mnuItemCount - 1, True, mInfo)

   If r Then Print " Done !"

End Sub


Private Sub Command2_Click()

  'divides the menu into 2 even columns

   Dim r As Long

   Dim hSubMenu As Long
   Dim mnuItemCount As Long
   Dim mInfo As MENUITEMINFO

   Dim pad As Long
  
  'Get the menuitem handle  
   hSubMenu = GetSubMenu(GetMenu(Me.hWnd), 0)
   mnuItemCount = GetMenuItemCount(hSubMenu)
  
  'If there are an odd number of menu items, make
  'sure that the Left column has the extra item  
   If mnuItemCount Mod 2 <> 0 Then pad = 1
  
  'retrieve the current information For the
  'last item In the menu into an MENUITEMINFO structure.
  'True means MF_BYPOSITION.  
   mInfo.cbSize = Len(mInfo)
   mInfo.fMask = MIIM_TYPE
   mInfo.fType = MFT_STRING
   mInfo.dwTypeData = Space$(256)
   mInfo.cch = Len(mInfo.dwTypeData)

   r = GetMenuItemInfo(hSubMenu, (mnuItemCount \ 2) + pad, True, mInfo)
  
  'modify its attributes To the New Type,
  'telling the menu To insert a break before
  'the member In the MENUITEMINFO structure.  
   mInfo.fType = RGB_STARTNEWCOLUMNWITHVERTBAR
   mInfo.fMask = MIIM_TYPE

   r = SetMenuItemInfo(hSubMenu, (mnuItemCount \ 2) + pad, True, mInfo)

   If r Then Print " Done !"
  
End Sub
 


CyberWEB Network Ltda.    © Copyright 2000-2020   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página