Question

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

Asked by: garyLittle

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

This Question has been solved and asker verified All Experts Exchange premium technology solutions are available to subscription members.

Subscribe now for full access to Experts Exchange and get

Instant Access to this Solution

  • Plus...
  • 30 Day FREE access, no risk, no obligation
  • Collaborate with the world's top tech experts
  • Unlimited access to our exclusive solution database
  • Never be left without tech help again

Subscribe Now

Asked On
2005-05-02 at 06:11:56ID21409380
Topic

VB Controls

Participating Experts
2
Points
500
Comments
13

Trusted by hundreds of thousands everyday for fast, accurate and reliable tech support.

  • "The time we save is the biggest benefit of Experts Exchange to Warner Bros. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange." Mike Kapnisakis, Warner Bros.
  • "Our team likes having a resource that is more secure than just using Google and most experts using this service really know their stuff. It's nice to look here first versus using Google." Dayna Sellner, Lockheed Martin
  • "Anytime that I've been stumped with a problem, 9 out of 10 times Experts Exchange has either the accepted solution or an open discussion of the potential solution to the problem." Kenny Red, eBay Inc.

See what Experts Exchange can do for you.

Got a question?

We've got the answer.

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.

Screenshot of Experts Exchange Knowledgebase

Need individual assistance?

Our experts are ready to help.

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.

Screenshot of Experts Exchange Knowledgebase

Want to learn from the best?

Read articles from industry experts.

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.

Screenshot of an Article

Working on a long term project?

Store your work and research.

Save solutions to your questions, answers you’ve discovered through searching plus helpful articles in your personal knowledgebase for easy future access.

Screenshot of Experts Exchange Knowledgebase

Access the answers to your technology questions today.

Subscribe Now

30-day free trial. Register in 60 seconds.

What Makes Experts Exchange Unique?

Members of the expert community talk about why the experience at Experts Exchange is different than what you will find anywhere else.

Trusted by the world's most respected brands.

image of each brand's logo

Faithfully serving IT professionals since 1996.

Experts Exchange Logo

Try it out and discover for yourself.

Subscribe Now

30-day free trial. Register in 60 seconds.

Related Solutions

  1. Make French keyboard English
    RConsole to the server and the keyboard does not behave like an English keyboard (probably French since the keyboard is in Montreal). Of particular distress is that I cannot use the backslash key ( \ ). Have issued 'LOAD KEYB United States' which seems successful, reporting c...
  2. English/German Keyboard
    How can one easily switch from English to German keyboard and back again. User primarily wishes to work in English but, from time-to-time in German.
  3. VB6 & RDC for French Deployment still showing in English
    The problem: a CR 9 RDC (CRViewer) application packaged with the French Merge Modules still shows up in English rather than French (toolbar text, etc.) even when the Windows Regional Options are set to French (Canada) or French (France). I packaged the application to an ...
  4. How to simulate German keyboard on a English OS?
    i have the following. 1. English win-xp os. 2. The hardware - keyboard is english-US Now if i click "start->programs->accessories->accesibility->on screen keyboard" i can see a english-us-keyboard as an application using which i can "type" ch...
  5. Multiple Language issue (English, Dutch, German, Fren…
    Hi expt, I am dealing with multiple languages issue within pages (English, Dutch, German, French). Each page's controls will have to be loaded upon the selected language. there can be Spainish and Vietnamese in addition (so ...pretty much) There are several option which ar...
  6. VB6 Multi language input (Czech, Hungerian, English, …
    Hi, I have a visual basic 6 application that will be used in The Netherlands (Already running 3 years), Belgium and the Czech Republic. Backend = MS SQL 2000 (SP4). Here in the netherlands we just type everything in english or dutch and store it under collation: SQL_Latin1_...

Free Tech Articles

  1. WARNING: 5 Reasons why you should NEVER fix a computer for free.
    It is in our nature to love the puzzle. We are obsessed. The lot of us. We love puzzles. We love the challenge. We thrive on finding the answer. We hate disarray. It bothers us deep in our soul. W...
  2. SCCM OSD Basic troubleshooting
    SCCM 2007 OSD is a fantastic way to deploy operating systems, however, like most things SCCM issues can sometimes be difficult to resolve due to the sheer volume of logs to sift through and the dispe...
  3. Migrate Small Business Server 2003 to Exchange 2010 and Windows 2008 R2
    This guide is intended to provide step by step instructions on how to migrate from Small Business Server 2003 to Windows 2008 R2 with Exchange 2010. For this migration to work you will need the fo...
  4. Create a Win7 Gadget
    This article shows you how to create a simple "Gadget" -- a sort of mini-application supported by Windows 7 and Vista. Gadgets can be dropped anywhere on the desktop to provide instant information, ...
  5. Outlook continually prompting for username and password
    There have been a lot of questions recently regarding Outlook prompting for a username and password whilst using Exchange 2007. There are a few reasons why this would happen and I will try to cover t...
  6. Backup Exchange 2010 Information Store using Windows Backup
    There seems to be quite a lot of confusion around the ability to backup Exchange 2010 using the built in Windows Backup feature. This stems from the omission of this feature prior to Exchange 2007 s...

Cloud Class Webinars

  1. Avoiding Bugs in Microsoft Access
    Alison Balter takes and in-depth look at avoiding bugs in Access. In this webinar you will learn about using the immediate window to debug your applications, invoking the debugger, using breakpoints to troubleshoot, stepping through code, setting the next statement to execute, ...
  2. Top 10 Best New Features in Visio 2010
    Scott Helmers gives live demonstrations of the top 10 new features in Visio 2010. This webinar will teach you how to create compelling diagrams by adding shapes to the page with a single click, linking the shapes in a diagram to data in Excel (or SQL Server, or SharePoint), ...
  3. IT Consultant Business Secrets Revealed
    Michael Munger, Experts Exchange tech pro and IT consultant, pulls back the curtain on his very successful businesses and answers question on every IT consultant and business owner should know about. He shares secrets on what he did to solve the 5 most common problems in IT, ...
  4. Disaster Recovery and Business Continuity
    Quest CTO, Mike Billon, gives an overview of the steps involved in building a dunamic disaster recovery plan. Through case studies and an examination of software/hardware tooles for monitoring and testing, you'll gain a better understandin of where you are, where you want ...
  5. Organize Your Visio Diagrams with Containers and Lists
    Scott Helmers uses cross functional flowcharts, wireframe diagrams, data graphic legends and seating charts to teach you: how to ustilize all three new structured diagram components in Visio 2010, the best practices for organizeing shapes in previous version of Visio, how to organize ...
  6. How to Us Objects, Properties, Events and Methods in Microsoft Access
    Alison Dalter gives an in-depbth look at objects, properties, events and methods in Microsoft Access. In this webinar you will learn about using the object browser, referring to objects, working with properties and methods, working with object variables, understanding the ...

Join the Community

Give a Little. Get a Lot.

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.

Join the Community

Answers

 

by: edwardiiiPosted on 2005-05-02 at 07:48:38ID: 13909445

Hi, garyLittle.

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

http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/VB_Controls/Q_21208243.html?query=Regional+Options&topics=94

 

by: garyLittlePosted on 2005-05-02 at 07:51:31ID: 13909479

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.

 

by: edwardiiiPosted on 2005-05-02 at 08:04:20ID: 13909609

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.

 

by: garyLittlePosted on 2005-05-02 at 08:15:59ID: 13909723

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.

 

by: edwardiiiPosted on 2005-05-02 at 08:47:20ID: 13910035

Take a look at this link:http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_20387081.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)

 

by: danaseamanPosted on 2005-05-02 at 13:19:32ID: 13912471

' 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

 

by: danaseamanPosted on 2005-05-02 at 13:59:47ID: 13912856

'This codewill enumerate what languages are installed(LCID)

'Form Code
Option Explicit

Dim WithEvents cEnumLCID As clsEnumLCID

Private Sub cEnumLCID_EnumLocales(ByVal LCID As Long)
   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.EnumInstalledLocales
   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(lpLocaleString As Long) As Long

  '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(dwLocaleHex), 4)
   dwLocaleDec = CLng("&H" & dwLocaleHex)
   'sLocaleName = pfGLI(dwLocaleDec, LOCALE_SLANGUAGE)
   'sLocaleAbbrev = pfGLI(dwLocaleDec, LOCALE_SABBREVLANGNAME)
   LocaleCount = LocaleCount + 1
   theCtrl.fReturnLocale dwLocaleDec
   'frmEnumLCID.List1.AddItem "   " & dwLocaleHex & vbTab & _
                               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 = Len(udtVer)
   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

 

by: garyLittlePosted on 2005-05-02 at 16:25:22ID: 13913783

Thanks to you  danaseaman. Both your last two were perfect!!
Thanks for sticking with me. This is everything I need.
Gary

 

by: danaseamanPosted on 2005-05-02 at 18:16:54ID: 13914298

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.

 

by: danaseamanPosted on 2005-05-02 at 19:40:23ID: 13914645

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

 

by: garyLittlePosted on 2005-05-02 at 23:48:56ID: 13915572

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

 

by: danaseamanPosted on 2005-05-03 at 07:34:50ID: 13918267

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.

 

by: danaseamanPosted on 2005-05-03 at 08:11:21ID: 13918620

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

20120131-EE-VQP-002

3 Ways to Join

30-Day Free Trial

The Experts

98% positive feedback on 31,087 answers since March 2000. angeliii is a Microsoft Most Valuable Professional for his work with MS SQL Server & Develoment.

He has also proven his knowledge of Visual Basic Programming, PHP Scripting and Oracle Databases.

The Experts

97% positive feedback on 10,752 answers since July 2000. lrmoore has more than 18 years experience in the networking industry.

The six-time Mircosoft MVPs specialties include firewalls, virtual private networking, and network management.

Testimonials

"...and excellent source for support... Kind of like having your very own IT dept." Electriciansnet

Testimonials

"I was apprehensive at signing up at first. However... it has already made my life as an IT administrator much easier." JaCrews

Testimonials

"WOW! You guys have great, active, and knowledgeable people on here." moore50

Business Clients

Business Clients

In the Press

"If you’ve got a question... Experts Exchange can supply an answer.”

In the Press

"...an invaluable aid for both IT professionals and those who require tech support."

In the Press

"where IT professionals provide quick answers on just about any topic"

Business Account Plans

Loading Advertisement...