用SetMenu就是设置窗体的菜单
覆盖
不是添加
如果是添加:
rtn = AppendMenu(GetMenu(hWnd), MF_BYPOSITION, id, "MenuName")要使它有子菜单,就必须先用CreatePopupMenu创建弹出式菜单:
id=CreatePopupMenu
rtn = AppendMenu(GetMenu(hWnd), MF_BYPOSITION Or MF_POPUP, id, "MenuName")
覆盖
不是添加
如果是添加:
rtn = AppendMenu(GetMenu(hWnd), MF_BYPOSITION, id, "MenuName")要使它有子菜单,就必须先用CreatePopupMenu创建弹出式菜单:
id=CreatePopupMenu
rtn = AppendMenu(GetMenu(hWnd), MF_BYPOSITION Or MF_POPUP, id, "MenuName")
Const MF_APPEND = &H100&
Const TPM_LEFTALIGN = &H0&
Const MF_DISABLED = &H2&
Const MF_GRAYED = &H1&
Const MF_SEPARATOR = &H800&
Const MF_STRING = &H0&
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, ByVal lprc As Any) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim hMenu As Long
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: [email protected]
'Create an empty popupmenu
hMenu = CreatePopupMenu()
'Append a few menu items
AppendMenu hMenu, MF_STRING, ByVal 0&, "Hello !"
AppendMenu hMenu, MF_GRAYED Or MF_DISABLED, ByVal 0&, "Testing ..."
AppendMenu hMenu, MF_SEPARATOR, ByVal 0&, ByVal 0&
AppendMenu hMenu, MF_CHECKED, ByVal 0&, "TrackPopupMenu"
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Pt As POINTAPI
'Get the position of the mouse cursor
GetCursorPos Pt
If Button = 1 Then
'Show our popupmenu
TrackPopupMenu hMenu, TPM_LEFTALIGN, Pt.x, Pt.y, 0, Me.hwnd, ByVal 0&
Else
'Show our form's default popup menu
TrackPopupMenu GetSystemMenu(Me.hwnd, False), TPM_LEFTALIGN, Pt.x, Pt.y, 0, Me.hwnd, ByVal 0&
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Destroy our menu
DestroyMenu hMenu
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim pSM As ClsSMenu
Dim TempMIS As MEASUREITEMSTRUCT
Dim TempDIS As DRAWITEMSTRUCT
Select Case uMsg
Case WM_MEASUREITEM '告诉系统绘制的控件大小
在这里的设置菜单的大小
Case WM_DRAWITEM '绘制控件
在这里画菜单
Case Else
'下级传递消息
WindowProc = CallWindowProc(MeOldWndProc, hwnd, uMsg, wParam, lParam)
End Select
End Function
SubClass就是为了捕获系统发出的让你画菜单项的消息WM_DRAWITEM和WM_MEASUREITEM,从消息处理函数的参数获得自画必需的 数据。你就可以在自己的消息处理函数中画图写字了。
2. 设置菜单是自画的。
在VB的菜单设计器设计了菜单后,然后SubClass这个窗体。你会发现根本就不发生前面说的那两个消息。原来这些菜单是系统画的,你没有设置它们是自画的。当然没有这两个消息发生。必须调用相关的API函数设置窗体的菜单项是自画的。设置了以后每当要显示这些菜单项目时系统就会发出那两个消息了。而且会传出必要的参数,是菜单自画必需的。
设置菜单为自画需要这几个关于菜单的API函数。
Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Declare Function ModifyMenuLong Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Long) As Long
3. 收到WM_DRAWITEM消息怎么办?
在这里才开始画可见的菜单项。消息处理函数lParam参数指向一个结构声明如下:
Public Type DRAWITEMSTRUCT
CtlType As Long '自画控件的类型
CtlID As Long
ItemID As Long '菜单项目ID
itemAction As Long '
itemState As Long '菜单项状态
hwndItem As Long
hDC As Long '菜单项的DC,要向这个DC画图,写字
rcItem As Rect '菜单项的矩形大小。要仔细控制矩形区域中图片和文本的位置。
itemData As Long '
End Type
声明变量:
Private mDrawInfo As DRAWITEMSTRUCT
使用CopyMemory拷贝到定义的变量中
CopyMemory mDrawInfo, ByVal lParam, Len(mDrawInfo)
这个结构中的成员itemState表明了菜单项目的状态:
state = DrawInfo.itemState
bSel = state And ODS_SELECTED '鼠标在菜单项上,选中。
bEnab = Not state And ODS_DISABLED '菜单项是Enable还是Disable
bCheck = state And ODS_CHECKED '菜单项是否设为Checked
具体画图和写字已在(3)中讲述。
4. 还要处理WM_MEASUREITEM消息。
WM_MEASUREITEM在菜单创建时在WM_DRAWITEM之前发生,已决定菜单项目的矩形大小。消
息处理函数lParam参数指向一个结构声明如下:
Type MEASUREITEMSTRUCT
CtlType As Long
CtlID As Long
ItemID As Long
itemWidth As Long
itemHeight As Long
itemData As Long
End Type
使用CopyMemory拷贝到定义的变量中
Private mMeasureInfo As MEASUREITEMSTRUCT
CopyMemory mMeasureInfo, ByVal lParam, Len(mMeasureInfo)
我们的函数要设置itemWidth和itemHeight的,再拷贝结构变量回lParam参数指向地址。
相当于按引用传递。
CopyMemory ByVal lParam, mMeasureInfo, Len(mMeasureInfo)
决定itemWidth和itemHeight的值要考虑到同一个MenuBar的菜单项中要取最长Caption
的菜单项的宽度。菜单高度取系统菜单高度,设置字体的高度, 菜单项的图片高度属性
三者的最大值。