Link to home
Start Free TrialLog in
Avatar of garyLittle
garyLittle

asked on

How to determine whether other languages have been installed in "Regional Options"

My application is in VB6 and has the ability to dynamically change the entire program to one of 15 languages. Many of these languages such as French, Danish, Estonian, German, etc. can utilize the US English System Language under the Regional Options. Others such as Korean, Japanese, Russian, Farsi need the system language option changed to their respective lanugage in order to have the menus in the language. This works fine as long as the correct input Text Service keyboard is chosen.
I find that I can keep the VB6 menus in English, as an option, when choosing, for example Russian, but still input Russian into a RTF control if the Russian input system keyboard has been loaded beforehand.

Finally, my question is: how can I ascertain what Regional Options | Text Service keyboards have been installed in the system so that I can alert the user what keyboards are available? Also what other foreign language  codepages have been installed.
Gary
Avatar of edwardiii
edwardiii

Hi, garyLittle.

Please see the following EE link regarding determining a PC's Regional Options settings:

https://www.experts-exchange.com/questions/21208243/Find-Regional-option-of-PC-using-VB.html?query=Regional+Options&topics=94
Avatar of garyLittle

ASKER

Edwardiii,
I did see that but I am interested in what language keyboards have been installed. I don't think the above link addresses that. Maybe I am wrong.
This MSDN page breaks down the various language choices:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/intl/nls_9l2r.asp

For example, German (Standard) has an identifier of "0x0407".  You can input the "0407" in Windows' Scientific Calculator with it set to "Hex", then click "Dec" and the result is: 1031.
Thank you. This is an excellent resource.
But I think I have not correctly identified the problem I am having.
I need to query the operating system to see if the Farsi or Korean or Japanese keyboard handlers have been installed. These do not normally come already installed in WinXP system. You have to go to the Regional Options and install these keyboards. I need to know if the user has done this on their system.
Take a look at this link:https://www.experts-exchange.com/questions/20387081/Change-language-in-VB.html

You can modify it slightly as follows:

Command button to list available language layouts on system:

Dim lOriginalLayout As Long
    Dim lRet As Long
    Dim i As Integer

    ReDim lLayouts(50) As Long

    'Save current configuration
    lOriginalLayout = GetKeyboardLayout(0)

    'Get the first 50 supported keyboard layouts (50 is max supported for now)
    lRet = GetKeyboardLayoutList(50, lLayouts(0))
    'Loop through all the keyboard layouts
    For i = 0 To UBound(lLayouts)
        If lLayouts(i) = 0 Then
            Exit For
        End If
        'Activate the keyboard layout and get its name
        lRet = ActivateKeyboardLayout(lLayouts(i), 0)
        'you can populate a listbox/multiline textbox, etc. here based on lRet's value
    Next i
   
    'Restore current configuration
    lRet = ActivateKeyboardLayout(lOriginalLayout, 0)
Avatar of Dana Seaman
' Form Code:
Option Explicit
Private Sub Form_Load()
   Dim i As Long
   Dim vLayouts As Variant
   vLayouts = GetKybdLayouts
   For i = 0 To UBound(vLayouts)
      Debug.Print vLayouts(i)
   Next
End Sub

'Module Code
Option Explicit

Private Declare Function GetKeyboardLayout& Lib "user32" (ByVal dwLayout As Long)
Private Declare Function GetKeyboardLayoutList& Lib "user32" (ByVal nBuff As Long, lpList As Long)
Private Declare Function ActivateKeyboardLayout& Lib "user32" (ByVal hkl As Long, ByVal flags As Long)
Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Private Declare Function GetLocaleInfoA Lib "KERNEL32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

Const KL_NAMELENGTH As Long = 9
Const LOCALE_SENGCOUNTRY As Long = &H1002 '// English name of country
Private buf As String * KL_NAMELENGTH

Public Function GetKybdLayouts() As Variant
   Dim lOriginalLayout  As Long
   Dim lRet             As Long
   Dim i                As Integer

   ReDim lLayouts(50) As Long
   Dim sLayouts() As String

   'Save current configuration
   lOriginalLayout = GetKeyboardLayout(0)

   'Get the first 50 supported keyboard layouts (50 is max supported for now)
   lRet = GetKeyboardLayoutList(50, lLayouts(0))
   'Loop through all the keyboard layouts
   For i = 0 To UBound(lLayouts)
      If lLayouts(i) = 0 Then
         Exit For
      End If
      'Activate the keyboard layout and get its name
      lRet = ActivateKeyboardLayout(lLayouts(i), 0)
      'you can populate a listbox/multiline textbox, etc. here based on lRet's value
      lRet = GetKeyboardLayoutName(buf)
      'Debug.Print "KeyboardLayoutName=", buf, pfGLI(("&H" & Right$(buf, 3)), LOCALE_SENGCOUNTRY)
      ReDim Preserve sLayouts(i)
      sLayouts(i) = pfGLI(("&H" & Right$(buf, 3)), LOCALE_SENGCOUNTRY)
     
   Next i
   GetKybdLayouts = sLayouts
   'Restore current configuration
   lRet = ActivateKeyboardLayout(lOriginalLayout, 0)

