Solved

How to set locale in VB?

Posted on 2004-10-26
10,942 Views
Last Modified: 2008-02-07
I want to set my application Locale to "En-US"

how?
0
Question by:Jerry_Pang
    8 Comments
     
    LVL 48

    Expert Comment

    by:Ryan Chong
    Try access registry and edit:

    HKEY_CURRENT_USER\Control Panel\International\sLanguage

    then set the sLanguage to ENU

    ?
    0
     
    LVL 9

    Author Comment

    by:Jerry_Pang
    in .net i just need to set the current thread to locale(culture)
    http://www.experts-exchange.com/Programming/Programming_Languages/Dot_Net/Q_21176707.html

    i found out that what i need is to set the vb program not the vb.net locale.

    can i do it programatically?
    this problem is related to the above link.
    0
     
    LVL 6

    Expert Comment

    by:danths
    One option could be ...

    since you can easily call WSH functions from Vb by sourcing in wsh references.
    in wsh you could easily setLocale("<locale>")
    http://msdn.microsoft.com/library/default.asp?url=/library/en-us/script56/html/vsfctsetlocale.asp

    Hope this helps
    0
     
    LVL 6

    Accepted Solution

    by:
    .Net provides CultureInfo. ASP has SetLocale via VBScript. VB6 has nothing. It's a sad thing. You'll need to use some Windows API to probably do it but most samples you'll find about the API uses C++. Well, we gave up on VB6 because of this limitation among other things.

    A VB6 application by default supports the English characters even when running on Windows with regional settings set to Chinese, Korean, Thai, etc. for as long as the language packs are installed.

    VB6 relies on the regional settings a lot. If you have an "English" machine, VB6 cannot support non-English characters in it. Based on our experiments, VB6 seems to converts values based on the machine's regional settings. You can test this yourself: during debug, use ADO to get a Chinese character from a unicode field of a table in a database. Assign the field value to a VB6 string variable and you should see it becomes a "?" or some garbage character along the way.

    Unicode support in VB6 is not default. Rather, VB6 expects the world to be communicating in ASCII. Thus, the regional settings dependency behavior. Application locale in VB6? Nah! We simply switched to VB.Net and we're done!

    Have fun.
    0
     
    LVL 27

    Assisted Solution

    by:Ark
    'This example was created by A.E.Veltstra

    'This fucntion changes the locale and as a result, the keyboardlayout gets adjusted

    'parameters for api's
    Const KL_NAMELENGTH As Long = 9                      'length of the keyboardbuffer
    Const KLF_ACTIVATE  As Long = &H1                     'activate the layout

    'the language constants
    Const LANG_NL_STD As String = "00000413"
    Const LANG_EN_US As String = "00000409"
    Const LANG_DU_STD As String = "00000407"
    Const LANG_FR_STD As String = "0000040C"

    'api's to adjust the keyboardlayout
    Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
    Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long
    Public Function SetKbLayout(strLocaleId As String) As Boolean
        'Changes the KeyboardLayout
        'Returns TRUE when the KeyboardLayout was adjusted properly, FALSE otherwise
        'If the KeyboardLayout isn't installed, this function will install it for you
        On Error Resume Next
        Dim strLocId As String 'used to retrieve current KeyboardLayout
        Dim strMsg As String   'used as buffer
        Dim lngErrNr As Long   'receives the API-error number

      'create a buffer
      strLocId = String(KL_NAMELENGTH, 0)
      'retrieve the current KeyboardLayout
      GetKeyboardLayoutName strLocId
      'Check whether the current KeyboardLayout and the
      'new one are the same
      If strLocId = (strLocaleId & Chr(0)) Then
        'If they're the same, we return immediately
        SetKbLayout = True
      Else
        'create buffer
        strLocId = String(KL_NAMELENGTH, 0)
        'load and activate the layout for the current thread
        strLocId = LoadKeyboardLayout((strLocaleId & Chr(0)), KLF_ACTIVATE)
        If IsNull(strLocId) Then  'returns NULL when it fails
          SetKbLayout = False
        Else 'check again
          'create buffer
          strLocId = String(KL_NAMELENGTH, 0)
          'retrieve the current layout
          GetKeyboardLayoutName strLocId
          If strLocId = (strLocaleId & Chr(0)) Then
            SetKbLayout = True
          Else
            SetKbLayout = False
          End If
        End If
      End If
    End Function
    Private Sub Form_Load()
        'change the current keybour layout to 'English - US'
        SetKbLayout LANG_EN_US
    End Sub
    0
     
    LVL 22

    Assisted Solution

    by:danaseaman
    I would have to disagree with some of the information above. Vb6 is Unicode but the controls shipped with it are not. All you need to do is use Unicode aware controls such as Forms 2.0 Object Library, UniToolBox, etc. If you are seeing "??" in your controls you are using the wrong Font or your controls are not Unicode aware. You may be suprised to know that Format$ and FormatDateTime$ functions are Unicode aware and use the Regional Settings. If you don't have Unicode aware controls you can cheat and use DrawTextW/TextOutW(NT or later) in conjunction with a PictureBox.hDC.

    So how do you set the Locale programatically? If Control Panel/Regional Settings can do it there must be a way for us to do it from Vb. Let's examine how I think MS does it. When you first open Regional Settings you should see the UserDefault language and settings including any customization you may have done. When you select a new language from the combo it loads up SystemDefault variables for this LCID. At this point you may use the settings as is or tweak some of the variables to your preference(i.e. Short Date Format = "dd-MMM-yyyy"). When you press update these variables now become the UserDefault settings and they are plugged into the Registry at [HKEY_CURRENT_USER\Control Panel\International]. You can verify this by tweaking the registry setting "sShortDate" and see the dates in File Explorer update immediately to the new format. So all we need to do in theory is load up the SystemDefault variables for a specified LCID and plug them into the correct location in the registry. My registry has 37 values under [HKEY_CURRENT_USER\Control Panel\International].

    To change the Locale you need the Hex value of the LCID with leading zeros. The final string should be 8 characters long. Example: "00000409" for English-U.S.Changing this value manually will enable month/day names for the specified Locale.

    There are 36 other values besides Locale in [HKEY_CURRENT_USER\Control Panel\International] that should be updated when you switch languages. Here is partial code to do this. You will need to attach your favorite Registry class to update the Registry strings but the rest of the work of retrieving the Default System values for the LCID is done. Note that the following code is Unicode aware so that we can use it with any language. We should notify Windows of the change using PostMessageg so that apps that are Locale aware will update automatically however just setting the new items in the registry seem to update File Explorer immediately.

    Example usage:
       '&H409 English (United States)
       '&H804 Chinese (PRC)
       '&H416 Portuguese (Brazil)
       SetLocale &H409
    'module
     Option Explicit

    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

    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 SetLocaleInfoA Lib "kernel32.dll" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Long
    Public Declare Function SetLocaleInfoW Lib "kernel32.dll" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Long
    Public Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
    Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
    Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Public Const HWND_BROADCAST = &HFFFF&
    Public Const WM_SETTINGCHANGE = &H1A
    Public Const VER_PLATFORM_WIN32_NT As Long = 2


    Public Const LOCALE_ICOUNTRY As Long = &H5
    Public Const LOCALE_ICURRDIGITS As Long = &H19
    Public Const LOCALE_ICURRENCY As Long = &H1B
    Public Const LOCALE_IDATE As Long = &H21
    Public Const LOCALE_IDIGITS As Long = &H11
    Public Const LOCALE_ILZERO As Long = &H12
    Public Const LOCALE_IMEASURE As Long = &HD
    Public Const LOCALE_INEGCURR As Long = &H1C
    Public Const LOCALE_ITIME As Long = &H23
    Public Const LOCALE_ITLZERO As Long = &H25
    Public Const LOCALE_S1159 As Long = &H28
    Public Const LOCALE_S2359 As Long = &H29
    Public Const LOCALE_SCOUNTRY As Long = &H6
    Public Const LOCALE_SCURRENCY As Long = &H14
    Public Const LOCALE_SDATE As Long = &H1D
    Public Const LOCALE_SDECIMAL As Long = &HE
    Public Const LOCALE_SLANGUAGE As Long = &H2
    Public Const LOCALE_SLIST As Long = &HC
    Public Const LOCALE_SLONGDATE As Long = &H20
    Public Const LOCALE_SSHORTDATE As Long = &H1F
    Public Const LOCALE_STHOUSAND As Long = &HF
    Public Const LOCALE_STIME As Long = &H1E
    Public Const LOCALE_STIMEFORMAT As Long = &H1003
    Public Const LOCALE_ITIMEMARKPOSN As Long = &H1005
    Public Const LOCALE_SMONDECIMALSEP As Long = &H16
    Public Const LOCALE_SMONTHOUSANDSEP As Long = &H17
    Public Const LOCALE_INEGNUMBER As Long = &H1010
    Public Const LOCALE_SNATIVEDIGITS As Long = &H13
    Public Const LOCALE_IDIGITSUBSTITUTION As Long = &H1014
    Public Const LOCALE_ICALENDARTYPE As Long = &H1009
    Public Const LOCALE_IFIRSTDAYOFWEEK As Long = &H100C
    Public Const LOCALE_IFIRSTWEEKOFYEAR As Long = &H100D
    Public Const LOCALE_SGROUPING As Long = &H10
    Public Const LOCALE_SMONGROUPING As Long = &H18
    Public Const LOCALE_SPOSITIVESIGN As Long = &H50
    Public Const LOCALE_SNEGATIVESIGN As Long = &H51

    Private Buffer As String * 255
    Private m_SysLCID As Long

    Property Let SysLCID(ByVal LCID As Long)
    m_SysLCID = LCID
    End Property

    Public Sub SetLocale(ByVal LCID As Long)

       SetReg "Locale", Right$("00000000" & Hex$(LCID), 8)
       SetReg "iCountry", pfGLI(LCID, LOCALE_ICOUNTRY)
       SetReg "iCurrDigits", pfGLI(LCID, LOCALE_ICURRDIGITS)
       SetReg "iCurrency", pfGLI(LCID, LOCALE_ICURRENCY)
       SetReg "iDate", pfGLI(LCID, LOCALE_IDATE)
       SetReg "iDigits", pfGLI(LCID, LOCALE_IDIGITS)
       SetReg "iLZero", pfGLI(LCID, LOCALE_ILZERO)
       SetReg "iMeasure", pfGLI(LCID, LOCALE_IMEASURE)
       SetReg "iNegCurr", pfGLI(LCID, LOCALE_INEGCURR)
       SetReg "iTime", pfGLI(LCID, LOCALE_ITIME)
       SetReg "iTLZero", pfGLI(LCID, LOCALE_ITLZERO)
       SetReg "s1159", pfGLI(LCID, LOCALE_S1159)
       SetReg "s2359", pfGLI(LCID, LOCALE_S2359)
       SetReg "sCountry", pfGLI(LCID, LOCALE_SCOUNTRY)
       SetReg "sCurrency", pfGLI(LCID, LOCALE_SCURRENCY)
       SetReg "sDate", pfGLI(LCID, LOCALE_SDATE)
       SetReg "sDecimal", pfGLI(LCID, LOCALE_SDECIMAL)
       SetReg "sLanguage", pfGLI(LCID, LOCALE_SLANGUAGE)
       SetReg "sList", pfGLI(LCID, LOCALE_SLIST)
       SetReg "sLongDate", pfGLI(LCID, LOCALE_SLONGDATE)
       SetReg "sShortDate", pfGLI(LCID, LOCALE_SSHORTDATE)
       SetReg "sThousand", pfGLI(LCID, LOCALE_STHOUSAND)
       SetReg "sTime", pfGLI(LCID, LOCALE_STIME)
       SetReg "sTimeFormat", pfGLI(LCID, LOCALE_STIMEFORMAT)
       SetReg "iTimePrefix", pfGLI(LCID, LOCALE_ITIMEMARKPOSN)
       SetReg "sMonDecimalSep", pfGLI(LCID, LOCALE_SMONDECIMALSEP)
       SetReg "sMonThousandSep", pfGLI(LCID, LOCALE_SMONTHOUSANDSEP)
       SetReg "iNegNumber", pfGLI(LCID, LOCALE_INEGNUMBER)
       SetReg "sNativeDigits", pfGLI(LCID, LOCALE_SNATIVEDIGITS)
       SetReg "NumShape", pfGLI(LCID, LOCALE_IDIGITSUBSTITUTION)
       SetReg "iCalendarType", pfGLI(LCID, LOCALE_ICALENDARTYPE)
       SetReg "iFirstDayOfWeek", pfGLI(LCID, LOCALE_IFIRSTDAYOFWEEK)
       SetReg "iFirstWeekOfYear", pfGLI(LCID, LOCALE_IFIRSTWEEKOFYEAR)
       SetReg "sGrouping", pfGLI(LCID, LOCALE_SGROUPING)
       SetReg "sMonGrouping", pfGLI(LCID, LOCALE_SMONGROUPING)
       SetReg "sPositiveSign", pfGLI(LCID, LOCALE_SPOSITIVESIGN)
       SetReg "sNegativeSign", pfGLI(LCID, LOCALE_SNEGATIVESIGN)

    End Sub

    Private Function SetReg(ByVal sName As String, ByVal sValue As String)
       Debug.Print sName, sValue
       'Here is where you put code to update the registry.
       'Use your favorite Registry class.Location is "HKEY_CURRENT_USER\Control Panel\International"
    End Function

    'Purpose: Get Locale Info
    Private Function pfGLI(ByVal m_LocaleLCID As Long, ByVal lpLCType As Long) As String
       If IsNT Then
          GetLocaleInfoW m_LocaleLCID, lpLCType, Buffer, 255
          pfGLI = StripNull(StrConv(Buffer, vbFromUnicode))
       Else
          GetLocaleInfoA m_LocaleLCID, lpLCType, Buffer, 255
          pfGLI = StripNull(Buffer)
       End If
    End Function

    'Purpose: Set Locale Info
    Private Sub pfSLI(ByVal m_LocaleLCID As Long, ByVal lpLCType As Long, ByVal lpLCData As String)
       If IsNT Then
          SetLocaleInfoW m_LocaleLCID, lpLCType, lpLCData
       Else
          SetLocaleInfoA m_LocaleLCID, lpLCType, lpLCData
       End If
    End Sub

    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

    0
     
    LVL 9

    Author Comment

    by:Jerry_Pang
    good stuff. a lot of work.

    i will split the points now. I will accept that there is no setlocale for application. i believe this answers my question.

    in vb.net you only need to set the culture.

    my experience with coldfusion, you only need to set the locale in application.cfm
    <cfset locale="en-US"> something like that.

    thank you for all your inputs.
    sorry but i cant change the locale of the OS in regional settings(or doing something similar)

    i have found the root cause for problem already.
    the problem was calling asc() or ascw() funtions.
    It only returns an Interger (-32,000 to 32,000)
    we use this function to return the numeric value of the characters.

    the chinese unicode are from 20,000 to 40,000.
    Some of the unicode charactes returns a negative value which causes the bug.

    I dont use time or date or currency values.
    funny thing is that, if i use english language, the bug does not occur, except for chinese or korean languages in regional settings.


    thanx,
    jerry
    0
     
    LVL 22

    Expert Comment

    by:danaseaman
    Vb Integers are signed. What you need to work with Unicode is unsigned integer. Just add 65536 to negative numbers and you will be OK. Here is an example:

    Public Function IsUtf16(ByVal s As String) As Boolean
       Dim i As Long
       Dim lLen As Long
       Dim lAscW As Long

       lLen = Len(s)
       For i = 1 To lLen
          lAscW = AscW(Mid$(s, i))
          If lAscW < 0 Then
             lAscW = lAscW + 65536
          End If
          If (lAscW > 255) Then
             IsUtf16 = True
             Exit Function
          End If
       Next
    End Function

    Also see http://www.vbip.com/winsock-api/template/template-02.asp

    0

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Highfive Gives IT Their Time Back

    Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

    Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
    When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
    Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
    This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

    913 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    19 Experts available now in Live!

    Get 1:1 Help Now