'--------------------------------------------------------------------------------------- ' Module : Module1 ' DateTime : 2005-10-12 00:14 ' Author : Lingll ' Email : lingll_xl@163.com ' Purpose : TranslateAccelerator sample '--------------------------------------------------------------------------------------- Option Explicit Public Declare Function GetMessage Lib "user32.dll" Alias "GetMessageA" (ByRef lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long Public Declare Sub PostQuitMessage Lib "user32.dll" (ByVal nExitCode As Long) Public Declare Function TranslateAccelerator Lib "user32.dll" Alias "TranslateAcceleratorA" (ByVal hwnd As Long, ByVal hAccTable As Long, ByRef lpMsg As MSG) As Long Public Declare Function CreateAcceleratorTable Lib "user32.dll" Alias "CreateAcceleratorTableA" (ByVal lpaccl As Long, ByVal cEntries As Long) As Long Public Declare Function DestroyAcceleratorTable Lib "user32.dll" (ByVal haccel As Long) As Long Public Declare Function TranslateMessage Lib "user32.dll" (ByRef lpMsg As MSG) As Long Public Declare Function DispatchMessage Lib "user32.dll" Alias "DispatchMessageA" (ByRef lpMsg As MSG) As Long Public Type POINTAPI x As Long y As Long End Type Public Type MSG hwnd As Long message As Long wParam As Long lParam As Long time As Long pt As POINTAPI End Type Public Type ACCEL fVirt As Integer key As Integer cmd As Integer 'rev As Integer End Type Public Const FSHIFT As Long = &H4 Public Const FCONTROL As Long = &H8 Public Const FALT As Long = &H10 Public Const FNOINVERT As Long = &H2 Public Const FVIRTKEY As Long = 3 ' 131 Public Const WM_COMMAND As Long = &H111 Public Const VK_F11 As Long = &H7A Public Const WM_KEYDOWN As Long = &H100 Sub Main() Dim tHwnd& tHwnd = Form1.hwnd Form1.Show Dim tMsg As MSG Dim tVk(0 To 1) As ACCEL 'Ctrl+C With tVk(0) .cmd = 102 .fVirt = FVIRTKEY Or FCONTROL .key = vbKeyC End With 'F8 With tVk(1) .cmd = 101 .fVirt = FVIRTKEY Or FCONTROL .key = vbKeyF8 End With Dim tTable& tTable = CreateAcceleratorTable(VarPtr(tVk(0)), 2) While (GetMessage(tMsg, 0, 0, 0) <> 0) If TranslateAccelerator(tHwnd, tTable, tMsg) = 0 Then Call TranslateMessage(tMsg) Call DispatchMessage(tMsg) End If Wend DestroyAcceleratorTable (tTable) End Sub

对form1做子类处理,响应WM_COMMAND消息,
记得在程序退出时 PostQuitMessage (0)

什么情况下需要:当用api创建菜单的时候,当想要动态改变菜单快捷键的时候

by lingll
lingll_xl@163.com
lingll.yeah.net