mcdhappy80
Registered User.
- Local time
- Today, 23:54
- Joined
- Jun 22, 2009
- Messages
- 347
On this article http://allenbrowne.com/ser-36.html#Interface I've found this module:
Can I determine which Language is set in Standards and Format option of Control Panel?
Thank You
Code:
'------------------------------------------
' basIntlFormats
'
' Some helper functions for handling date/time/currency
' formats for locales other than the current regional
' settings will handle. Since VB relies on the control
' panel, this is the only way to accomplish this.
'
' You may use this code in your projects, but a note on who
' you got it from would be appreciated. :-)
'
' Version of this module is 2.1.
'
' HISTORY:
' 1.0 5/5/98 Added date/time enum info
' 1.1 12/1/98 Used Get[Time|Date]Format instead of VB's Format function
' 1.2 5/5/99 Added currency formatting support
' 1.3 10/1/99 Added locale validation code
' 2.0 10/1/99 Added NT5 constants
' 2.1 10/1/99 Added comments on the validation code
'
' (c) 1998-99 Trigeminal Software, Inc. All Rights Reserved
'------------------------------------------
Option Explicit
Option Compare Text
'------------------------------------------------------------
' LOCALE specifiers -- from OLENLS.H
'------------------------------------------------------------
Public Enum LCTypeEnum
LOCALE_NOUSEROVERRIDE = &H80000000 ' OR in to avoid user override
LOCALE_ILANGUAGE = &H1 ' language id
LOCALE_SLANGUAGE = &H2 ' localized name of language
LOCALE_SENGLANGUAGE = &H1001 ' English name of language
LOCALE_SABBREVLANGNAME = &H3 ' abbreviated language name
LOCALE_SNATIVELANGNAME = &H4 ' native name of language
LOCALE_ICOUNTRY = &H5 ' country code
LOCALE_SCOUNTRY = &H6 ' localized name of country
LOCALE_SENGCOUNTRY = &H1002 ' English name of country
LOCALE_SABBREVCTRYNAME = &H7 ' abbreviated country name
LOCALE_SNATIVECTRYNAME = &H8 ' native name of country
LOCALE_IDEFAULTLANGUAGE = &H9 ' default language id
LOCALE_IDEFAULTCOUNTRY = &HA ' default country code
LOCALE_IDEFAULTCODEPAGE = &HB ' default oem code page
LOCALE_IDEFAULTANSICODEPAGE = &H1004 ' default ansi code page
LOCALE_SLIST = &HC ' list item separator
LOCALE_IMEASURE = &HD ' 0 = metric, 1 = US
LOCALE_SDECIMAL = &HE ' decimal separator
LOCALE_STHOUSAND = &HF ' thousand separator
LOCALE_SGROUPING = &H10 ' digit grouping
LOCALE_IDIGITS = &H11 ' number of fractional digits
LOCALE_ILZERO = &H12 ' leading zeros for decimal
LOCALE_INEGNUMBER = &H1010 ' negative number mode
LOCALE_SNATIVEDIGITS = &H13 ' native ascii 0-9
LOCALE_SCURRENCY = &H14 ' local monetary symbol
LOCALE_SINTLSYMBOL = &H15 ' intl monetary symbol
LOCALE_SMONDECIMALSEP = &H16 ' monetary decimal separator
LOCALE_SMONTHOUSANDSEP = &H17 ' monetary thousand separator
LOCALE_SMONGROUPING = &H18 ' monetary grouping
LOCALE_ICURRDIGITS = &H19 ' # local monetary digits
LOCALE_IINTLCURRDIGITS = &H1A ' # intl monetary digits
LOCALE_ICURRENCY = &H1B ' positive currency mode
LOCALE_INEGCURR = &H1C ' negative currency mode
LOCALE_SDATE = &H1D ' date separator
LOCALE_STIME = &H1E ' time separator
LOCALE_SSHORTDATE = &H1F ' short date-time separator
LOCALE_SLONGDATE = &H20 ' long date-time separator
LOCALE_STIMEFORMAT = &H1003 ' time format string
LOCALE_IDATE = &H21 ' short date format ordering
LOCALE_ILDATE = &H22 ' long date format ordering
LOCALE_ITIME = &H23 ' time format specifier
LOCALE_ITIMEMARKPOSN = &H1005 ' time marker position
LOCALE_ICENTURY = &H24 ' century format specifier
LOCALE_ITLZERO = &H25 ' leading zeros in time field
LOCALE_IDAYLZERO = &H26 ' leading zeros in day field
LOCALE_IMONLZERO = &H27 ' leading zeros in month field
LOCALE_S1159 = &H28 ' AM designator
LOCALE_S2359 = &H29 ' PM designator
LOCALE_ICALENDARTYPE = &H1009 ' type of calendar specifier
LOCALE_IOPTIONALCALENDAR = &H100B ' additional calendar types specifier
LOCALE_IFIRSTDAYOFWEEK = &H100C ' first day of week specifier
LOCALE_IFIRSTWEEKOFYEAR = &H100D ' first week of year specifier
LOCALE_SDAYNAME1 = &H2A ' long name for Monday
LOCALE_SDAYNAME2 = &H2B ' long name for Tuesday
LOCALE_SDAYNAME3 = &H2C ' long name for Wednesday
LOCALE_SDAYNAME4 = &H2D ' long name for Thursday
LOCALE_SDAYNAME5 = &H2E ' long name for Friday
LOCALE_SDAYNAME6 = &H2F ' long name for Saturday
LOCALE_SDAYNAME7 = &H30 ' long name for Sunday
LOCALE_SABBREVDAYNAME1 = &H31 ' abbreviated name for Monday
LOCALE_SABBREVDAYNAME2 = &H32 ' abbreviated name for Tuesday
LOCALE_SABBREVDAYNAME3 = &H33 ' abbreviated name for Wednesday
LOCALE_SABBREVDAYNAME4 = &H34 ' abbreviated name for Thursday
LOCALE_SABBREVDAYNAME5 = &H35 ' abbreviated name for Friday
LOCALE_SABBREVDAYNAME6 = &H36 ' abbreviated name for Saturday
LOCALE_SABBREVDAYNAME7 = &H37 ' abbreviated name for Sunday
LOCALE_SMONTHNAME1 = &H38 ' long name for January
LOCALE_SMONTHNAME2 = &H39 ' long name for February
LOCALE_SMONTHNAME3 = &H3A ' long name for March
LOCALE_SMONTHNAME4 = &H3B ' long name for April
LOCALE_SMONTHNAME5 = &H3C ' long name for May
LOCALE_SMONTHNAME6 = &H3D ' long name for June
LOCALE_SMONTHNAME7 = &H3E ' long name for July
LOCALE_SMONTHNAME8 = &H3F ' long name for August
LOCALE_SMONTHNAME9 = &H40 ' long name for September
LOCALE_SMONTHNAME10 = &H41 ' long name for October
LOCALE_SMONTHNAME11 = &H42 ' long name for November
LOCALE_SMONTHNAME12 = &H43 ' long name for December
LOCALE_SMONTHNAME13 = &H100E ' long name for 13th month (if exists)
LOCALE_SABBREVMONTHNAME1 = &H44 ' abbreviated name for January
LOCALE_SABBREVMONTHNAME2 = &H45 ' abbreviated name for February
LOCALE_SABBREVMONTHNAME3 = &H46 ' abbreviated name for March
LOCALE_SABBREVMONTHNAME4 = &H47 ' abbreviated name for April
LOCALE_SABBREVMONTHNAME5 = &H48 ' abbreviated name for May
LOCALE_SABBREVMONTHNAME6 = &H49 ' abbreviated name for June
LOCALE_SABBREVMONTHNAME7 = &H4A ' abbreviated name for July
LOCALE_SABBREVMONTHNAME8 = &H4B ' abbreviated name for August
LOCALE_SABBREVMONTHNAME9 = &H4C ' abbreviated name for September
LOCALE_SABBREVMONTHNAME10 = &H4D ' abbreviated name for October
LOCALE_SABBREVMONTHNAME11 = &H4E ' abbreviated name for November
LOCALE_SABBREVMONTHNAME12 = &H4F ' abbreviated name for December
LOCALE_SABBREVMONTHNAME13 = &H100F ' abbreviated name for 13th month (if exists)
LOCALE_SPOSITIVESIGN = &H50 ' positive sign
LOCALE_SNEGATIVESIGN = &H51 ' negative sign
LOCALE_IPOSSIGNPOSN = &H52 ' positive sign position
LOCALE_INEGSIGNPOSN = &H53 ' negative sign position
LOCALE_IPOSSYMPRECEDES = &H54 ' mon sym precedes pos amt
LOCALE_IPOSSEPBYSPACE = &H55 ' mon sym sep by space from pos
LOCALE_INEGSYMPRECEDES = &H56 ' mon sym precedes neg amt
LOCALE_INEGSEPBYSPACE = &H57 ' mon sym sep by space from neg */
End Enum
' Locale enumeration flags from winnls.h
Private Const LCID_INSTALLED = &H1 '/* installed locale ids */
Private Const LCID_SUPPORTED = &H2 '/* supported locale ids */
' dwFlags values for EnumDateFormats
Private Const DATE_SHORTDATE = &H1 ' use short date picture
Private Const DATE_LONGDATE = &H2 ' use long date picture
Private Const DATE_USE_ALT_CALENDAR = &H4 ' use alternate calendar (if any)
#If (WINVER >= &H500) Then
Private Const DATE_YEARMONTH = &H8 ' use year month picture
Private Const DATE_LTRREADING = &H10 ' add marks for left to right reading order layout
Private Const DATE_RTLREADING = &H20 ' add marks for right to left reading order layout
#End If ' WINVER >= &h0500
Private Type CURRENCYFMT
NumDigits As Long ' number of decimal digits
LeadingZero As Long ' if leading zero in decimal fields
Grouping As Long ' group size left of decimal
lpDecimalSep As String ' ptr to decimal separator string
lpThousandSep As String ' ptr to thousand separator string
NegativeOrder As Long ' negative currency ordering
PositiveOrder As Long ' positive currency ordering
lpCurrencySymbol As String ' ptr to currency symbol string
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)
' Supported by NT4, Windows 95, Windows 98
Private Declare Function ConvertDefaultLocale Lib "kernel32" (ByVal LCID As Long) As Long
Private Declare Function EnumDateFormats Lib "kernel32" Alias "EnumDateFormatsA" (ByVal lpDateFmtEnumProc As Long, ByVal locale As Long, ByVal dwFlags As Long) As Boolean
Private Declare Function EnumTimeFormats Lib "kernel32" Alias "EnumTimeFormatsA" (ByVal lpTimeFmtEnumProc As Long, ByVal locale As Long, ByVal dwFlags As Long) As Boolean
Private Declare Function GetCurrencyFormat Lib "kernel32" Alias "GetCurrencyFormatA" (ByVal locale As Long, ByVal dwFlags As Long, ByVal lpValue As String, lpFormat As CURRENCYFMT, ByVal lpCurrencyStr As String, ByVal cchCurrency As Long) As Long
Private Declare Function GetDateFormat Lib "kernel32" Alias "GetDateFormatA" (ByVal locale As Long, ByVal dwFlags As Long, lpDate As SYSTEMTIME, ByVal lpFormat As String, ByVal lpDateStr As String, ByVal cchDate As Long) As Long
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal LCID As Long, ByVal LCTYPE As Long, lpData As Any, ByVal cchData As Integer) As Integer
Private Declare Function GetUserDefaultLangID Lib "kernel32" () As Integer
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
Private Declare Function GetSystemDefaultLangID Lib "kernel32" () As Integer
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Private Declare Function GetTimeFormat Lib "kernel32" Alias "GetTimeFormatA" (ByVal locale As Long, ByVal dwFlags As Long, lpTime As SYSTEMTIME, ByVal lpFormat As String, ByVal lpTimeStr As String, ByVal cchTime As Long) As Long
Private Declare Function IsValidLocale Lib "kernel32" (ByVal locale As Long, ByVal dwFlags As Long) As Boolean
Private Declare Function VariantTimeToSystemTime Lib "oleaut32.dll" (ByVal vtime As Double, lpSystemTime As SYSTEMTIME) As Boolean
' Not used at present -- Windows 2000-specific functions relating to the UI language.
' CONSIDER: Use them for enhanced NT5 support?
Private Declare Function GetUserDefaultUILanguage Lib "kernel32" () As Long
Private Declare Function GetSystemDefaultUILanguage Lib "kernel32" () As Long
Private m_stFormatEnum As String
'----------------------------------------------------------------------
' StGetLocaleInfo
'
' Gets Locale (international) info about current config
' See LOCALE constants at top of module for LCTYPE values
'----------------------------------------------------------------------
Public Function StGetLocaleInfo(locale As Long, LCTYPE As LCTypeEnum) As String
Dim LCID As Long
Dim stBuff As String * 255
MsgBox "locale = " & locale & " - LCTYPE = " & LCTYPE
'ask for the locale info
If (GetLocaleInfo(locale, LCTYPE, ByVal stBuff, Len(stBuff)) > 0) Then
StGetLocaleInfo = StFromSz(stBuff)
End If
End Function
'------------------------------------------------------------
' StFromSz
'
' Returns a truncated string given a null terminated string
'------------------------------------------------------------g
Public Function StFromSz(szTmp As String) As String
Dim ich As Integer
ich = InStr(1, szTmp, vbNullChar, vbBinaryCompare)
If ich Then
StFromSz = Left$(szTmp, ich - 1)
Else
StFromSz = szTmp
End If
End Function
Public Function StDateEnum(ByVal locale As Long, Optional ByVal fShortDate As Boolean = True) As String
m_stFormatEnum = vbNullString
Call EnumDateFormats(AddressOf EnumFormatsProc, locale, IIf(fShortDate, DATE_SHORTDATE, DATE_LONGDATE))
StDateEnum = m_stFormatEnum
End Function
Public Function StTimeEnum(ByVal locale As Long) As String
m_stFormatEnum = vbNullString
Call EnumTimeFormats(AddressOf EnumFormatsProc, locale, 0&)
StTimeEnum = m_stFormatEnum
End Function
Public Function EnumFormatsProc(ByVal lpFormatString As Long) As Long
Dim st As String
st = String$(lstrlen(lpFormatString), vbNullChar)
RtlMoveMemory ByVal StrPtr(st), ByVal lpFormatString, lstrlen(lpFormatString)
st = StFromSz(StrConv(st, vbUnicode))
' Grab the first format
m_stFormatEnum = st
' Stop enumerating after the first one (there is usually only one anyway)
EnumFormatsProc = 1&
End Function
'------------------------------
' FormatDateTimeIntl
'
' Provides a slightly better version of FormatDateTime which will allow
' you to use format strings other than the ones for the current regional
' settings
'------------------------------
Public Function FormatDateTimeIntl(Expression As Variant, _
Optional NamedFormat As VbDateTimeFormat = vbGeneralDate, _
Optional locale As Long = -1)
Dim stDateFormat As String
Dim stTimeFormat As String
Dim stDateBuffer As String
Dim stTimeBuffer As String
Dim st As SYSTEMTIME
Dim cch As Long
If (IsValidLocale(locale, LCID_SUPPORTED) = 0) Then
' Either they are wanting the default locale, or the locale they specified
' is invalid, so use the normal FormatDateTime function. This works since
' the default value (-1) is not a supported locale
' CONSIDER: NOT a perfect solution, perhaps an error should be raised
' when an invalid LCID is passed?
FormatDateTimeIntl = FormatDateTime(Expression, NamedFormat)
Exit Function
End If
Select Case NamedFormat
Case vbGeneralDate
stDateFormat = StDateEnum(locale, False)
stTimeFormat = StTimeEnum(locale)
Case vbLongDate
stDateFormat = StDateEnum(locale, False)
Case vbShortDate
stDateFormat = StDateEnum(locale, True)
Case vbLongTime
stTimeFormat = StTimeEnum(locale)
Case vbShortTime
' Since VB does not use regional settings for this format, neither
' do we. Display a time using the 24-hour format (hh:mm)
stTimeFormat = "hh" & StGetLocaleInfo(locale, LOCALE_STIME) & "mm"
End Select
If (NamedFormat = vbGeneralDate) Or (NamedFormat = vbLongDate) Or (NamedFormat = vbShortDate) Then
If VariantTimeToSystemTime(Expression, st) Then
cch = GetDateFormat(locale, 0&, st, stDateFormat, vbNullString, 0&)
If cch > 0 Then
stDateBuffer = String$(cch, vbNullChar)
If GetDateFormat(locale, 0&, st, stDateFormat, stDateBuffer, Len(stDateBuffer)) > 0 Then
stDateBuffer = StFromSz(stDateBuffer)
Else
Err.Raise vbObjectError + 3000, "basIntlformats.FormatDateTimeIntl", "Failed GetDateFormat call, GetLastError returns: " & Err.LastDllError
End If
End If
Else
Err.Raise vbObjectError + 3000, "basIntlformats.FormatDateTimeIntl", "Failed VariantTimeToSystemTime call, GetLastError returns: " & Err.LastDllError
End If
End If
If (NamedFormat = vbGeneralDate) Or (NamedFormat = vbLongTime) Or (NamedFormat = vbShortTime) Then
If VariantTimeToSystemTime(Expression, st) Then
cch = GetTimeFormat(locale, 0&, st, stTimeFormat, vbNullString, 0&)
If cch > 0 Then
stTimeBuffer = String$(cch, vbNullChar)
If GetTimeFormat(locale, 0&, st, stTimeFormat, stTimeBuffer, Len(stTimeBuffer)) > 0 Then
stTimeBuffer = StFromSz(stTimeBuffer)
Else
Err.Raise vbObjectError + 3000, "basIntlformats.FormatDateTimeIntl", "Failed GetDateFormat call, GetLastError returns: " & Err.LastDllError
End If
End If
Else
Err.Raise vbObjectError + 3000, "basIntlformats.FormatDateTimeIntl", "Failed VariantTimeToSystemTime call, GetLastError returns: " & Err.LastDllError
End If
End If
If NamedFormat = vbGeneralDate Then
FormatDateTimeIntl = stDateBuffer & " " & stTimeBuffer
Else
FormatDateTimeIntl = stDateBuffer & stTimeBuffer
End If
End Function
'------------------------------
' FormatCurrencyIntl
'
' Provides a slightly better version of FormatCurrency which will allow
' you to use format strings other than the ones for the current regional
' settings...
'------------------------------
Function FormatCurrencyIntl(Expression As Variant, _
Optional NumDigitsAfterDecimal As Long = -1, _
Optional IncludeLeadingDigit As VbTriState = vbUseDefault, _
Optional UseParensForNegativeNumbers As VbTriState = vbUseDefault, _
Optional GroupDigits As VbTriState = vbUseDefault, _
Optional locale As Long = -1) As String
Dim cf As CURRENCYFMT
Dim nc As Integer
Dim stGrouping As String
Dim stBuffer As String
Dim ich As Long
Dim cch As Long
If (IsValidLocale(locale, LCID_SUPPORTED) = 0) Then
' Either they are wanting the default locale, or the locale they specified
' is invalid, so use the normal FormatCurrency function. This works since
' the default value (-1) is not a supported locale.
' CONSIDER: NOT a perfect solution, perhaps an error should be raised
' when an invalid LCID is passed?
FormatCurrencyIntl = FormatCurrency(Expression, NumDigitsAfterDecimal, IncludeLeadingDigit, UseParensForNegativeNumbers, GroupDigits)
Exit Function
End If
If NumDigitsAfterDecimal = -1 Then
cf.NumDigits = StGetLocaleInfo(locale, LOCALE_IDIGITS)
Else
cf.NumDigits = NumDigitsAfterDecimal
End If
If IncludeLeadingDigit = vbUseDefault Then
cf.LeadingZero = StGetLocaleInfo(locale, LOCALE_ILZERO)
Else
cf.LeadingZero = Abs(IncludeLeadingDigit)
End If
Select Case UseParensForNegativeNumbers
Case vbUseDefault
cf.NegativeOrder = StGetLocaleInfo(locale, LOCALE_INEGCURR)
Case vbTrue
If StGetLocaleInfo(locale, LOCALE_INEGSYMPRECEDES) = 1 Then
cf.NegativeOrder = 0 ' Left parenthesis,monetary symbol,number,right parenthesis. Example: ($1.1)
Else
cf.NegativeOrder = 4 ' Left parenthesis, number, monetary symbol, right parenthesis. Example: (1.1$)
End If
Case vbFalse
Select Case StGetLocaleInfo(locale, LOCALE_INEGSIGNPOSN)
Case 0 ' Parentheses surround the amount and the monetary symbol.
' Moral dilemma... the user has said to NOT use parens for
' negative currency, but the control panel says we should
' and does not give us the order. Try to derive it
nc = StGetLocaleInfo(locale, LOCALE_INEGCURR)
Select Case nc
Case 0, 14 ' Left parenthesis,monetary symbol,number,right parenthesis. Example: ($1.1) -- 14 has extra space
cf.NegativeOrder = 1 ' Negative sign, monetary symbol, number. Example: -$1.1
Case 4, 15 ' Left parenthesis, number, monetary symbol, right parenthesis. Example: (1.1$) -- 15 has extra space
cf.NegativeOrder = 7 ' Number, monetary symbol, negative sign. Example: 1.1$-
Case Else
cf.NegativeOrder = nc
End Select
Case 1 ' The sign precedes the number.
cf.NegativeOrder = 2 ' Monetary symbol, negative sign, number. Example: $-1.1
Case 2 ' The sign follows the number.
cf.NegativeOrder = 3 ' Monetary symbol, number, negative sign. Example: $1.1-
Case 3 ' The sign precedes the monetary symbol.
cf.NegativeOrder = 1 ' Negative sign, monetary symbol, number. Example: -$1.1
Case 4 ' The sign follows the monetary symbol.
cf.NegativeOrder = 7 ' Number, monetary symbol, negative sign. Example: 1.1$-
End Select
End Select
Select Case GroupDigits
Case vbUseDefault, vbTrue
stGrouping = StGetLocaleInfo(locale, LOCALE_SMONGROUPING)
ich = InStr(1, stGrouping, ";", vbBinaryCompare)
If ich > 0 Then stGrouping = Left$(stGrouping, ich - 1)
If IsNumeric(stGrouping) Then
cf.Grouping = Val(stGrouping)
Else
cf.Grouping = 3
End If
Case vbFalse
cf.Grouping = 0
End Select
' Get the values that the function does not have params for from the info
' for the given locale
cf.lpCurrencySymbol = StGetLocaleInfo(locale, LOCALE_SCURRENCY)
cf.lpDecimalSep = StGetLocaleInfo(locale, LOCALE_SMONDECIMALSEP)
cf.lpThousandSep = StGetLocaleInfo(locale, LOCALE_STHOUSAND)
cf.PositiveOrder = StGetLocaleInfo(locale, LOCALE_ICURRENCY)
cch = GetCurrencyFormat(locale, 0&, CStr(Expression), cf, vbNullString, 0&)
If cch > 0 Then
stBuffer = String$(cch, vbNullChar)
If GetCurrencyFormat(locale, 0&, CStr(Expression), cf, stBuffer, Len(stBuffer)) > 0 Then
FormatCurrencyIntl = StFromSz(stBuffer)
Else
Err.Raise vbObjectError + 3000, "basIntlformats.FormatCurrencyIntl", "Failed GetCurrencyFormat call, GetLastError returns: " & Err.LastDllError
End If
End If
End FunctionCan I determine which Language is set in Standards and Format option of Control Panel?
Thank You
