روش ساخت منو به صورت چند ستوني

[Amin_vb]

اين كد به شما اين امكان را مي‌دهد كه منو‌هايي به صورت چند ستوني در ويژوال بيسيك داشته باشيد. ابتدا يك دكمه به نام Command1 به فرم خود اضافه نماييد سپس با استفاده از ابزار منو سازي دو منو اصلي و 4 زير منو براي هريك درست كنيد سپس كد زير را در ماژول قرار دهيد.

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

Private Const MF_MENUBARBREAK = &H20& ' columns with a separator line
Private Const MF_MENUBREAK = &H40&    ' columns w/o a separator line
Private Const MF_STRING = &H0&
Private Const MF_HELP = &H4000&
Private Const MFS_DEFAULT = &H1000&
Private Const MIIM_ID = &H2
Private Const MIIM_SUBMENU = &H4
Private Const MIIM_TYPE = &H10
Private 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()

    ' Splitting a menu here demonstrates that this can be done dynamically.
    Dim mnuItemInfo As MENUITEMINFO, hMenu As Long, hSubMenu As Long
    Dim BuffStr As String * 80   ' Define as largest possible menu text.
    
    hMenu = GetMenu(Me.hwnd)   ' retrieve menu handle.
    BuffStr = Space(80)
    With mnuItemInfo   ' Initialize the UDT.
           .cbSize = Len(mnuItemInfo)   ' 44
           .dwTypeData = BuffStr & Chr(0)
           .fType = MF_STRING
           .cch = Len(mnuItemInfo.dwTypeData)   ' 80
           .fState = MFS_DEFAULT
           .fMask = MIIM_ID Or MIIM_DATA Or MIIM_TYPE Or MIIM_SUBMENU
    End With

    ' Use item break point position for the '3' below (zero-based list).
    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)   ' Repaint top level Menu.

End Sub



Private Sub Form_Load()

    ' This works for either an API-created menu or a native VB Menu.
    Dim mnuItemInfo As MENUITEMINFO, hMenu As Long, hSubMenu As Long
    Dim BuffStr As String * 80   ' Define as largest possible menu text.
    
    hMenu = GetMenu(Me.hwnd)   ' Retrieve menu handle.
    BuffStr = Space(80)
    
    With mnuItemInfo   ' Initialize the UDT
           .cbSize = Len(mnuItemInfo)   ' 44
           .dwTypeData = BuffStr & Chr(0)
           .fType = MF_STRING
           .cch = Len(mnuItemInfo.dwTypeData)   ' 80
           .fState = MFS_DEFAULT
           .fMask = MIIM_ID Or MIIM_DATA Or MIIM_TYPE Or MIIM_SUBMENU
    End With

    ' Use item break point position for the '3' below (zero-based list).
    hSubMenu = GetSubMenu(hMenu, 1)
    If GetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then
       MsgBox "GetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
    Else
       mnuItemInfo.fType = mnuItemInfo.fType Or MF_MENUBREAK
       If SetMenuItemInfo(hSubMenu, 2, True, mnuItemInfo) = 0 Then
          MsgBox "SetMenuItemInfo failed. Error: " & Err.LastDllError, , "Error"
       End If
    End If
    DrawMenuBar (Me.hwnd)   ' Repaint top level Menu.

End Sub

ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ

هميشه شاد باشيد.
:roll: