1你所要建的子菜单必须在在相同的子菜单类且连续,
2名称必须相同;
3索引必须赋值,比如0,1,2,这里的索引跟建立控件数组的索引一样,索引值就是你要编写的对象
完成之后,就可以对你的子菜单就行编辑事件,下面我举个例:
比如我要在标签中改变文本的字体颜色
Private
Sub
Form_Load()
MeAutoRedraw
=
True
Label1Caption
=
"文字颜色变化"
Label1FontSize
=
15
End
Sub
Private
Sub
num_Click(Index
As
Integer)
Select
Case
Index
Case
0
Label1ForeColor
=
vbRed
Case
1
Label1ForeColor
=
vbBlue
End
Select
End
Sub
我试过,希望对你有帮助VB实现窗口的d出式菜单
在Windows95、Windows98或NT的风格中,有按动鼠标器右键d出下拉菜单的 *** 作,在VB执行环境下,有一些控件本身具有d下拉菜单的功能,如TexTbox控件等,但大多数编辑类控件以及窗体本身却没有此功能,要在窗口中任意位置实现PopUpMenu(d出式菜单),可借助VB的菜单工具来实现。
首先,打开VB的“工具”菜单条,利用“菜单编辑器”为窗体生成一个菜单:
标题(Caption) 菜单条名(Name)
编辑 menuEdit
……复制 mnuCopy
……剪切 munCut
其次,将生成的menuEdit菜单设置为不可视。
Private Sub Form_Load()
MemenuEditVisibe=False
′menuEdit菜单设置为不可视
End Sub
然后,利用MouseDown事件实现任意位置d出PopUpMenu,如下例:
本例中以RichTexBox控件为例,在其上面实现复制、剪切功能。
1.复制功能的实现。
Private Sub MnuCopy_Click()
ClipboarClear′将剪贴板清空
′将RichTexBox控件上选择上的内容复制到剪贴板
ClipboardSetTextRichTexBox1SelText
End Sub
2.剪切功能的实现。
Private Sub MnuCut_Click()
ClipboardClear ′将剪贴板清空
′将RichTextBox控件上选择了的内容复制到剪贴板
ClipboardSetTextRichBox1SelText
′将RichTexBox控件上选择了的内容删除
SendKeys〃{DELETE}〃,True
End Sub
3.在RichTexBox控件的MouseDown事件中实现任意位置d出PopUPMenu。
OPrivate Sub RichTexBox1_MouseDown(Button As Integer,Shift As Integer,x As Single,Y As Single)
Dim MnuFile AS Menu ′声明一个菜单类型的变量
Set munFile=MeMenuEdit ′将MenuEdit赋给菜单变量
if Button=2 Then ′判断是否按动鼠标器右键
′判断RichTexBox控件上选择了的内容是否存在,决定复制、剪切菜单条是否可 *** 作。
If Len(RichTexBoxText)=0 Or Len(RichTexBoxSelText)=0 Then
mnuCopyEnabled=Flase ′复制菜单条不可 *** 作。
nmuCutEnabled=False ′剪切菜单条不可 *** 作。
nmuCopyEnabled=True ′复制菜单条可 *** 作。
nmuCutEnabled=True ′剪切菜单条可 *** 作。
End IF
PopupMenu mnuFile ′d出PopUpMenu。
End If
End Sub
这样,在VB执行环境中, *** 作窗体上的RichTexBox控件,按动鼠标器右键就可d出下拉菜单,实现复制、剪切功能。方法1:使用菜单数组
在文件菜单里增加一个菜单项,标题任意,现在假设菜单项的Name属性是mnuDynamic
更改菜单项mnuDynamic的可见属性,使mnuDynamicVisible=
False
更改菜单项mnuDynamic的下标(索引)属性,使mnuDynamicIndex=0
在程序中控制菜单项mnuDynamic的动态装入。
Load
mnuDynamic(1)
mnuDynamic(1)Caption
=
"动态菜单1"
mnuDynamic(1)Visible
=
True
方法2:使用用API函数
新建一个模块,复制以下代码。
Public
Declare
Function
SetWindowLong
Lib
"user32"
Alias
"SetWindowLongA"
(ByVal
hwnd
As
Long,
ByVal
nIndex
As
Long,
ByVal
dwNewLong
As
Long)
As
Long
Public
Declare
Function
CallWindowProc
Lib
"user32"
Alias
"CallWindowProcA"
(ByVal
lpPrevWndFunc
As
Long,
ByVal
hwnd
As
Long,
ByVal
Msg
As
Long,
ByVal
wParam
As
Long,
ByVal
lParam
As
Long)
As
Long
Public
Const
MF_STRING
=
&H0&
Public
Const
MF_BYCOMMAND
=
&H0&
Public
Const
GWL_WNDPROC
=
(-4)
Public
Const
WM_COMMAND
=
&H111
Public
OldWinProc
As
Long
Public
Function
OnMenu(ByVal
hwnd
As
Long,
ByVal
wMsg
As
Long,
ByVal
wParam
As
Long,
ByVal
lParam
As
Long)
As
Long
'{响应菜单事件}
If
wMsg
=
WM_COMMAND
Then
If
wParam
=
1000
Then
MsgBox
"Dynamic"
End
If
OnMenu
=
CallWindowProc(OldWinProc,
hwnd,
wMsg,
wParam,
lParam)
End
Function
窗体代码:
Private
Sub
Form_Load()
Dim
hMenu
As
Long,
hSubMenu
As
Long
hMenu
=
GetMenu(Mehwnd)
hSubMenu
=
GetSubMenu(hMenu,
0)
InsertMenu
hSubMenu,
0,
MF_BYCOMMAND
Or
MF_STRING,
1000,
"Dynamic"
OldWinProc
=
SetWindowLong(Mehwnd,
GWL_WNDPROC,
AddressOf
OnMenu)
End
Sub
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)