Turn the CAPSLOCK on / off

[YasserKhalil]

Hello everyone
I found the following code

Code: Select all

' Declare Type for API call:
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128   '  Maintenance string for PSS usage
End Type
' API declarations:
Private Declare Function GetVersionEx Lib "kernel32" _
                                      Alias "GetVersionExA" _
                                      (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Sub keybd_event Lib "USER32" _
                                (ByVal bVk As Byte, _
                                 ByVal bScan As Byte, _
                                 ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyboardState Lib "USER32" _
                                          (pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "USER32" _
                                          (lppbKeyState As Byte) As Long
' Constant declarations:
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_CAPITAL = &H14
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2
Const VER_PLATFORM_WIN32_NT = 2
Const VER_PLATFORM_WIN32_WINDOWS = 1

Sub Test()
    Dim o As OSVERSIONINFO
    Dim NumLockState As Boolean
    Dim ScrollLockState As Boolean
    Dim CapsLockState As Boolean
    o.dwOSVersionInfoSize = Len(o)
    GetVersionEx o
    Dim keys(0 To 255) As Byte
    GetKeyboardState keys(0)

    ' CapsLock handling:
    CapsLockState = keys(VK_CAPITAL)
    If CapsLockState <> True Then    'Turn capslock on
        If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=== Win95/98
            keys(VK_CAPITAL) = 1
            SetKeyboardState keys(0)
        ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=== WinNT
            'Simulate Key Press
            keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
            'Simulate Key Release
            keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY _
                                          Or KEYEVENTF_KEYUP, 0
        End If
    End If
End Sub

I tested it and found it turned the CAPSLOCK on only.. But doesn't work for OFF
Any idea?

[YasserKhalil]

I found this link
https://support.microsoft.com/en-us/kb/177674" onclick="window.open(this.href);return false;
I tested it but only works to ON .. How to adapt to OFF?

[YasserKhalil]

Thanks a lot. I can figure it out

Code: Select all

Sub CAPSLOCK_ON_OFF()
    Dim o As OSVERSIONINFO
    Dim CapsLockState As Boolean
    Dim keys(0 To 255) As Byte
    
    o.dwOSVersionInfoSize = Len(o)
    GetVersionEx o
    GetKeyboardState keys(0)


        CapsLockState = keys(VK_CAPITAL)
    If CapsLockState <> True Then    'Turn capslock on
        If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=== Win95/98
            keys(VK_CAPITAL) = 1
            SetKeyboardState keys(0)
        ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=== WinNT
            'Simulate Key Press
            keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
            'Simulate Key Release
            keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY _
                                          Or KEYEVENTF_KEYUP, 0
        End If
    Else
        If o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then  '=== Win95/98
            keys(VK_CAPITAL) = 1
            SetKeyboardState keys(1)
        ElseIf o.dwPlatformId = VER_PLATFORM_WIN32_NT Then   '=== WinNT
            'Simulate Key Press
            keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 1
            'Simulate Key Release
            keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY _
                                          Or KEYEVENTF_KEYUP, 1
        End If
    End If
End Sub

But if there is another way I welcome it
Regards

[YasserKhalil]

Thank you very much
I welcome other solutions

[Sam1085]

Hi YasserKhalil,

Does this help?

Code: Select all

Private Type KeyboardBytes
kbByte(0 To 255) As Byte
End Type
Dim kbArray As KeyboardBytes

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
Private Declare Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
Private Declare Function SetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long


Sub CAPS_LOCK_ON_OFF()
KeyCode = &H14
GetKeyboardState kbArray
kbArray.kbByte(KeyCode) = IIf(kbArray.kbByte(KeyCode) = 1, 0, 1)
SetKeyboardState kbArray
End Sub

[HansV]

The code proposed by Sam1085 works for me but it has the disadvantage that the CapsLock indicator light isn't turned on if Caps Lock is on.

The following works for me, including the indicator light:

Code: Select all

Private Declare Sub keybd_event Lib "USER32" _
                                (ByVal bVk As Byte, _
                                 ByVal bScan As Byte, _
                                 ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetKeyboardState Lib "USER32" _
                                          (pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState Lib "USER32" _
                                          (lppbKeyState As Byte) As Long
' Constant declarations:
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_CAPITAL = &H14
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2

Sub CAPSLOCK_ON_OFF()
    Dim CapsLockState As Boolean
    Dim keys(0 To 255) As Byte

    GetKeyboardState keys(0)

    CapsLockState = keys(VK_CAPITAL)
    If CapsLockState <> True Then    'Turn capslock on
        'Simulate Key Press
        keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
        'Simulate Key Release
        keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY _
                                      Or KEYEVENTF_KEYUP, 0
    Else
        'Simulate Key Press
        keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 1
        'Simulate Key Release
        keybd_event VK_CAPITAL, &H45, KEYEVENTF_EXTENDEDKEY _
                                      Or KEYEVENTF_KEYUP, 1
    End If
End Sub

[Sam1085]

Wow! It's amazing!! Thank you Hans.

[YasserKhalil]

Thank you very much Mr. Sam & Mr. Rudi & Mr. HansV
You are so helpful and great people
Thanks a lot for great and awesome solution