13 Декабрь 2008

Выравнивание меню по правому краю

Меню |  Таги:

Выравнивание меню по правому краю.

Option Explicit

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function DrawMenuBar 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

Const MIIM_TYPE = &H10
Const MFT_RIGHTJUSTIFY = &H4000
Const MFT_STRING = &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 Sub Command1_Click()
Dim MnuInfo As MENUITEMINFO
Dim mnuH As Long, MyTemp As Long
mnuH = GetMenu(Me.hwnd)
MnuInfo.cbSize = Len(MnuInfo)
MnuInfo.fMask = MIIM_TYPE
'Если вы хотите выровнять только часть пунктов меню, тогда замените в следующей
'строке, а также в строке над End Sub число 0 на число пунктов, которое вы хотите
'оставить слева
MyTemp = GetMenuItemInfo(mnuH, 0, True, MnuInfo)
MnuInfo.fType = MFT_RIGHTJUSTIFY Or MFT_STRING
'Вам также надо заменить "3" на имя пункта, которое будет крайним слева
'в новой расстановке
MnuInfo.cch = Len("3")
MnuInfo.dwTypeData = "3"
MnuInfo.cbSize = Len(MnuInfo)
MyTemp = SetMenuItemInfo(mnuH, 2, True, MnuInfo)
MyTemp = DrawMenuBar(Me.hwnd)
End Sub


Оставить комментарий

Я не робот.