'***************************************************************************
'*                                                                         *
'* MODULE NAME:     CHECK KEYBOARD BUFFER                                  *
'*                                                                         *
'* AUTHOR & DATE:   STEPHEN BULLEN,  Stephen@oaltd.co.uk                   *
'*                                                                         *
'* DESCRIPTION:     This module contains an example of using Windows API   *
'*                  calls to check the state of the message buffer.  The   *
'*                  example includes a check for "Key down" events, which  *
'*                  are used to stop a loop.  The module contains functions*
'*                  for both 16-bit and 32-bit versions of Windows.        *
'*                                                                         *
'***************************************************************************

Option Base  1 
Option Explicit



'********************************************************************
'* DECLARE WINDOWS 32-BIT API CALLS                                 *
'********************************************************************

'Type to hold the x and y coordinates of the mouse pointer
Type POINTAPI32
    x As Long
    y As Long
End Type

'Type to hold the Windows message information
Type MSG32
    hWnd As Long        'the window handle of the app
    message As Long     'the type of message (e.g. keydown, keyup etc)
    wParam As Long      'stores the key code
    lParam As Long      '?
    time As Long        'time when message posted
    pt As POINTAPI32    'coordinate of mouse pointer when messahe posted
End Type

'Find the window handle for this instance of Excel
Declare Function FindWindow32 Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

'Look in the message buffer for a message
Declare Function PeekMessage32 Lib "USER32" Alias "PeekMessageA" (lpMsg As MSG32, _
    ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, _
    ByVal wRemoveMsg As Long) As Long

'Translate the message from a virtual key code to a ASCII code
Declare Function TranslateMessage32 Lib "USER32" Alias "TranslateMessage" (lpMsg As MSG32) As Long


'********************************************************************
'* Demo procedure to test the keyboard checking function            *
'********************************************************************

Sub procTestKey()

Dim iCount As Integer
Dim sKey As String

Application.DisplayStatusBar = True

iCount =  0 

'Just loop until a key is pressed
Do
    iCount = iCount +  1 
    Application.StatusBar = "Loop: " & iCount & "  Press any key to stop."

    '******************************************
    '*         INSERT YOUR CODE HERE          *
    '******************************************

    'Call the appropriate routine to check the keyboard buffer
   
        sKey = funCheckKey32
  
Loop Until sKey <> ""

'Display the key pressed
MsgBox "You pressed: " & sKey

Application.StatusBar = False

End Sub




'***************************************************************************
'*                                                                         *
'* FUNCTION NAME:   CHECK KEYBOARD BUFFER - 32 BIT                         *
'* AUTHOR & DATE:   STEPHEN BULLEN, 9 APRIL 1996                           *
'*                                                                         *
'* DESCRIPTION:     This function uses Windows API calls to check if there *
'*                  are any 'Key down' messages for the application.  If   *
'*                  there are some, it returns the key pressed as a string *
'*                                                                         *
'***************************************************************************

Function funCheckKey32() As String

'Dimension variables
Dim msgMessage As MSG32
Dim iHwnd As Long
Dim i As Long

'Dimension Windows API constants
Const WM_CHAR As Long = &H102
Const WM_KEYDOWN As Long = &H100
Const PM_REMOVE As Long = &H1
Const PM_NOYIELD As Long = &H2

'Default to no key pressed
funCheckKey32 = ""

'Get the window handle of this application
iHwnd = FindWindow32("XLMAIN", Application.Caption)

'See if there are any "Key down" messages
i = PeekMessage32(msgMessage, iHwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE + PM_NOYIELD)

'If so ...
If i <>  0  Then
    '... translate the virtual key code to a character code ...
    i = TranslateMessage32(msgMessage)
    
    '... and get the character code message
    i = PeekMessage32(msgMessage, iHwnd, WM_CHAR, WM_CHAR, PM_REMOVE + PM_NOYIELD)

    'Return the character of the key pressed
    funCheckKey32 = Chr(msgMessage.wParam)
End If

End Function