|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Visual Basic Locale/Regionalization Routines GetLocaleInfo: Regional Locale Currency Settings |
|
Posted: | Monday March 20, 2000 |
Updated: | Monday December 26, 2011 |
Applies to: | VB4-32, VB5, VB6 |
Developed with: | VB6, Windows NT4 |
OS restrictions: | None |
Author: | VBnet - Randy Birch |
Related: |
EnumSystemLocales: Enumerate Installed and Supported System Locales GetLocaleInfo: Regional Locale Country Settings GetLocaleInfo: Regional Locale Currency Settings GetLocaleInfo: System Calendar Information |
Prerequisites |
None. |
|
National
language support functions also provide the means to retrieve either the user's
or the system's international locale information regarding representation of
currency. This includes the correct symbols for the decimal separator and the group separator (a period and comma on my system, respectively). While the GetSystemDefaultLCID function retrieves the system default locale identifier, this is often inappropriate or insufficient in a networked environment or under an operating system where multiple locales have been installed. For example, it is possible for a network admin rolling out a standard image to have the user's default locale set to one differing from the base OS installation, and thus the system default locale. In this situation Windows' provides an alternate API you can use to obtain the LCID for the current user ... GetUserDefaultLCID. Defined identically to GetSystemDefaultLCID, GetUserDefaultLCID function retrieves the user default–locale identifier and is therefore the most appropriate API to use when it is the user's locale you are interested in, rather than that of the system. Note that if the user and system both have the same locale, there will be no difference in the data returned unless the user's preferences or the overall system preferences have been customized.
|
BAS Module Code |
None. |
|
Form Code |
Create a form one text box (Text1) and set its index property to 0 - the Load event will create the text boxes. Space is left for labels but those are not created as part of this demo. Add a command button (Command1) and two option buttons (Option1 / Option2) along with the following code: |
|
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ©1996-2011 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. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Const LOCALE_SCURRENCY As Long = &H14 'local symbol Private Const LOCALE_SINTLSYMBOL As Long = &H15 'intl symbol Private Const LOCALE_SMONDECIMALSEP As Long = &H16 'decimal separator Private Const LOCALE_SMONTHOUSANDSEP As Long = &H17 'thousand separator Private Const LOCALE_SMONGROUPING As Long = &H18 'grouping Private Const LOCALE_ICURRDIGITS As Long = &H19 '# local digits Private Const LOCALE_IINTLCURRDIGITS As Long = &H1A '# intl digits Private Const LOCALE_ICURRENCY As Long = &H1B 'pos currency mode Private Const LOCALE_INEGCURR As Long = &H1C 'neg currency mode Private Const LOCALE_IPOSSIGNPOSN As Long = &H52 'pos sign position Private Const LOCALE_INEGSIGNPOSN As Long = &H53 'neg sign position Private Const LOCALE_IPOSSYMPRECEDES As Long = &H54 'mon sym precedes pos amt Private Const LOCALE_IPOSSEPBYSPACE As Long = &H55 'mon sym sep by space from pos amt Private Const LOCALE_INEGSYMPRECEDES As Long = &H56 'mon sym precedes neg amt Private Const LOCALE_INEGSEPBYSPACE As Long = &H57 'mon sym sep by space from neg amt Private Const LOCALE_SENGCURRNAME As Long = &H1007'english name of currency Private Const LOCALE_SNATIVECURRNAME As Long = &H1008'native name of currency Private Declare Function GetThreadLocale Lib "kernel32" () As Long Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long Private 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 Private Sub Form_Load() Dim cnt As Long For cnt = 0 To 16 If cnt > 0 Then Load Text1(cnt) With Text1(cnt) .Left = 1800 .Top = 120 + (360 * (cnt)) If cnt < 8 Then .Width = 2775 Else .Width = 4815 End If .Text = "" .Visible = True End With Next Command1.Caption = "Get Currency Info" Option1.Caption = "User" Option2.Caption = "System" Option1.Value = True End Sub Private Sub Command1_Click() Dim LCID As Long If Option1.Value = True Then LCID = GetSystemDefaultLCID() Else LCID = GetUserDefaultLCID() End If 'LOCALE_SCURRENCY 'String used as the local symbol. The 'maximum number of characters allowed is six. Text1(0).Text = GetCurrentLocaleInfo(LCID, LOCALE_SCURRENCY) 'LOCALE_SINTLSYMBOL 'Three characters of the international symbol 'specified in ISO 4217 followed by the character 'separating this string from the amount. Text1(1).Text = GetCurrentLocaleInfo(LCID, LOCALE_SINTLSYMBOL) 'LOCALE_SMONDECIMALSEP 'Character(s) used as the decimal separator. 'The maximum characters allowed is four. Text1(2).Text = GetCurrentLocaleInfo(LCID, LOCALE_SMONDECIMALSEP) 'LOCALE_SMONTHOUSANDSEP 'Character(s) used as the separator between groups 'of digits to the left of the decimal. The maximum number 'of characters allowed is four. Text1(3).Text = GetCurrentLocaleInfo(LCID, LOCALE_SMONTHOUSANDSEP) 'LOCALE_SMONGROUPING 'Sizes for each group of digits to the left of 'the decimal. An explicit size is needed for each group, 'and sizes are separated by semicolons. If the last value 'is zero, the preceding value is repeated. For example, 'to group thousands, specify 3;0. Indic languages group 'the first thousand and then group by hundreds - for 'example, 12,34,56,789, which is represented by 3;2;0. 'The maximum characters allowed is four. Text1(4).Text = GetCurrentLocaleInfo(LCID, LOCALE_SMONGROUPING) 'LOCALE_ICURRDIGITS 'Number of fractional digits for the local format. 'The maximum characters allowed is three. Text1(5).Text = GetCurrentLocaleInfo(LCID, LOCALE_ICURRDIGITS) 'LOCALE_IINTLCURRDIGITS 'Number of fractional digits for the international 'format. The maximum characters allowed is three. Text1(6).Text = GetCurrentLocaleInfo(LCID, LOCALE_IINTLCURRDIGITS) 'LOCALE_ICURRENCY 'Position of the symbol in the positive currency mode. 'The maximum characters allowed is two. The mode can be 'one of the following values: Select Case GetCurrentLocaleInfo(LCID, LOCALE_ICURRENCY) Case "0": Text1(7).Text = "0 - Prefix, no separation, ie $1.1" Case "1": Text1(7).Text = "1 - Suffix, no separation, ie 1.1$" Case "2": Text1(7).Text = "2 - Prefix, 1-character separation, ie $ 1.1" Case "3": Text1(7).Text = "3 - Suffix, 1-character separation, ie 1.1 $" End Select 'LOCALE_INEGCURR 'neg currency mode. The maximum characters allowed is 'three. The mode can be one of the following values: Select Case GetCurrentLocaleInfo(LCID, LOCALE_INEGCURR) Case "0": Text1(8).Text = "0 - L parenthesis, symbol, number, " & _ "R parenthesis, ie ($1.1)" Case "1": Text1(8).Text = "1 - Neg sign, symbol, number, ie -$1.1" Case "2": Text1(8).Text = "2 - Symbol, neg sign, number, ie $-1.1" Case "3": Text1(8).Text = "3 - Symbol, number, neg sign, ie $1.1-" Case "4": Text1(8).Text = "4 - L parenthesis, number, symbol, " & _ "R parenthesis, ie (1.1$)" Case "5": Text1(8).Text = "5 - Neg sign, number, symbol, ie -1.1$" Case "6": Text1(8).Text = "6 - Number, neg sign, symbol, ie 1.1-$" Case "7": Text1(8).Text = "7 - Number, symbol, neg sign, ie 1.1$-" Case "8": Text1(8).Text = "8 - Neg sign, number, space, symbol " & _ "(like #5, but w/ space before symbol), ie -1.1 $" Case "9": Text1(8).Text = "9 - Neg sign, symbol, space, number " & _ "(like #1, but w/ space after symbol), ie -$ 1.1" Case "10": Text1(8).Text = "10 - Number, space, symbol, neg sign " & _ "(like #7, but w/ space before symbol), ie 1.1 $-" Case "11": Text1(8).Text = "11 - Symbol, space, number, neg sign " & _ "(like #3, but w/ space after symbol), ie $ 1.1-" Case "12": Text1(8).Text = "12 - Symbol, space, neg sign, number " & _ "(like #2, but w/ space after symbol), ie $ -1.1" Case "13": Text1(8).Text = "13 - Number, neg sign, space, symbol " & _ "(like #6, but w/ space before symbol), ie 1.1- $" Case "14": Text1(8).Text = "14 - L parenthesis, symbol, space, number, " & _ "R parenthesis (like #0, but w/ space after symbol), ie ($ 1.1)" Case "15": Text1(8).Text = "15 - L parenthesis, number, space, symbol, " & _ "R parenthesis (like #4, but w/ space before symbol), ie (1.1 $)" End Select 'LOCALE_INEGSIGNPOSN 'Formatting index for the neg sign in currency 'values. The maximum allowed is two. The index can 'be one of the following values. Select Case GetCurrentLocaleInfo(LCID, LOCALE_INEGSIGNPOSN) Case "0": Text1(9).Text = "0 - Parentheses surround the amount and symbol." Case "1": Text1(9).Text = "1 - The sign precedes the number." Case "2": Text1(9).Text = "2 - The sign follows the number." Case "3": Text1(9).Text = "3 - The sign precedes the symbol." Case "4": Text1(9).Text = "4 - The sign follows the symbol" End Select 'LOCALE_IPOSSIGNPOSN 'Formatting index for positive values. This index 'uses the same values as LOCALE_INEGSIGNPOSN, except 'that it does not use the zero index. The maximum 'number of characters allowed for this string is two. Select Case GetCurrentLocaleInfo(LCID, LOCALE_IPOSSIGNPOSN) Case "0": Text1(10).Text = "0 - Parentheses surround the amount and symbol." Case "1": Text1(10).Text = "1 - The sign precedes the number." Case "2": Text1(10).Text = "2 - The sign follows the number." Case "3": Text1(10).Text = "3 - The sign precedes the symbol." Case "4": Text1(10).Text = "4 - The sign follows the symbol" End Select 'LOCALE_IPOSSYMPRECEDES 'Position of symbol in a pos value. 'This value is 1 if the symbol precedes the positive 'amount, zero if it follows it. The maximum allowed is two. Select Case GetCurrentLocaleInfo(LCID, LOCALE_IPOSSYMPRECEDES) Case "0": Text1(11).Text = "0 - symbol follows a pos amount." Case "1": Text1(11).Text = "1 - symbol precedes a pos amount." End Select 'LOCALE_INEGSYMPRECEDES 'Position of symbol in a neg value. 'This value is 1 if the symbol precedes the neg 'amount, 0 if it follows it. The maximum allowed is two. Select Case GetCurrentLocaleInfo(LCID, LOCALE_INEGSYMPRECEDES) Case "0": Text1(12).Text = "0 - symbol follows a neg amount." Case "1": Text1(12).Text = "1 - symbol precedes a neg amount." End Select 'LOCALE_IPOSSEPBYSPACE 'Separation of symbol in a pos value. 'This value is 1 if the symbol is separated by a 'space from a positive amount, 0 if not. The maximum 'number allowed is two. Select Case GetCurrentLocaleInfo(LCID, LOCALE_IPOSSEPBYSPACE) Case "0": Text1(13).Text = "0 - symbol has no space preceding pos amount." Case "1": Text1(13).Text = "1 - symbol has space preceding pos amount." End Select 'LOCALE_INEGSEPBYSPACE 'Separation of the neg sign in a value. 'This value is 1 if the symbol is separated 'by a space from the neg amount, 0 if it is not. 'The maximum allowed is two. Select Case GetCurrentLocaleInfo(LCID, LOCALE_INEGSEPBYSPACE) Case "0": Text1(14).Text = "0 - symbol has no space preceding neg amt." Case "1": Text1(14).Text = "1 - symbol has space preceding neg amt." End Select 'LOCALE_SENGCURRNAME 'Windows 2000: The full English name of the currency 'associated with the locale. Text1(15).Text = GetCurrentLocaleInfo(LCID, LOCALE_SENGCURRNAME) 'LOCALE_SNATIVECURRNAME 'Windows 2000: The native name of the currency 'associated with the locale. Text1(16).Text = GetCurrentLocaleInfo(LCID, LOCALE_SNATIVECURRNAME) If Len(Text1(15).Text) = 0 Then Text1(15).Text = "Sorry, Windows 2000/XP only" If Len(Text1(16).Text) = 0 Then Text1(16).Text = "Sorry, Windows 2000/XP only" End Sub Private Function GetCurrentLocaleInfo(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 GetCurrentLocaleInfo = Left$(sReturn, r - 1) End If End If End Function |
Comments |
Save the program and run. The values displayed should correspond to the Codepage and Regional Settings for your system. |
|
|
|
|||||
|
|||||
|
|||||
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |