Place the following code into the general declarations area of a bas module: --------------------------------------------------------------------------------
Option Explicit
Public Const LOCALE_ILANGUAGE As Long = &H1 'language id
Public Const LOCALE_SLANGUAGE As Long = &H2 'localized name of lang
Public Const LOCALE_SENGLANGUAGE As Long = &H1001 'English name of lang
Public Const LOCALE_SABBREVLANGNAME As Long = &H3 'abbreviated lang name
Public Const LOCALE_SNATIVELANGNAME As Long = &H4 'native name of lang
Public Const LOCALE_ICOUNTRY As Long = &H5 'country code
Public Const LOCALE_SCOUNTRY As Long = &H6 'localized name of country
Public Const LOCALE_SENGCOUNTRY As Long = &H1002 'English name of country
Public Const LOCALE_SABBREVCTRYNAME As Long = &H7 'abbreviated country name
Public Const LOCALE_SNATIVECTRYNAME As Long = &H8 'native name of country
Public Const LOCALE_SINTLSYMBOL As Long = &H15 'intl monetary symbol
Public Const LOCALE_IDEFAULTLANGUAGE As Long = &H9 'def language id
Public Const LOCALE_IDEFAULTCOUNTRY As Long = &HA 'def country code
Public Const LOCALE_IDEFAULTCODEPAGE As Long = &HB 'def oem code page
Public Const LOCALE_IDEFAULTANSICODEPAGE As Long = &H1004 'def ansi code page
Public Const LOCALE_IDEFAULTMACCODEPAGE As Long = &H1011 'def mac code pagePublic Const LOCALE_IMEASURE As Long = &HD '0 = metric, 1 = US'#if(WINVER >= &H0400)
Public Const LOCALE_SISO639LANGNAME As Long = &H59 'ISO abbreviated language name
Public Const LOCALE_SISO3166CTRYNAME As Long = &H5A 'ISO abbreviated country name
'#endif /* WINVER >= as long = &H0400 */'#if(WINVER >= &H0500)
Public Const LOCALE_SNATIVECURRNAME As Long = &H1008'native name of currency
Public Const LOCALE_IDEFAULTEBCDICCODEPAGE As Long = &H1012'default ebcdic code page
Public Const LOCALE_SSORTNAME As Long = &H1013'sort name
'#endif /* WINVER >= &H0500 */Public Declare Function GetThreadLocale Lib "kernel32" () As LongPublic Declare Function GetSystemDefaultLCID Lib "kernel32" () As LongPublic 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
Public Function GetUserLocaleInfo(ByVal dwLocaleID As Long, ByVal dwLCType As Long) As String Dim sReturn As String
Dim r As Long 'call the function passing the Locale type
'variable to retrieve the required size of
'the string buffer needed
r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
'if successful..
If r Then
'pad the buffer with spaces
sReturn = Space$(r)
'and call again passing the buffer
r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
'if successful (r > 0)
If r Then
'r holds the size of the string
'including the terminating null
GetUserLocaleInfo = Left$(sReturn, r - 1)
End If
End If
End Function
'--end block--'
Option Explicit
Public Const LOCALE_ILANGUAGE As Long = &H1 'language id
Public Const LOCALE_SLANGUAGE As Long = &H2 'localized name of lang
Public Const LOCALE_SENGLANGUAGE As Long = &H1001 'English name of lang
Public Const LOCALE_SABBREVLANGNAME As Long = &H3 'abbreviated lang name
Public Const LOCALE_SNATIVELANGNAME As Long = &H4 'native name of lang
Public Const LOCALE_ICOUNTRY As Long = &H5 'country code
Public Const LOCALE_SCOUNTRY As Long = &H6 'localized name of country
Public Const LOCALE_SENGCOUNTRY As Long = &H1002 'English name of country
Public Const LOCALE_SABBREVCTRYNAME As Long = &H7 'abbreviated country name
Public Const LOCALE_SNATIVECTRYNAME As Long = &H8 'native name of country
Public Const LOCALE_SINTLSYMBOL As Long = &H15 'intl monetary symbol
Public Const LOCALE_IDEFAULTLANGUAGE As Long = &H9 'def language id
Public Const LOCALE_IDEFAULTCOUNTRY As Long = &HA 'def country code
Public Const LOCALE_IDEFAULTCODEPAGE As Long = &HB 'def oem code page
Public Const LOCALE_IDEFAULTANSICODEPAGE As Long = &H1004 'def ansi code page
Public Const LOCALE_IDEFAULTMACCODEPAGE As Long = &H1011 'def mac code pagePublic Const LOCALE_IMEASURE As Long = &HD '0 = metric, 1 = US'#if(WINVER >= &H0400)
Public Const LOCALE_SISO639LANGNAME As Long = &H59 'ISO abbreviated language name
Public Const LOCALE_SISO3166CTRYNAME As Long = &H5A 'ISO abbreviated country name
'#endif /* WINVER >= as long = &H0400 */'#if(WINVER >= &H0500)
Public Const LOCALE_SNATIVECURRNAME As Long = &H1008'native name of currency
Public Const LOCALE_IDEFAULTEBCDICCODEPAGE As Long = &H1012'default ebcdic code page
Public Const LOCALE_SSORTNAME As Long = &H1013'sort name
'#endif /* WINVER >= &H0500 */Public Declare Function GetThreadLocale Lib "kernel32" () As LongPublic Declare Function GetSystemDefaultLCID Lib "kernel32" () As LongPublic 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
Public Function GetUserLocaleInfo(ByVal dwLocaleID As Long, ByVal dwLCType As Long) As String Dim sReturn As String
Dim r As Long 'call the function passing the Locale type
'variable to retrieve the required size of
'the string buffer needed
r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
'if successful..
If r Then
'pad the buffer with spaces
sReturn = Space$(r)
'and call again passing the buffer
r = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
'if successful (r > 0)
If r Then
'r holds the size of the string
'including the terminating null
GetUserLocaleInfo = Left$(sReturn, r - 1)
End If
End If
End Function
'--end block--'
Create a form containing 21 textboxes named Text1 through Text21 (not in a control array). Add labels as desired, and a command button (Command1). Add the following code to the form: --------------------------------------------------------------------------------
Option Explicit
Private Sub Command1_Click() Dim LCID As Long
LCID = GetSystemDefaultLCID() 'LOCALE_ICOUNTRY
'Country/region code, based on international phone
'codes, also referred to as IBM country codes.
'The maximum characters allowed is six.
Text1.Text = GetUserLocaleInfo(LCID, LOCALE_ICOUNTRY) 'LOCALE_IDEFAULTANSICODEPAGE
'American National Standards Institute (ANSI) code page
'associated with this locale. If the locale does not use
'an ANSI code page, the value is 0. The maximum characters
'allowed is six.
Text2.Text = GetUserLocaleInfo(LCID, LOCALE_IDEFAULTANSICODEPAGE) 'LOCALE_IDEFAULTCODEPAGE
'Original equipment manufacturer (OEM) code page associated
'with the country/region. If the locale does not use an OEM
'code page, the value is 1.The maximum characters allowed is six.
Text3.Text = GetUserLocaleInfo(LCID, LOCALE_IDEFAULTCODEPAGE) 'LOCALE_IDEFAULTCOUNTRY
'Code for the principal country/region in this locale.
'This is provided so that partially specified locales
'can be completed with default values. The maximum
'characters allowed is six.
Text4.Text = GetUserLocaleInfo(LCID, LOCALE_IDEFAULTCOUNTRY) 'LOCALE_IDEFAULTEBCDICCODEPAGE
'Windows 2000: Default EBCDIC code page associated
'with the locale. The maximum characters allowed is six.
Text5 = GetUserLocaleInfo(LCID, LOCALE_IDEFAULTEBCDICCODEPAGE)
If Len(Text5.Text) = 0 Then Text5.Text = "Sorry, Windows 2000 only" 'LOCALE_IDEFAULTLANGUAGE
'Language identifier for the principal language spoken in this
'locale. This is provided so partially specified locales can be
'completed with default values. The maximum characters allowed is five.
Text6.Text = GetUserLocaleInfo(LCID, LOCALE_IDEFAULTLANGUAGE) 'LOCALE_IDEFAULTMACCODEPAGE
'Default Macintosh code page associated with the locale.
'If the locale does not use a Macintosh code page, the
'value is 2. The maximum characters allowed is six.
Text7.Text = GetUserLocaleInfo(LCID, LOCALE_IDEFAULTLANGUAGE) 'LOCALE_ILANGUAGE
'Language identifier. The maximum characters allowed is five.
Text8.Text = GetUserLocaleInfo(LCID, LOCALE_ILANGUAGE) 'LOCALE_IMEASURE
'System of measurement. This value is 0 if the metric system
'(Systéme International d'Unités, or S.I.) is used, and 1 if
'the U.S. system is used. The maximum characters allowed is two.
Select Case GetUserLocaleInfo(LCID, LOCALE_IMEASURE)
Case "0": Text9.Text = "0 - Metric system is used"
Case "1": Text9.Text = "1 - U.S. system is used"
End Select 'LOCALE_SCOUNTRY
'Full localized name of the country/region. This is based on
'the localization of the product, thus it changes for
'each localized version.
Text10.Text = GetUserLocaleInfo(LCID, LOCALE_SCOUNTRY) 'LOCALE_SENGCOUNTRY
'Full English name of the country/region. This is always
'restricted to characters that can be mapped into the
'ASCII 127-character subset.
Text11.Text = GetUserLocaleInfo(LCID, LOCALE_SENGCOUNTRY)
'LOCALE_SENGLANGUAGE
'Full English name of the language from the International
'Organization for Standardization (ISO) Standard 639.
'This is always restricted to characters that can be
'mapped into the ASCII 127-character subset. This is
'not always equivalent to the English version of LOCALE_SLANGUAGE.
Text12.Text = GetUserLocaleInfo(LCID, LOCALE_SENGLANGUAGE)
'LOCALE_SINTLSYMBOL
'Three characters of the international monetary symbol specified
'in ISO 4217 followed by the character separating this string
'from the amount.
Text13.Text = GetUserLocaleInfo(LCID, LOCALE_SINTLSYMBOL) 'LOCALE_SISO3166CTRYNAME
'Windows NT 4.0 and Windows 2000: Country/region name, based on
'ISO Standard 3166.
Text14.Text = GetUserLocaleInfo(LCID, LOCALE_SISO3166CTRYNAME)
'LOCALE_SISO639LANGNAME
'Windows NT 4.0 and Windows 2000: The abbreviated name of the
'language based entirely on the ISO Standard 639 values.
Text15.Text = GetUserLocaleInfo(LCID, LOCALE_SISO639LANGNAME)
'LOCALE_SABBREVLANGNAME
'Abbreviated name of the language. In most cases it is created
'by taking the two-letter language abbreviation from the ISO
'Standard 639 and adding a third letter, as appropriate, to
'indicate the sublanguage.
Text16.Text = GetUserLocaleInfo(LCID, LOCALE_SABBREVLANGNAME)
'LOCALE_SLANGUAGE
'Full localized name of the language. This name is based on the
'localization of the product, thus the value changes for each
'localized version.
Text17.Text = GetUserLocaleInfo(LCID, LOCALE_SLANGUAGE)
'LOCALE_SNATIVELANGNAME
'Native name of the language.
Text18.Text = GetUserLocaleInfo(LCID, LOCALE_SNATIVELANGNAME)
'LOCALE_SNATIVECTRYNAME
'Native name of the country/region.
Text19.Text = GetUserLocaleInfo(LCID, LOCALE_SNATIVECTRYNAME)
'LOCALE_SNATIVECURRNAME
'Windows 2000: The native name of the currency associated with the locale.
Text20.Text = GetUserLocaleInfo(LCID, LOCALE_SNATIVECURRNAME)
If Len(Text20.Text) = 0 Then Text20 = "Sorry, Windows 2000 only"
'LOCALE_SSORTNAME
'Windows 2000: The full localized name of the sort for the
'specified locale identifier, dependent on the language of the shell.
Text21.Text = GetUserLocaleInfo(LCID, LOCALE_SSORTNAME)
If Len(Text21.Text) = 0 Then Text21 = "Sorry, Windows 2000 only"
End Sub
'--end block--'
Public Const LOCALE_USER_DEFAULT = &H400
Public Const LOCALE_SCURRENCY = &H14 ' local monetary symbol
Public Const LOCALE_SINTLSYMBOL = &H15 ' intl monetary symbol
Public Const LOCALE_SMONDECIMALSEP = &H16 ' monetary decimal separator
Public Const LOCALE_SMONTHOUSANDSEP = &H17 ' monetary thousand separator
Public Const LOCALE_SMONGROUPING = &H18 ' monetary grouping
Public Const LOCALE_ICURRDIGITS = &H19 ' # local monetary digitsDeclare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
'
' Locale specific information
'
Public Sub GetInfo()
Dim buffer As String * 100
Dim dl&'compare this with
'Start/Settings/Control Panel/Regional Settings/Currency#If Win32 Then
dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SCURRENCY, buffer, 99)
Form1.list1.AddItem " Local curency symbol: " & LPSTRToVBString(buffer)
dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SINTLSYMBOL, buffer, 99)
Form1.list1.AddItem " International currency symbol: " & LPSTRToVBString(buffer)
dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SMONDECIMALSEP, buffer, 99)
Form1.list1.AddItem " Decimaal separator: " & LPSTRToVBString(buffer)
dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SMONTHOUSANDSEP, buffer, 99)
Form1.list1.AddItem " Thousand separator: " & LPSTRToVBString(buffer)
dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SMONGROUPING, buffer, 99)
Form1.list1.AddItem " Number of digits in group: " & LPSTRToVBString(buffer)
dl& = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_ICURRDIGITS, buffer, 99)
Form1.list1.AddItem " Number of digits behind the decimal separator: " & LPSTRToVBString(buffer)
#Else
Form1.list1.AddItem " Not implemented under Win16"
#End IfEnd Sub
'
' Extracts a VB string from a buffer containing a null terminated
' string
Public Function LPSTRToVBString$(ByVal s$)
Dim nullpos&
nullpos& = InStr(s$, Chr$(0))
If nullpos > 0 Then
LPSTRToVBString = Left$(s$, nullpos - 1)
Else
LPSTRToVBString = ""
End If
End Function