Option Compare Database
'Keyboard functions for MS Access
'VERSION 1.0
'c. 1995 by Bliss Sloan, CDM Associates
'Distribute freely as long as you keep the full copyright notice and addresses in.. :)
'(615)354-1500 voice, (615)354-3116 alternate voice
'(615) 523-7544 voice mail, One Tahiti on AOL, 73770,1501 on CompuServe
'
'*******************
'     CAPS LOCK    *
'*******************
'SetCapsLock(True) turns on caps lock and returns true if successful, false otherwise
'SetCapsLock(False) turns off caps lock and returns true if successful, false otherwise
'CapsLockOn() turns on caps lock (same as SetCapsLock(True) without error return)
'CapsLockOff() turns off caps lock (same as SetCapsLock(False) without error return)
'
'*******************
'     NUM LOCK    *
'*******************
'SetNumLock(True) turns on Num lock and returns true if successful, false otherwise
'SetNumLock(False) turns off Num lock and returns true if successful, false otherwise
'NumLockOn() turns on Num lock (same as SetNumLock(True) without error return)
'NumLockOff() turns off Num lock (same as SetNumLock(False) without error return)
'

'***************************************************
'in declarations section of module:
'***************************************************
Declare Sub Acc_GetKeyboardState Lib "User" Alias "GetKeyBoardState" (ByVal lpKeyBuf As String)
Declare Sub Acc_SetKeyboardState Lib "User" Alias "SetKeyBoardState" (ByVal lpKeyBuf As String)

Function CapsLockOff ()
'turn off Num lock
    On Error Resume Next
    Dim intSuccessful As Integer
    intSuccessful = SetCapsLock(False)
End Function

Function CapsLockOn ()
'turn on caps lock
    On Error Resume Next
    Dim intSuccessful As Integer
    intSuccessful = SetCapsLock(True)
End Function

Function NumLockOff ()
'turn off Num lock
    On Error Resume Next
    Dim intSuccessful As Integer
    intSuccessful = SetNumLock(False)
End Function

Function NumLockOn ()
'turn on num lock
    On Error Resume Next
    Dim intSuccessful As Integer
    intSuccessful = SetNumLock(True)

End Function

Function SetCapsLock (intTrueIfOnFalseIfOff As Integer) As Integer
'***************************************************
'Function to set capslock to ON or OFF based on True or False input parameter
'       INPUT: True to turn caps lock on, false to turn it off
'       OUTPUT: True if successful, False if an error occurred
'       EXAMPLE: intSuccessFlag=SetCapsLock(True)   'turns on caps lock, puts true in intSuccessFlg if successful
'c. 1995 by Bliss Sloan, CDM Associates
'Use freely as long as you keep the full copyright notice and addresses in.. :)
'(615)354-1500 voice, (615)354-3116 alternate voice
'(615) 523-7544 voice mail, One Tahiti on AOL, 73770,1501 on CompuServe
'****************************************************
        On Error GoTo SetCapsLock_Err

        Const ACC_VK_CAPITAL = &H14&
        Const ACC_SHIFTLOCK_ON = &H81&
        Dim strKeyBuf As String

'make sure buffer is long enough or GetKeyboardState will overwrite mem.
strKeyBuf = Space$(256)                 'make sure string is long enough :)

'get the current keyboard state
        Call Acc_GetKeyboardState(strKeyBuf)

'set the character which is Hex 14 from the beginning (when you start
'counting at 0 like you do in C) (i.e., the 21st char in Access parlance)
'to a hex 81 = decimal 129 for shift lock on, or 0 for shift lock off,
'preserving the rest of the 256-character string
        Dim intKeyValue As Integer
        If intTrueIfOnFalseIfOff Then
                intKeyValue = ACC_SHIFTLOCK_ON
        Else
                intKeyValue = 0
        End If

        strKeyBuf = Left$(strKeyBuf, ACC_VK_CAPITAL) & Chr$(intKeyValue) & Mid$(strKeyBuf, ACC_VK_CAPITAL + 2, 255 - ACC_VK_CAPITAL)

'now set the keyboard state from your newly updated buffer
        Call Acc_SetKeyboardState(strKeyBuf)

        SetCapsLock = True
SetCapsLock_Exit:
        Exit Function
SetCapsLock_Err:
        On Error Resume Next
        SetCapsLock = False
        MsgBox "SetCapsLock Error: " & Error$

End Function

Function SetNumLock (intTrueIfOnFalseIfOff As Integer) As Integer
'***************************************************
'Function to set numlock to ON or OFF based on True or False input parameter
'       INPUT: True to turn numlock on, false to turn it off
'       OUTPUT: True if successful, False if an error occurred
'       EXAMPLE: intSuccessFlag=SetNumLock(True)   'turns on numlock, puts true in intSuccessFlg if successful
'c. 1995 by Bliss Sloan, CDM Associates
'Use freely as long as you keep the full copyright notice and addresses in.. :)
'(615)354-1500 voice, (615)354-3116 alternate voice
'(615) 523-7544 voice mail, One Tahiti on AOL, 73770,1501 on CompuServe
'****************************************************
        On Error GoTo SetNumLock_Err

        Const ACC_VK_NUMLOCK = &H90&
        Const ACC_NUMLOCK_ON = &H81&
        Dim strKeyBuf As String

'make sure buffer is long enough or GetKeyboardState will overwrite mem.
        strKeyBuf = Space$(256)                 'make sure string is long enough :)

'get the current keyboard state
        Call Acc_GetKeyboardState(strKeyBuf)

'set the character which is Hex 90 from the beginning (when you start
'counting at 0 like you do in C) (i.e., the 145th char in Access parlance)
'to a hex 81 = decimal 129 for numlock on, or 0 for shift lock off,
'preserving the rest of the 256-character string
        Dim intKeyValue As Integer
        If intTrueIfOnFalseIfOff Then
                intKeyValue = ACC_NUMLOCK_ON
        Else
                intKeyValue = 0
        End If

        strKeyBuf = Left$(strKeyBuf, ACC_VK_NUMLOCK) & Chr$(intKeyValue) & Mid$(strKeyBuf, ACC_VK_NUMLOCK + 2, 255 - ACC_VK_NUMLOCK)

'now set the keyboard state from your newly updated buffer
        Call Acc_SetKeyboardState(strKeyBuf)

        SetNumLock = True
SetNumLock_Exit:
        Exit Function
SetNumLock_Err:
        On Error Resume Next
        SetNumLock = False
        MsgBox "NumLock Error: " & Error$


End Function

