Professional Excel Development [Electronic resources] : The Definitive Guide to Developing Applications Using Microsoft® Excel and VBA® نسخه متنی

Working with the Keyboard

The behavior of many of Excel's toolbar buttons and some of the dialog buttons changes if the Shift key is held down when the button is clicked. For example, the Increase decimal toolbar button normally increases the number of decimal places shown in a cell, but decreases the number of decimal places if it is clicked with the Shift key held down. Similarly, when closing Excel, if you hold down the Shift key when clicking the No button on the Save Changes? dialog, it acts like a "No to All" button. We can do exactly the same in our applications by using API functions to examine the state of the keyboard. The procedures included in this section can be found in the MKeyboard module of the API Examples.xls workbook.

Checking for Shift, Ctrl, Alt, Caps Lock, Num Lock and Scroll Lock

The GetKeyState API function tells us whether a given key on the keyboard is currently held down or "on" (in the case of Caps Lock, Num Lock and Scroll Lock). The function is used by passing a code representing the key we're interested in and returns whether the key is being held down or is "on." Listing 9-8 shows a function to determine whether one of the six "special" keys is currently pressed. Note that we have again encapsulated the key code constants inside a more meaningful enumeration.

Listing 9-8. Checking Whether a Key Is Held Down

Private Declare Function GetKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
Private Const VK_SHIFT As Long = &H10
Private Const VK_CONTROL As Long = &H11
Private Const VK_MENU As Long = &H12
Private Const VK_CAPITAL = &H14
Private Const VK_NUMLOCK = &H90
Private Const VK_SCROLL = &H91
Public Enum GetKeyStateKeyboardCodes
gksKeyboardShift = VK_SHIFT
gksKeyboardCtrl = VK_CONTROL
gksKeyboardAlt = VK_MENU
gksKeyboardCapsLock = VK_CAPITAL
gksKeyboardNumLock = VK_NUMLOCK
gksKeyboardScrollLock = VK_SCROLL
End Enum
Public Function IsKeyPressed _
(ByVal lKey As GetKeyStateKeyboardCodes) As Boolean
Dim iResult As Integer
iResult = GetKeyState(lKey)
Select Case lKey
Case gksKeyboardCapsLock, gksKeyboardNumLock, _
gksKeyboardScrollLock
'For the three 'toggle' keys, the 1st bit says if it's
'on or off, so clear any other bits that might be set,
'using a binary AND
iResult = iResult And 1
Case Else
'For the other keys, the 16th bit says if it's down or
'up, so clear any other bits that might be set, using a
'binary AND
iResult = iResult And &H8000
End Select
IsKeyPressed = (iResult <> 0)
End Function

Bit Masks

The value obtained from the call to GetKeyState should not be interpreted as a simple number, but as its binary representation where each individual bit represents whether a particular attribute is on or off. This is one of the few functions that return a 16-bit Integer value, rather than the more common 32-bit Long. The MSDN documentation for GetKeyState says that "If the high-order bit is 1, the key is down, otherwise the key is up. If the low-order bit is 1, the key is on, otherwise the key is off." The first sentence is applicable for all keys (down/up), whereas the second is only applicable to the Caps Lock, Num Lock and Scroll Lock keys. It is possible for both bits to be set, if the Caps Lock key is held down and "on." The low-order bit is the rightmost bit, and the high-order bit is the leftmost (16th) bit. To examine whether a specific bit has been set, we have to apply a bit mask, to zero-out the bits we're not interested in, by performing a binary AND between the return value and a binary value that has a single 1 in the position we're interested in. In the first case, we're checking for a 1 in the first bit, which is the number 1. In the second case, we're checking for a 1 in the 16th bit, i.e. the binary number 1000 0000 0000 0000, which is easiest to represent in code as the hexadecimal number &h8000. After we've isolated that bit, a zero value means off/up and a nonzero value means on/down.

Testing for a Key Press

As mentioned previously, at the lowest level, windows communicate through messages sent to their wndproc procedure. When an application is busy (such as Excel running some code), the wndproc only processes critical messages (such as the system shutting down). All other messages get placed in a queue and are processed when the application next has some spare time. This is why using SendKeys is so unreliable; it's not until the code stops running (or issues a DoEvents statement) that Excel checks its message queue to see whether there are any key presses to process. Chapter 10 Userform Design and Best Practices), or allow the user to press the Cancel key to jump into the routine's error handler (as explained in Chapter 12 VBA Error Handling). An easier way is to check Excel's message queue during each iteration of the loop to see whether the user has pressed a key. This is achieved using the PeekMessage API function:

Declare Function PeekMessage Lib "user32" _
Alias "PeekMessageA" _
(ByRef lpMsg As MSG, _
ByVal hWnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long

Structures

If you look at the first parameter of the PeekMessage function, you'll see it is declared As MSG and is passed ByRef. MSG is a windows structure and is implemented in VBA as a user-defined type. To use it in this case, we declare a variable of that type and pass it in to the function. The function sets the value of each element of the UDT, which we then read. Many API functions use structures as a convenient way of passing large amounts of information into the function, instead of having a long list of parameters. Many messages that we send using the SendMessage function require a structure to be passed as the final parameter (as opposed to a single Long value). In those cases, we use a different form of the SendMessage declaration, where the final parameter is declared As Any and is passed ByRef:

Declare Function SendMessageAny Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long

When we use this declaration, we're actually sending a pointer to the memory where our UDT is stored. If we have an error in the definition of our UDT, or if we use this version of the declaration to send a message that is not expecting a memory pointer, the call will at best fail and possibly crash Excel.

Listing 9-9 shows the full code to check for a key press.

Listing 9-9. Testing for a Key Press

'Type to hold the coordinates of the mouse pointer
Private Type POINTAPI
x As Long
y As Long
End Type
'Type to hold the Windows message information
Private Type MSG
hWnd As Long      'the window handle of the app
message As Long   'the type of message (e.g. keydown)
wParam As Long    'the key code
lParam As Long    'not used
time As Long      'time when message posted
pt As POINTAPI    'coordinate of mouse pointer
End Type
'Look in the message buffer for a message
Private Declare Function PeekMessage Lib "user32" _
Alias "PeekMessageA" _
(ByRef lpMsg As MSG, ByVal hWnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long
'Translate the message from a key code to a ASCII code
Private Declare Function TranslateMessage Lib "user32" _
(ByRef lpMsg As MSG) As Long
'Windows API constants
Private Const WM_CHAR As Long = &H102
Private Const WM_KEYDOWN As Long = &H100
Private Const PM_REMOVE As Long = &H1
Private Const PM_NOYIELD As Long = &H2
'Check for a key press
Public Function CheckKeyboardBuffer() As String
'Dimension variables
Dim msgMessage As MSG
Dim hWnd As Long
Dim lResult As Long
'Get the window handle of this application
hWnd = ApphWnd
'See if there are any "Key down" messages
lResult = PeekMessage(msgMessage, hWnd, WM_KEYDOWN, _
WM_KEYDOWN, PM_REMOVE + PM_NOYIELD)
'If so ...
If lResult <> 0 Then
'... translate the key-down code to a character code,
'which gets put back in the message queue as a WM_CHAR
'message ...
lResult = TranslateMessage(msgMessage)
'... and retrieve that WM_CHAR message
lResult = PeekMessage(msgMessage, hWnd, WM_CHAR, _
WM_CHAR, PM_REMOVE + PM_NOYIELD)
'Return the character of the key pressed,
'ignoring shift and control characters
CheckKeyboardBuffer = Chr$(msgMessage.wParam)
End If
End Function

When we press a key on the keyboard, the active window is sent a WM_KEYDOWN message, with a low-level code to identify the physical key pressed. The first thing we need to do, then, is to use PeekMessage to look in the message queue to see whether there are any pending WM_KEYDOWN messages, removing it from the queue if we find one. If we found one, we have to translate it into a character code using TranslateMessage, which sends the translated message back to Excel's message queue as a WM_CHAR message. We then look in the message queue for this WM_CHAR message and return the character pressed.