[Thewolf]

س !!!!!!!!!! دوستان خسته نباشید!!!!!!!!!!!!
هنگامی که تعداد منو ها زیاد است و ممکن است از صفحه اصلی برنامه بیرون بزند، استفاده از منوهای چند ستونی کار بسیار مفیدی است.
VB خود تابعی برای این کار ندارد اما با Api ها می توان چنین کاری کرد.

روش ساخت منوهای چند ستونی:
1- یک پروژه جدید ایجاد کنید.
2- یک CommandButton به فرم اضافه کنید.
3- با استفاده از Menu Editor، دو منو ایجاد کنید و برای هر منو چهار زیر منو انتخاب کنید.
4- کدهای زیر را در قسمت General فرم وارد کنید:

کد:

Option Explicit
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
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If Button = vbRightButton Then
PopupMenu saf ' Use the name of one of your menus.
End If
End Sub

5- عبارت "Aaa" را در آخرین کد (در بخش Form_MouseDown) به نام یکی از منوهای اصلی تغییر دهید.

خب
حال اگر برنامه را اجرا کنید و روی منو ها کلیک کنید هیچ تغییری را مشاهده
نمی کنید. اما اگر روی CommandButton کلیک کنید سپس روی منو ها کلیک کنید،
تغییر را مشاهده خواهید کرد.

(برای اطلاعات بیشتر و اطلاعات مفید در مورد منو ها به کتاب "کار با منو ها" که از سایت "Parsbook" قابل دانلود است، مراجعه نمایید.)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!