在vb中使用加速键(accelerator keys)
在vb中使用加速键(accelerator keys) '---------------------------------------------------------------------------------------
' 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
