vb实现菜单右对齐
【打印文章】
传统的窗口菜单都是左对齐,是否可以右对齐,或窗口菜单左右分开呢?
当然可以!
新建一个工程,添加菜单(本例需要3列),添加四个按钮控件,一个时间控件
添加以下代码:
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 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 GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal
b As Long, lpMenuItemInfo As menuItemInfo) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public a As Integer
Private Sub Command1_Click()
Unload Me
Me.Show
Dim my_menuItemInfo As menuItemInfo
Dim return_value As Long
With my_menuItemInfo
.cbSize = 44
.fMask = 16
.cch = 128
.dwTypeData = Space$(128)
End With
return_value = GetMenuItemInfo(GetMenu(Me.hwnd), 3, 1, my_menuItemInfo)
my_menuItemInfo.fType = 16384
return_value = SetMenuItemInfo(GetMenu(Me.hwnd), 3, 1, my_menuItemInfo)
DrawMenuBar GetMenu(Me.hwnd)
Me.Refresh
Me.WindowState = 1
End Sub
Private Sub Command2_Click()
Dim my_menuItemInfo As menuItemInfo
Dim return_value As Long
With my_menuItemInfo
.cbSize = 44
.fMask = 16
.cch = 128
.dwTypeData = Space$(128)
End With
return_value = GetMenuItemInfo(GetMenu(Me.hwnd), 0, 1, my_menuItemInfo)
my_menuItemInfo.fType = 16384
return_value = SetMenuItemInfo(GetMenu(Me.hwnd), 0, 1, my_menuItemInfo)
DrawMenuBar GetMenu(Me.hwnd)
Me.Refresh
Me.WindowState = 1
End Sub
Private Sub Command3_Click()
Unload Me
Me.Show
Dim my_menuItemInfo As menuItemInfo
Dim return_value As Long
With my_menuItemInfo
.cbSize = 44
.fMask = 16
.cch = 128
.dwTypeData = Space$(128)
End With
return_value = GetMenuItemInfo(GetMenu(Me.hwnd), 1, 1, my_menuItemInfo)
my_menuItemInfo.fType = 16384
return_value = SetMenuItemInfo(GetMenu(Me.hwnd), 1, 1, my_menuItemInfo)
DrawMenuBar GetMenu(Me.hwnd)
Me.Refresh
Me.WindowState = 1
End Sub
Private Sub Command4_Click()
Unload Me
Me.Show
Dim my_menuItemInfo As menuItemInfo
Dim return_value As Long
With my_menuItemInfo
.cbSize = 44
.fMask = 16
.cch = 128
.dwTypeData = Space$(128)
End With
return_value = GetMenuItemInfo(GetMenu(Me.hwnd), 2, 1, my_menuItemInfo)
my_menuItemInfo.fType = 16384
return_value = SetMenuItemInfo(GetMenu(Me.hwnd), 2, 1, my_menuItemInfo)
DrawMenuBar GetMenu(Me.hwnd)
Me.Refresh
Me.WindowState = 1
End Sub
Private Sub Timer1_Timer()
If Me.WindowState = 1 Then Me.WindowState = 0
End Sub
运行一下,如何?
注意四个按钮不同的一个参数,那表示左边有几个菜单项
当然可以!
新建一个工程,添加菜单(本例需要3列),添加四个按钮控件,一个时间控件
添加以下代码:
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 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 GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal
b As Long, lpMenuItemInfo As menuItemInfo) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public a As Integer
Private Sub Command1_Click()
Unload Me
Me.Show
Dim my_menuItemInfo As menuItemInfo
Dim return_value As Long
With my_menuItemInfo
.cbSize = 44
.fMask = 16
.cch = 128
.dwTypeData = Space$(128)
End With
return_value = GetMenuItemInfo(GetMenu(Me.hwnd), 3, 1, my_menuItemInfo)
my_menuItemInfo.fType = 16384
return_value = SetMenuItemInfo(GetMenu(Me.hwnd), 3, 1, my_menuItemInfo)
DrawMenuBar GetMenu(Me.hwnd)
Me.Refresh
Me.WindowState = 1
End Sub
Private Sub Command2_Click()
Dim my_menuItemInfo As menuItemInfo
Dim return_value As Long
With my_menuItemInfo
.cbSize = 44
.fMask = 16
.cch = 128
.dwTypeData = Space$(128)
End With
return_value = GetMenuItemInfo(GetMenu(Me.hwnd), 0, 1, my_menuItemInfo)
my_menuItemInfo.fType = 16384
return_value = SetMenuItemInfo(GetMenu(Me.hwnd), 0, 1, my_menuItemInfo)
DrawMenuBar GetMenu(Me.hwnd)
Me.Refresh
Me.WindowState = 1
End Sub
Private Sub Command3_Click()
Unload Me
Me.Show
Dim my_menuItemInfo As menuItemInfo
Dim return_value As Long
With my_menuItemInfo
.cbSize = 44
.fMask = 16
.cch = 128
.dwTypeData = Space$(128)
End With
return_value = GetMenuItemInfo(GetMenu(Me.hwnd), 1, 1, my_menuItemInfo)
my_menuItemInfo.fType = 16384
return_value = SetMenuItemInfo(GetMenu(Me.hwnd), 1, 1, my_menuItemInfo)
DrawMenuBar GetMenu(Me.hwnd)
Me.Refresh
Me.WindowState = 1
End Sub
Private Sub Command4_Click()
Unload Me
Me.Show
Dim my_menuItemInfo As menuItemInfo
Dim return_value As Long
With my_menuItemInfo
.cbSize = 44
.fMask = 16
.cch = 128
.dwTypeData = Space$(128)
End With
return_value = GetMenuItemInfo(GetMenu(Me.hwnd), 2, 1, my_menuItemInfo)
my_menuItemInfo.fType = 16384
return_value = SetMenuItemInfo(GetMenu(Me.hwnd), 2, 1, my_menuItemInfo)
DrawMenuBar GetMenu(Me.hwnd)
Me.Refresh
Me.WindowState = 1
End Sub
Private Sub Timer1_Timer()
If Me.WindowState = 1 Then Me.WindowState = 0
End Sub
运行一下,如何?
注意四个按钮不同的一个参数,那表示左边有几个菜单项
本栏文章均来自于互联网,版权归原作者和各发布网站所有,本站收集这些文章仅供学习参考之用。任何人都不能将这些文章用于商业或者其他目的。( Pfan.cn )
【编程爱好者论坛】