basIntlFormats (1 Viewer)

[Guus2005]

I found this gem here on AWF. https://www.access-programmers.co.uk/forums/threads/please-explain-how-to-use-this-module.180307/
And i believe that it is outdated. It is obviously 20 years old and the return values are not always what i expect them to be.

Examples:

?stGetLocaleInfo(LOCALE_SMONDECIMALSEP,LOCALE_SMONDECIMALSEP)
,

Returns a comma, which is what i expect in my country.

?stGetLocaleInfo(LOCALE_SMONTHOUSANDSEP,LOCALE_SMONTHOUSANDSEP)
'

Returns a quote, where i would expect a dot.

I am looking for the same code but updated a few years and perhaps with better results.

Thanks for your time!

 

[Ranman256]

what are you wanting to do?

 

[arnelgp]

i've found this a long time ago:

'These declarations are designed
'for use in a .bas module
'since the constants are public

#If VBA7 Then

Private Declare PtrSafe 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 Declare PtrSafe Function GetSystemDefaultLCID Lib "kernel32" () As Long

Private Declare PtrSafe Function PostMessage Lib "USER32" Alias "PostMessageA" ( _
        ByVal hwnd As LongPtr, _
            ByVal wMsg As Long, _
                ByVal wParam As LongPtr, _
                    ByVal lParam As LongPtr) As Long

Private Declare PtrSafe Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" ( _
        ByVal Locale As Long, _
            ByVal LCType As Long, _
                ByVal lpLCData As String) As Long

Private Declare PtrSafe Function GetUserDefaultLCID Lib "kernel32" () As Long

#Else


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 Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long

Private Declare Function PostMessage Lib "user32" _
   Alias "PostMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long

Private Declare Function SetLocaleInfo Lib "kernel32" Alias _
"SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, _
ByVal lpLCData As String) As Boolean

Private Declare Function GetUserDefaultLCID% Lib "kernel32" ()
#End If

Private Const LOCALE_ICENTURY = &H24
Private Const LOCALE_ICOUNTRY = &H5
Private Const LOCALE_ICURRDIGITS = &H19
Private Const LOCALE_ICURRENCY = &H1B
Private Const LOCALE_IDATE = &H21
Private Const LOCALE_IDAYLZERO = &H26
Private Const LOCALE_IDEFAULTCODEPAGE = &HB
Private Const LOCALE_IDEFAULTCOUNTRY = &HA
Private Const LOCALE_IDEFAULTLANGUAGE = &H9
Private Const LOCALE_IDIGITS = &H11
Private Const LOCALE_IINTLCURRDIGITS = &H1A
Private Const LOCALE_ILANGUAGE = &H1
Private Const LOCALE_ILDATE = &H22
Private Const LOCALE_ILZERO = &H12
Private Const LOCALE_IMEASURE = &HD
Private Const LOCALE_IMONLZERO = &H27
Private Const LOCALE_INEGCURR = &H1C
Private Const LOCALE_INEGSEPBYSPACE = &H57
Private Const LOCALE_INEGSIGNPOSN = &H53
Private Const LOCALE_INEGSYMPRECEDES = &H56
Private Const LOCALE_IPOSSEPBYSPACE = &H55
Private Const LOCALE_IPOSSIGNPOSN = &H52
Private Const LOCALE_IPOSSYMPRECEDES = &H54
Private Const LOCALE_ITIME = &H23
Private Const LOCALE_ITLZERO = &H25
Private Const LOCALE_NOUSEROVERRIDE = &H80000000
Private Const LOCALE_S1159 = &H28
Private Const LOCALE_S2359 = &H29
Private Const LOCALE_SABBREVCTRYNAME = &H7
Private Const LOCALE_SABBREVDAYNAME1 = &H31
Private Const LOCALE_SABBREVDAYNAME2 = &H32
Private Const LOCALE_SABBREVDAYNAME3 = &H33
Private Const LOCALE_SABBREVDAYNAME4 = &H34
Private Const LOCALE_SABBREVDAYNAME5 = &H35
Private Const LOCALE_SABBREVDAYNAME6 = &H36
Private Const LOCALE_SABBREVDAYNAME7 = &H37
Private Const LOCALE_SABBREVLANGNAME = &H3
Private Const LOCALE_SABBREVMONTHNAME1 = &H44
Private Const LOCALE_SCOUNTRY = &H6
Private Const LOCALE_SCURRENCY = &H14
Private Const LOCALE_SDATE = &H1D
Private Const LOCALE_SDAYNAME1 = &H2A
Private Const LOCALE_SDAYNAME2 = &H2B
Private Const LOCALE_SDAYNAME3 = &H2C
Private Const LOCALE_SDAYNAME4 = &H2D
Private Const LOCALE_SDAYNAME5 = &H2E
Private Const LOCALE_SDAYNAME6 = &H2F
Private Const LOCALE_SDAYNAME7 = &H30
Private Const LOCALE_SDECIMAL = &HE
Private Const LOCALE_SGROUPING = &H10
Private Const LOCALE_SINTLSYMBOL = &H15
Private Const LOCALE_SLANGUAGE = &H2
Private Const LOCALE_SLIST = &HC
Private Const LOCALE_SLONGDATE = &H20
Private Const LOCALE_SMONDECIMALSEP = &H16
Private Const LOCALE_SMONGROUPING = &H18
Private Const LOCALE_SMONTHNAME1 = &H38
Private Const LOCALE_SMONTHNAME10 = &H41
Private Const LOCALE_SMONTHNAME11 = &H42
Private Const LOCALE_SMONTHNAME12 = &H43
Private Const LOCALE_SMONTHNAME2 = &H39
Private Const LOCALE_SMONTHNAME3 = &H3A
Private Const LOCALE_SMONTHNAME4 = &H3B
Private Const LOCALE_SMONTHNAME5 = &H3C
Private Const LOCALE_SMONTHNAME6 = &H3D
Private Const LOCALE_SMONTHNAME7 = &H3E
Private Const LOCALE_SMONTHNAME8 = &H3F
Private Const LOCALE_SMONTHNAME9 = &H40
Private Const LOCALE_SMONTHOUSANDSEP = &H17
Private Const LOCALE_SNATIVEDIGITS = &H13
Private Const LOCALE_SNEGATIVESIGN = &H51
Private Const LOCALE_SPOSITIVESIGN = &H50
Private Const LOCALE_SSHORTDATE = &H1F
Private Const LOCALE_STHOUSAND = &HF
Private Const LOCALE_STIME = &H1E
Private Const LOCALE_STIMEFORMAT = &H1003

