在vb中使用加速键(accelerator keys)

在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