API declarations to be compatible with different platforms

[YasserKhalil]

Hello everyone
I have the following API declaration lines

Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VK_NUMLOCK = &H90
Private Const VK_CAPITAL = &H14
Private Const VK_SCROLL = &H91
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
           
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

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

How can I make this compatible with any platform and any office version either 32 Bit or 64 Bit?

 

[Jaafar Tribak]

Hi Yasser,

How about this :

Option Explicit

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

Private Const VK_NUMLOCK = &H90
Private Const VK_CAPITAL = &H14
Private Const VK_SCROLL = &H91
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2         

#If VBA7 Then
    Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Private Declare PtrSafe Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
    Private Declare PtrSafe Function SetKeyboardState Lib "user32" (lppbKeyState As Byte) As Long
    Private Declare PtrSafe Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
#Else
    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
    Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
#End If

 

[YasserKhalil]

Thank you very much my friend.
It works for me Windows 10 64 Bit and Office 365 32 Bit

Function CheckOnOff(ByVal v)
    ReDim KeyboardBuffer(256) As Byte
    GetKeyboardState KeyboardBuffer(0)
    If KeyboardBuffer(v) And 1 Then CheckOnOff = True Else CheckOnOff = False
End Function

Public Sub ToggleButton(ByVal TurnOn As Boolean, ByVal v)
    Dim bytKeys(255) As Byte, bOn As Boolean, typOS As OSVERSIONINFO
    GetKeyboardState bytKeys(0)
    bOn = bytKeys(v)
    If bOn <> TurnOn Then
        If typOS.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
            bytKeys(v) = 1
            SetKeyboardState bytKeys(0)
        Else
            keybd_event v, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
            keybd_event v, &H45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
        End If
    End If
End Sub

'------------------------------------------------------------------------

Sub NumLockToggle()
    If CheckOnOff(VK_NUMLOCK) = False Then NumLockON Else NumLockOFF
End Sub

Sub NumLockON()
    ToggleButton True, VK_NUMLOCK
End Sub

Sub NumLockOFF()
    ToggleButton False, VK_NUMLOCK
End Sub

But I need to test it on different versions and BITS.

 

[Kyle123]

You know that you’ll never get it working on a Mac right?

 

[Jaafar Tribak]

You know that you’ll never get it working on a Mac right?

Good point Kyle123. I should have mentioned that.