End Function

Private Function pfGLI(ByVal m_LocaleLCID As Long, ByVal reqInfo As Long) As String
   Dim Buffer          As String * 255
   GetLocaleInfoA m_LocaleLCID, reqInfo, Buffer, 255
   pfGLI = StripNull(Buffer)
End Function

Public Function StripNull(ByVal StrIn As String) As String
   Dim nul              As Long
   nul = InStr(StrIn, vbNullChar)
   Select Case nul
      Case Is > 1
         StripNull = Left$(StrIn, nul - 1)
      Case 1
         StripNull = ""
      Case 0
         StripNull = Trim$(StrIn)
   End Select
End Function
ASKER CERTIFIED SOLUTION
Avatar of Dana Seaman
Dana Seaman
Flag of Brazil image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks to you  danaseaman. Both your last two were perfect!!
Thanks for sticking with me. This is everything I need.
Gary
One unresolved issue is separating the Primary Language ID and Secondary Language ID from data returned by GetKeyboardLayoutName. On my box I should get Primary "Portuguese" and Secondary "Brazilian". The current code I posted only returns Portuguese which would lead one to believe it is "Iberian".  I'll post results as soon as I get this coded.
Updated code (encapsulated in a class) returns LCID for each Keyboard installed. Example output on my box:
LCID - LOCALE_SLANGUAGE
-----------------------
416 - Português (Brasil)
401 - Árabe (Arábia Saudita)
804 - Chinês (República Popular da China)
404 - Chinês (Taiwan)
412 - Coreano
409 - Inglês (Estados Unidos)
816 - Português (Portugal)
412 - Coreano

'Form code
Option Explicit

Const LOCALE_SENGCOUNTRY   As Long = &H1002 '// English name of country
Const LOCALE_SLANGUAGE     As Long = &H2   '// localized name of language
Const LOCALE_SENGLANGUAGE  As Long = &H1001   '// English name of language

Dim WithEvents KL As clsKeyboardLayout

Private Sub Form_Load()
   Set KL = New clsKeyboardLayout
   Debug.Print "LCID - LOCALE_SLANGUAGE"
   Debug.Print "-----------------------"
   KL.EnumKybdLayouts
   Unload Me
End Sub

Private Sub KL_EnumKybdLayouts(ByVal LCID As Long)
   Debug.Print Hex(LCID) & " - " & KL.pfGLI(LCID, LOCALE_SLANGUAGE)
End Sub

'Class code - clsKeyboardLayout
Option Explicit

Public Event EnumKybdLayouts(ByVal LCID As Long)

Private Declare Function GetKeyboardLayout& Lib "user32" (ByVal dwLayout As Long)
Private Declare Function GetKeyboardLayoutList& Lib "user32" (ByVal nBuff As Long, lpList As Long)
Private Declare Function ActivateKeyboardLayout& Lib "user32" (ByVal hkl As Long, ByVal flags As Long)
Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Private Declare Function GetLocaleInfoA Lib "KERNEL32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

Const KL_NAMELENGTH        As Long = 9
Const LOCALE_SENGCOUNTRY   As Long = &H1002 '// English name of country
Const LOCALE_SLANGUAGE     As Long = &H2   '// localized name of language
Private buf As String * KL_NAMELENGTH

Public Sub EnumKybdLayouts()
   Dim lOriginalLayout  As Long
   Dim lRet             As Long
   Dim i                As Integer

   ReDim lLayouts(50) As Long
   Dim LCID             As Long

   'Save current configuration
   lOriginalLayout = GetKeyboardLayout(0)

   'Get the first 50 supported keyboard layouts (50 is max supported for now)
   lRet = GetKeyboardLayoutList(50, lLayouts(0))
   'Loop through all the keyboard layouts
   For i = 0 To UBound(lLayouts)
      If lLayouts(i) = 0 Then
         Exit For
      End If
      'Activate the keyboard layout and get its name
      lRet = ActivateKeyboardLayout(lLayouts(i), 0)
      lRet = GetKeyboardLayout(0&)
      LCID = LoWord(lRet)
      RaiseEvent EnumKybdLayouts(LCID)
   Next i

   'Restore current configuration
   lRet = ActivateKeyboardLayout(lOriginalLayout, 0)

End Sub

Public Function pfGLI(ByVal m_LocaleLCID As Long, ByVal reqInfo As Long) As String
   Dim Buffer          As String * 255
   GetLocaleInfoA m_LocaleLCID, reqInfo, Buffer, 255
   pfGLI = StripNull(Buffer)
