Switch system keyboard language to match SendKeys characters

contrib/TouchKeyboard/test/Form1.frm

@@ -144,12 +144,6 @@ Public Sub RegisterCancelMode(oCtl As Object)
     Set m_oCtlCancelMode = oCtl
 End Sub
 
-Public Sub SendKeys(sText As String, Optional ByVal bWait As Boolean)
-   With CreateObject("WScript.Shell")
-        .SendKeys sText, bWait
-   End With
-End Sub
-
 Private Sub ctxTouchKeyboard1_ButtonClick(ByVal Index As Long)
     Dim sText           As String
 
@@ -197,13 +191,7 @@ Private Sub ctxTouchKeyboard1_ButtonClick(ByVal Index As Long)
             sText = ctxTouchKeyboard1.ButtonCaption(Index)
         End If
     End Select
-    If LenB(sText) <> 0 Then
-        SendKeys sText
-        If LenB(m_sNextLayout) <> 0 Then
-            ctxTouchKeyboard1.Layout = m_sNextLayout
-            m_sNextLayout = vbNullString
-        End If
-    End If
+    pvSendKeys ctxTouchKeyboard1, sText
 End Sub
 
 Private Sub ctxTouchKeyboard2_ButtonClick(ByVal Index As Long)
@@ -219,7 +207,7 @@ Private Sub ctxTouchKeyboard2_ButtonClick(ByVal Index As Long)
             sText = ctxTouchKeyboard2.ButtonCaption(Index)
         End If
     End Select
-    SendKeys sText
+    pvSendKeys ctxTouchKeyboard1, sText
 End Sub
 
 Private Sub Form_Load()
@@ -239,3 +227,19 @@ Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y A
     End If
 End Sub
 
+Private Sub pvSendKeys(oCtl As ctxTouchKeyboard, sText As String)
+    If LenB(sText) <> 0 Then
+        If sText Like "[à-ÿÀ-ß]" Then
+            KeybLanguage = "bg"
+        ElseIf sText Like "[a-zA-Z]" Then
+            KeybLanguage = "en"
+        End If
+        With CreateObject("WScript.Shell")
+            .SendKeys sText, False
+        End With
+        If LenB(m_sNextLayout) <> 0 Then
+            oCtl.Layout = m_sNextLayout
+            m_sNextLayout = vbNullString
+        End If
+    End If
+End Sub

contrib/TouchKeyboard/test/Module1.bas

@@ -0,0 +1,69 @@
+Attribute VB_Name = "Module1"
+Option Explicit
+
+'--- for GetLocaleInfo
+Private Const LOCALE_SISO639LANGNAME        As Long = &H59
+'--- for ActivateKeyboardLayout
+Private Const HKL_NEXT                      As Long = 1
+Private Const KLF_ACTIVATE                  As Long = &H1
+Private Const KLF_SETFORPROCESS             As Long = &H100
+'--- for LoadKeyboardLayout
+Private Const KLID_BULGARIAN                As String = "00030402"
+Private Const KLID_US                       As String = "00000409"
+
+Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
+Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal hKL As Long, ByVal Flags As Long) As Long
+Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal Flags As Long) As Long
+Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
+
+Property Get KeybLanguage() As String
+    KeybLanguage = pvGetUserLocaleInfo(GetKeyboardLayout(0) And &HFFFF&, LOCALE_SISO639LANGNAME)
+End Property
+
+Property Let KeybLanguage(sValue As String)
+    Dim hKL             As Long
+    Dim hActive         As Long
+    Dim sKLID           As String
+
+    If LenB(sValue) = 0 Then
+        GoTo QH
+    End If
+    hActive = GetKeyboardLayout(0)
+    hKL = hActive
+    Do
+        If LCase$(pvGetUserLocaleInfo(hKL And &HFFFF&, LOCALE_SISO639LANGNAME)) = LCase$(sValue) Then
+            GoTo QH
+        End If
+        Call ActivateKeyboardLayout(HKL_NEXT, 0)
+        hKL = GetKeyboardLayout(0)
+    Loop While hKL <> hActive
+    Select Case LCase$(sValue)
+    Case "bg"
+        sKLID = KLID_BULGARIAN
+    Case "en"
+        sKLID = KLID_US
+    End Select
+    If LoadKeyboardLayout(sKLID, KLF_ACTIVATE Or KLF_SETFORPROCESS) = 0 Then
+        Debug.Print "LoadKeyboardLayout, sKLID=" & sKLID & ", Err.LastDllError=" & Err.LastDllError, vbCritical
+    End If
+    If ActivateKeyboardLayout(sKLID, KLF_SETFORPROCESS) = 0 Then
+        If Err.LastDllError <> 0 Then
+            Debug.Print "ActivateKeyboardLayout, sKLID=" & sKLID & ", Err.LastDllError=" & Err.LastDllError, vbCritical
+        End If
+    End If
+QH:
+End Property
+
+Private Function pvGetUserLocaleInfo(ByVal dwLocaleID As Long, ByVal dwLCType As Long) As String
+   Dim sReturn          As String
+   Dim nSize            As Long
+
+   nSize = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
+   If nSize > 0 Then
+      sReturn = Space$(nSize)
+      nSize = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
+      If nSize > 0 Then
+         pvGetUserLocaleInfo = Left$(sReturn, nSize - 1)
+      End If
+   End If
+End Function

contrib/TouchKeyboard/test/Project1.vbp

@@ -6,6 +6,7 @@ Module=mdTouchKeyboard; ..\src\mdTouchKeyboard.bas
 UserControl=..\src\ctxTouchKeyboard.ctl
 Form=Form1.frm
 UserControl=..\src\ctxTouchButton.ctl
+Module=Module1; Module1.bas
 Startup="Form1"
 HelpFile=""
 Title="Project1"