怎么修改菜单热键

goldstar3000 2010-10-14 06:15:36
怎么修改菜单热键
...全文
156 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
dingyanwei 2010-10-15
  • 打赏
  • 举报
回复
1、将keypreview设置为true

2、在form的keydown事件中增加你的热键组合,并设置其作用
goldstar3000 2010-10-14
  • 打赏
  • 举报
回复
不行了,改了加上是不能用的
咸清 2010-10-14
  • 打赏
  • 举报
回复
改数据库里的数据喽~~
goldstar3000 2010-10-14
  • 打赏
  • 举报
回复
'Call CreateActiveMenu
Dim hMenu As Long, hSubMenu As Long
ReDim hPopMenuTmp(0) As Long
ReDim 编号(0)
ReDim MenuText(0)
Dim i As Integer
hMenu = GetMenu(Me.hwnd) '窗体级菜单句柄

If hMenu = 0 Then
'窗体上没有菜单时,创建菜单。这种情况下需在设计阶段设置窗体的NegotiatMenu=False菜单才能显示出来。
hMenu = CreateMenu()
End If
hSubMenu = hMenu

OpenConn

SQL = "select * from 菜单表 where isnull(子编号,0)=0"

rs.Open SQL, cn, 1, 1


Do While Not rs.EOF
ReDim Preserve hPopMenuTmp(rs!编号)
ReDim Preserve 编号(rs!编号)
hPopMenuTmp(rs!编号) = CreatePopupMenu()
编号(rs!编号) = rs!编号
AppendMenu1 hSubMenu, MF_POPUP, hPopMenuTmp(rs!编号), rs!菜单名称 & IIf(IsNull(rs!热键) = True, "", rs!热键)

rs.MoveNext
Loop
CloseConn


For i = 1 To UBound(编号)
OpenConn



SQL = "select * from 菜单表 where 子编号=" & 编号(i)
rs.Open SQL, cn, 1, 1
Do While Not rs.EOF
'hPopMenuTmp = GetSubMenu(hSubMenu, rs!编号)

'保存菜单文本,用于菜单事件触发时识别出被选择的菜单对象
ReDim Preserve MenuText(rs!编号)
MenuText(rs!编号) = rs!菜单名称
'加入子菜单,令其ID>1000,说明其为自动生成的菜单
AppendMenu1 hPopMenuTmp(编号(i)), MF_STRING, 1000 + rs!编号, MenuText(rs!编号) & IIf(IsNull(rs!热键) = True, "", rs!热键) & Space(5) & IIf(IsNull(rs!快捷键) = True, "", rs!快捷键)
'如果是间隔线,则wFlags=MF_SEPARATOR
'如果要Check,则wFlags=MF_STRING + MF_CHECKED,若令不可用,则再加MF_GRAYED
MIndex = MIndex + 1
SetMenuItemBitmaps hPopMenuTmp(编号(i)), 1000 + rs!编号, MF_bitmap, ImageList1.ListImages(MIndex).Picture, ImageList1.ListImages(MIndex).Picture

rs.MoveNext
Loop

CloseConn
Next


ReDim Preserve hPopMenuTmp(UBound(编号) + 1)
hPopMenuTmp(UBound(编号) + 1) = CreatePopupMenu()
AppendMenu1 hSubMenu, MF_POPUP, hPopMenuTmp(UBound(编号) + 1), "帮助(&H)"
ReDim Preserve MenuText(MIndex + 1)
MenuText(MIndex + 1) = "关于我们(&A)"
'加入子菜单,令其ID>1000,说明其为自动生成的菜单
AppendMenu1 hPopMenuTmp(UBound(编号) + 1), MF_STRING, 1000 + MIndex + 1, MenuText(MIndex + 1)
ReDim Preserve MenuText(MIndex + 1)
MenuText(MIndex + 1) = "帮助(&H)"
'加入子菜单,令其ID>1000,说明其为自动生成的菜单
AppendMenu1 hPopMenuTmp(UBound(编号) + 1), MF_STRING, 1000 + MIndex + 1, MenuText(MIndex + 1)


SetMenu Me.hwnd, hMenu
DrawMenuBar Me.hwnd


OldWinProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf OnMenu)

模块

Public Const MF_POPUP = &H10&
Public Const MF_STRING = &H0&
Public Const MF_DISABLED = &H2&
Public Const MF_SEPARATOR = &H800&
Public Const MF_CHECKED = &H8&
Public Const MF_GRAYED = &H1&
Public Const MF_BYCOMMAND = &H0&
Public Const GWL_WNDPROC = (-4)
Public Const WM_COMMAND = &H111
Public Declare Function CreateMenu Lib "user32" () As Long
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function AppendMenu1 Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long
Public Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
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 Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Public MenuCount As Long '菜单数量,不包括不能触发的菜单
Public MenuText() As String '菜单文本,ID=wParam的菜单的文本为MenuText(wParam - 1000)
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
'{响应菜单事件}
Select Case wMsg
Case WM_COMMAND
If wParam > 1000 And wParam <= 1000 + 255 Then
'MsgBox MenuText(wParam - 1000)
End If
End Select
OnMenu = CallWindowProc(OldWinProc, hwnd, wMsg, wParam, lParam)
End Function



游子 2010-10-14
  • 打赏
  • 举报
回复
代码。。。发来。。
goldstar3000 2010-10-14
  • 打赏
  • 举报
回复
我是动态菜单,菜单编辑器不能用的
我是小数位 2010-10-14
  • 打赏
  • 举报
回复
工具-菜单编辑器—快捷键
jhone99 2010-10-14
  • 打赏
  • 举报
回复
窗体——〉(右键)菜单编辑器——〉快捷键

7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