End Function

Private Function LoWord(wParam As Long) As Integer
   If wParam And &H8000& Then
      LoWord = &H8000& Or (wParam And &H7FFF&)
   Else
      LoWord = wParam And &HFFFF&
   End If
End Function

Private Function StripNull(ByVal StrIn As String) As String
   Dim nul              As Long
   nul = InStr(StrIn, vbNullChar)
   Select Case nul
      Case Is > 1
         StripNull = Left$(StrIn, nul - 1)
      Case 1
         StripNull = ""
      Case 0
         StripNull = Trim$(StrIn)
   End Select
End Function
Thanks again. I will try it today.
One other issue is:
Can I change the keyboard layout from the program. for example, change from USenglish to Russian?
Gary
The code as is remembers the current Keyboard and as it steps thru the list activates the keyboard with with list item to retrieve LCID and finally restores the current keyboard at the end. Should be a simple code modification to implement this. I'll post it later today.
Modified code to set kybd layout to specified LCID. LCID should be supplied as long. Example English= 1033 or you could supply English= &H409 which is the Hex equivalent. It will set new Keyboard Layout if it is available(installed) otherwise it will retain the current keyboard layout.

'Form code
Option Explicit

Const LOCALE_SENGCOUNTRY   As Long = &H1002 '// English name of country
Const LOCALE_SLANGUAGE     As Long = &H2   '// localized name of language
Const LOCALE_SENGLANGUAGE  As Long = &H1001   '// English name of language

Dim WithEvents KL As clsKeyboardLayout

Private Sub Form_Load()
   Set KL = New clsKeyboardLayout
   Debug.Print "LCID - LOCALE_SLANGUAGE"
   Debug.Print "-----------------------"
   KL.EnumKybdLayouts &H409
   Unload Me
End Sub

Private Sub KL_EnumKybdLayouts(ByVal LCID As Long)
   Debug.Print Hex(LCID) & " - " & KL.pfGLI(LCID, LOCALE_SLANGUAGE)
End Sub

'Class code - clsKeyboardLayout
Option Explicit

Public Event EnumKybdLayouts(ByVal LCID As Long)

Private Declare Function GetKeyboardLayout& Lib "user32" (ByVal dwLayout As Long)
Private Declare Function GetKeyboardLayoutList& Lib "user32" (ByVal nBuff As Long, lpList As Long)
Private Declare Function ActivateKeyboardLayout& Lib "user32" (ByVal hkl As Long, ByVal flags As Long)
Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Private Declare Function GetLocaleInfoA Lib "KERNEL32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

Const KL_NAMELENGTH        As Long = 9
Const LOCALE_SENGCOUNTRY   As Long = &H1002 '// English name of country
Const LOCALE_SLANGUAGE     As Long = &H2   '// localized name of language
Private buf As String * KL_NAMELENGTH

Public Sub EnumKybdLayouts(Optional ByVal NewLayoutLCID As Long = 0)
   Dim lOriginalLayout  As Long
   Dim lRet             As Long
   Dim i                As Integer

   ReDim lLayouts(50) As Long
   Dim LCID             As Long

   'Save current configuration
   lOriginalLayout = GetKeyboardLayout(0)

   'Get the first 50 supported keyboard layouts (50 is max supported for now)
   lRet = GetKeyboardLayoutList(50, lLayouts(0))
   'Loop through all the keyboard layouts
   For i = 0 To UBound(lLayouts)
      If lLayouts(i) = 0 Then
         Exit For
      End If
      'Activate the keyboard layout and get its name
      lRet = ActivateKeyboardLayout(lLayouts(i), 0)
      lRet = GetKeyboardLayout(0&)
      LCID = LoWord(lRet)
      If NewLayoutLCID = LCID Then
         lOriginalLayout = lRet
      End If
     
      RaiseEvent EnumKybdLayouts(LCID)
   Next i

   'Restore current (or requested if available) configuration
   lRet = ActivateKeyboardLayout(lOriginalLayout, 0)

End Sub

Public Function pfGLI(ByVal m_LocaleLCID As Long, ByVal reqInfo As Long) As String
   Dim Buffer          As String * 255
   GetLocaleInfoA m_LocaleLCID, reqInfo, Buffer, 255
   pfGLI = StripNull(Buffer)
End Function

Private Function LoWord(wParam As Long) As Integer
   If wParam And &H8000& Then
      LoWord = &H8000& Or (wParam And &H7FFF&)
   Else
      LoWord = wParam And &HFFFF&
   End If
End Function

Private Function StripNull(ByVal StrIn As String) As String
   Dim nul              As Long
   nul = InStr(StrIn, vbNullChar)
   Select Case nul
      Case Is > 1
         StripNull = Left$(StrIn, nul - 1)
      Case 1
         StripNull = ""
      Case 0
         StripNull = Trim$(StrIn)
   End Select
End Function