Private Const LOCALE_USER_DEFAULT = &H400
Private Const LOCALE_SENGCOUNTRY = &H1002 ' English name of country
Private Const LOCALE_SENGLANGUAGE = &H1001  ' English name of language
Private Const LOCALE_SNATIVELANGNAME = &H4  ' native name of language
Private Const LOCALE_SNATIVECTRYNAME = &H8  ' native name of country

Private Const HWND_BROADCAST = &HFFFF
Private Const WM_SETTINGCHANGE = &H1A

Public Sub Change_LocaleInfo()

   Dim LCID As Long
   Dim sNewFormat As String
  
   LCID = GetSystemDefaultLCID()
  
   'European #1
   FormatSymb = "€"
   FormatDec = ","
   FormatThou = "."
   FormatSDate = "d.MM.yy"
   FormatLDate = "d MMMM yyyy"
    
   'European #2
   FormatSymb = "€"
   FormatDec = "."
   FormatThou = ","
   FormatSDate = "dd/MM/yyyy"
   FormatLDate = "dd MMMM yyyy"
    
     'set the new long date format
      Call SetLocaleInfo(LCID, LOCALE_SCURRENCY, FormatSymb)
      Call SetLocaleInfo(LCID, LOCALE_SMONDECIMALSEP, FormatDec)
      Call SetLocaleInfo(LCID, LOCALE_SMONTHOUSANDSEP, FormatThou)
      Call SetLocaleInfo(LCID, LOCALE_SLONGDATE, FormatLDate)
      Call SetLocaleInfo(LCID, LOCALE_SSHORTDATE, FormatSDate)
    
     'send a system notification
      Call PostMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0&, ByVal 0&)
      'Call PostMessage(Application.hWndAccessApp, WM_SETTINGCHANGE, 0&, ByVal 0&)
      
      Debug.Print Format$(10000.56, "Currency")
      Debug.Print Format$(Date, "Short Date")
      Debug.Print Format$(Date, "Long Date")

End Sub

Public Function GetInfo(ByVal lInfo As Long) As String
    Dim Buffer As String
    Dim ret As String
    Buffer = String$(256, 0)
    ret = GetLocaleInfo(LOCALE_USER_DEFAULT, lInfo, Buffer, Len(Buffer))
    If ret > 0 Then
        GetInfo = Left$(Buffer, ret - 1)
    Else
        GetInfo = ""
    End If
End Function
 
Private Sub Test()
    'MsgBox "You live in " & GetInfo(LOCALE_SENGCOUNTRY) & _
    '" (" & GetInfo(LOCALE_SNATIVECTRYNAME) & ")," & vbCrLf & "and you speak " & GetInfo(LOCALE_SENGLANGUAGE) & _
    ''" (" & GetInfo(LOCALE_SNATIVELANGNAME) & ").", vbInformation 'WORKS CORRECTLY
    'MsgBox ("UserDefault: " & GetInfo(LOCALE_USER_DEFAULT)) 'STILL EMPTY STRING
    'MsgBox ("SDecimal: " & GetInfo(LOCALE_SDECIMAL)) 'RETURNS "."
    'MsgBox ("ILDate: " & GetInfo(LOCALE_ILDATE))     'RETURNS "0"
    'MsgBox ("Country: " & GetInfo(LOCALE_ICOUNTRY))  'RETURNS "1"
    
    MsgBox GetInfo(LOCALE_SMONDECIMALSEP)
    MsgBox GetInfo(LOCALE_SMONTHOUSANDSEP)
End Sub