 There
may be times when, in displaying a multiple-selection menu, that an 'option-button' style bullet is preferable over the default checkmark for
denoting the selected item in a related menu list. Using the MENUITEMINFO structure along with GetMenuItemInfo and SetMenuItemInfo, provides
a simple means to to alter the checkmark displayed.
This example shows how to create a routine that can be passed any
form, menubar menu, and, by specifying the menu item array index, change the default checkmark into a radio button.
The first menu (OptionsA) contains nine items (including the
separator) named mnuOptionsA(0) through mnuOptionsA(8). The second menu (OptionsB) has the same six menu captions along with a separator and
is named mnuOptionsB(0) through mnuOptionsB(6). The parent menubar names for this demo is mnuOptsA and mnuOptsB. The form load event uses the
API to change the bullet representation for the first three menu items in each menu.
In the originally presentation of this method, I had stated that this
routine would not work on a menu shown as a popup menu:
- Original statement: The (old) method below relies on
being able to obtain both the menu and submenu window handles. However, as a popup, this information is not available until the menu is
shown, at which point Windows is already awaiting the menu selection - in other words, too late. Consequently, the handles can not be
retrieved, and the menu radio option can't be set for a popup menu.
This is partially incorrect. On Windows NT4 the popup menus do
display radio checkmarks if set, but only if the parent menu item is visible. When the menu parent is hidden, the above holds true. |
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MIIM_STATE As Long = &H1
Private Const MIIM_ID As Long = &H2
Private Const MIIM_SUBMENU As Long = &H4
Private Const MIIM_CHECKMARKS As Long = &H8
Private Const MIIM_TYPE As Long = &H10
Private Const MIIM_DATA As Long = &H20
Private Const MFT_RADIOCHECK As Long = &H200
Private Const MENU_IDENTIFIER As Long = &H1
Private Const MFT_STRING As Long = &H0
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 Declare Function GetMenuItemInfo Lib "user32" _
Alias "GetMenuItemInfoA" _
(ByVal hMenu As Long, _
ByVal uItem As Long, _
ByVal fByPosition As Long, _
lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "user32" _
Alias "SetMenuItemInfoA" _
(ByVal hMenu As Long, _
ByVal uItem As Long, _
ByVal fByPosition As Long, _
lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function GetMenu 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 Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
mnuOptionsA(0).Checked = True
mnuOptionsB(0).Checked = True
End Sub
Private Sub Command1_Click()
'mnuBarIndex : 0-based horizontal position of the menu
' i.e. File = 0, Edit = 1, etc...
'
'mnuItem : 0-based vertical item in the menu
' i.e. under File, New = 0,
' Open = 1, Save =2 etc
SetRadioMenuChecksB frm:=Form1, mnuBarIndex:=0, mnuItem:=0
SetRadioMenuChecksB frm:=Form1, mnuBarIndex:=0, mnuItem:=1
SetRadioMenuChecksB frm:=Form1, mnuBarIndex:=0, mnuItem:=2
SetRadioMenuChecksB frm:=Form1, mnuBarIndex:=1, mnuItem:=0
SetRadioMenuChecksB frm:=Form1, mnuBarIndex:=1, mnuItem:=1
SetRadioMenuChecksB frm:=Form1, mnuBarIndex:=1, mnuItem:=2
End Sub
Private Sub Form_MouseUp(Button As Integer, _
Shift As Integer, _
X As Single, Y As Single)
If Button = vbRightButton Then
PopupMenu mnuOptsA
End If
End Sub
Private Sub mnuOptionsA_Click(Index As Integer)
Static prevSelection As Integer
Select Case Index
Case 0 To mnuOptionsA.UBound - 1
mnuOptionsA(prevSelection).Checked = False
mnuOptionsA(Index).Checked = True
prevSelection = Index
Case mnuOptionsA.UBound
Unload Me
End Select
End Sub
Private Sub mnuOptionsB_Click(Index As Integer)
Static prevSelection As Integer
mnuOptionsB(prevSelection).Checked = False
mnuOptionsB(Index).Checked = True
prevSelection = Index
End Sub
Private Sub SetRadioMenuChecksB(frm As Form, _
mnuBarIndex As Long, _
ByVal mnuItem As Long)
Dim hMenu As Long
Dim hSubMenu As Long
Dim mInfo As MENUITEMINFO
'get the menu handle
hMenu = GetMenu(frm.hWnd)
'get the submenu handle
hSubMenu = GetSubMenu(hMenu, mnuBarIndex)
'fill a structure to retrieve the current
'item menu string by first calling
'GetMenuItemInfo passing a null string.
'The required size is returned in
'mInfo.cch. Add 1 to accommodate the
'null that will be added when called.
With mInfo
.cbSize = Len(mInfo)
.fMask = MIIM_TYPE
.fType = MFT_STRING
.dwTypeData = vbNullString
.cch = Len(mInfo.dwTypeData)
'get the needed buffer size
Call GetMenuItemInfo(hSubMenu, mnuItem, MENU_IDENTIFIER, mInfo)
'set the buffer
.dwTypeData = Space$(mInfo.cch + 1)
.cch = Len(mInfo.dwTypeData)
End With
'and get the data
If GetMenuItemInfo(hSubMenu, mnuItem, MENU_IDENTIFIER, mInfo) <> 0 Then
'copy its attributes, changing
'the checkmark to a radio button
With mInfo
.cbSize = Len(mInfo)
.fType = MFT_RADIOCHECK
.fMask = MIIM_TYPE
End With
'modify the menu item
Call SetMenuItemInfo(hSubMenu, mnuItem, MENU_IDENTIFIER, mInfo)
End If
End Sub |
