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.
Main Topics
Browse All TopicsMy 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
This Question has been solved and asker verified All Experts Exchange premium technology solutions are available to subscription members.
Experts Exchange has been collecting answers to technology questions since 1996…3 million and counting! If you have a question, chances are we already have your answer.
If you can't find the exact answer you're looking for, ask our exclusive community of 50,000 experts. You’ll get a personalized answer from a trusted professional.
Thousands of free tech tips, tricks, how-to’s and tutorials are available in our peer reviewed articles section. See for yourself how smart our experts are, no login required.
Access the answers to your technology questions today.
30-day free trial. Register in 60 seconds.
Members of the expert community talk about why the experience at Experts Exchange is different than what you will find anywhere else.

Try it out and discover for yourself.
30-day free trial. Register in 60 seconds.
Join the community of experts here and help other tech pros by answering question in your area of expertise. You can earn FREE access to all Experts Exchange's premium features and resources.
This MSDN page breaks down the various language choices:
http://msdn.microsoft.com/
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:http://www.experts-ex
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(lLa
'you can populate a listbox/multiline textbox, etc. here based on lRet's value
Next i
'Restore current configuration
lRet = ActivateKeyboardLayout(lOr
' 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(lLa
'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(lOr
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
'This codewill enumerate what languages are installed(LCID)
'Form Code
Option Explicit
Dim WithEvents cEnumLCID As clsEnumLCID
Private Sub cEnumLCID_EnumLocales(ByVa
List1.AddItem Hex$(LCID) & vbTab & LCID & vbTab & _
pfGLI(LCID, LOCALE_SABBREVLANGNAME) & vbTab & _
pfGLI(LCID, LOCALE_SLANGUAGE)
End Sub
Private Sub cmdLoadLocales_Click()
Dim LCID As Long
Set cEnumLCID = New clsEnumLCID
'get the user's current default ID
LCID = GetSystemDefaultLCID()
'show the current localized name of language
Text1.Text = pfGLI(LCID, LOCALE_SLANGUAGE) & vbTab & _
pfGLI(LCID, LOCALE_SABBREVLANGNAME)
LocaleCount = 0
List1.Clear
List1.AddItem "Installed Locales:"
List1.AddItem "Hex" & vbTab & "Dec" & vbTab & "Abv" & vbTab & "Language"
List1.AddItem "---" & vbTab & "---" & vbTab & "---" & vbTab & "--------"
cEnumLCID.EnumInstalledLoc
lblInstalled.Caption = LocaleCount & " Installed"
Set cEnumLCID = Nothing
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set cEnumLCID = Nothing
End Sub
'Module Code (modEnumLCID)
Option Explicit
''''''''''''''''''''''''''
' Copyright ©1996-2004 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''
Public Const LOCALE_SLANGUAGE As Long = &H2 'localized name of language
Public Const LOCALE_SABBREVLANGNAME As Long = &H3 'abbreviated language name
Public Const LCID_INSTALLED As Long = &H1 'installed locale ids
Public Const LCID_SUPPORTED As Long = &H2 'supported locale ids
Public Const LCID_ALTERNATE_SORTS As Long = &H4 'alternate sort locale ids
Public Const VER_PLATFORM_WIN32_NT As Long = 2
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Public Declare Function GetLocaleInfoA Lib "kernel32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Public Declare Function GetLocaleInfoW Lib "kernel32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Public Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
Public Declare Function EnumSystemLocales Lib "kernel32" Alias "EnumSystemLocalesA" (ByVal lpLocaleEnumProc As Long, ByVal dwFlags As Long) As Long
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string
End Type
Private Buffer As String * 255
Private m_lObj As Long
Public LocaleCount As Long
Public Function EnumSystemLocalesProc(lpLo
'application-defined callback function for EnumSystemLocales
Dim pos As Integer
Dim dwLocaleDec As Long
Dim dwLocaleHex As String
Dim sLocaleName As String
Dim sLocaleAbbrev As String
'pad a string to hold the format
dwLocaleHex = Space$(32)
'copy the string pointed to by the return value
CopyMemory ByVal dwLocaleHex, lpLocaleString, ByVal Len(dwLocaleHex)
dwLocaleHex = Right$(StripNull(dwLocaleH
dwLocaleDec = CLng("&H" & dwLocaleHex)
'sLocaleName = pfGLI(dwLocaleDec, LOCALE_SLANGUAGE)
'sLocaleAbbrev = pfGLI(dwLocaleDec, LOCALE_SABBREVLANGNAME)
LocaleCount = LocaleCount + 1
theCtrl.fReturnLocale dwLocaleDec
'frmEnumLCID.List1.AddItem
dwLocaleDec & vbTab & _
sLocaleAbbrev & vbTab & _
sLocaleName
'and return 1 to continue enumeration
EnumSystemLocalesProc = 1
End Function
Public Property Let theCtrl(ByVal nCtrl As clsEnumLCID)
m_lObj = ObjPtr(nCtrl)
End Property
Public Property Get theCtrl() As clsEnumLCID
Dim ct As clsEnumLCID
If (m_lObj <> 0) Then
CopyMemory ct, m_lObj, 4
Set theCtrl = ct
CopyMemory ct, 0&, 4
End If
End Property
Public Function pfGLI(ByVal m_LocaleLCID As Long, ByVal reqInfo As Long) As String
If IsNT Then
GetLocaleInfoW m_LocaleLCID, reqInfo, Buffer, 255
pfGLI = StripNull(StrConv(Buffer, vbFromUnicode))
Else
GetLocaleInfoA m_LocaleLCID, reqInfo, Buffer, 255
pfGLI = StripNull(Buffer)
End If
End Function
Public Function IsNT() As Boolean
Dim udtVer As OSVERSIONINFO
On Error Resume Next
udtVer.dwOSVersionInfoSize
If GetVersionEx(udtVer) Then
If udtVer.dwPlatformId = VER_PLATFORM_WIN32_NT Then
IsNT = True
End If
End If
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
Public Function pfMAKELCID(PLang As Long, SLang As Long) As Long
Dim tX As Long
tX = SLang * 2 ^ 10
tX = tX Or PLang
pfMAKELCID = tX
End Function
Public Function pfPrimaryLang(ByVal LCID As Long) As Long
pfPrimaryLang = LCID Mod 1024
End Function
Public Function pfSecondaryLang(ByVal LCID As Long) As Long
pfSecondaryLang = LCID \ 2 ^ 10
End Function
'Class code (clsEnumLCID)
Option Explicit
Public Event EnumLocales(ByVal LCID As Long)
Public Sub EnumInstalledLocales()
EnumSystemLocales AddressOf EnumSystemLocalesProc, LCID_INSTALLED
End Sub
Public Sub EnumSupportedLocales()
EnumSystemLocales AddressOf EnumSystemLocalesProc, LCID_SUPPORTED
End Sub
Public Function fReturnLocale(ByVal LCID As Long)
RaiseEvent EnumLocales(LCID)
End Function
Private Sub Class_Initialize()
theCtrl = Me
End Sub
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(lLa
lRet = GetKeyboardLayout(0&)
LCID = LoWord(lRet)
RaiseEvent EnumKybdLayouts(LCID)
Next i
'Restore current configuration
lRet = ActivateKeyboardLayout(lOr
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
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(lLa
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(lOr
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
Business Accounts
Answer for Membership
by: edwardiiiPosted on 2005-05-02 at 07:48:38ID: 13909445
Hi, garyLittle.
e.com/Prog ramming/ Pr ogramming_ Languages/ Visual_Bas ic/VB_Cont rols/ Q_212 08243.html ?query=Reg ional+Opti ons&topics =94
Please see the following EE link regarding determining a PC's Regional Options settings:
http://www.experts-exchang