[VBnet Locale] GetLocaleInfo: System Calendar Information

	Visual Basic Locale/Regionalization Routines GetLocaleInfo: System Calendar Information

Posted:	Sunday August 8, 1999
Updated:	Monday December 26, 2011

Applies to:	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: System Calendar Information

Prerequisites

VB5 or VB6.

While Locale info can be used to enumerate / retrieve specific details of the user's locale settings, another similar method is used to obtain the user's Calendar information. Calendar info includes the localized long and abbreviated names for the calendar days and months, as well as the calendar type used by the locale (ie "Gregorian") and its calendar ID number.

Using EnumCalendarInfo, the VB developer can now retrieve and display month and day information conforming to the national language support for the locale. This means, for example, the day returned corresponding to CAL_SDAYNAME1 constant will differ between the US English, French and German platforms etc.

The demo is straight forward, and amply commented. Labels along the left side of the form are not included in discussing creation the form - they are simply to illustrate the values in the corresponding text and combos. The two labels to the right of the combos are required.

While it is possible (and was in fact the way I first coded this demo) to provide individual EnumProc methods hard-coded to populate each individual combo box, I have changed the code and opted to set the target combo to a global control variable instead allowing the demo to use the same Enum procedure for months and days.

BAS Module Code

Either add the following code to the previously-created Locales.bas, or add a BAS module to a new project:

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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public thisCombo As ComboBox

Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long

Public 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 Declare Function EnumCalendarInfo Lib "kernel32" _
   Alias "EnumCalendarInfoA" _
  (ByVal lpCalInfoEnumProc As Long, _
   ByVal Locale As Long, _
   ByVal Calendar As Long, _
   ByVal CalType As Long) As Long
   
Public Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, _
   Source As Any, _
   ByVal Length As Long)

Public Const LOCALE_SLANGUAGE As Long = &H2     'localized name of language

'Calendar ID Values.
Public Const CAL_GREGORIAN = 1                      'Gregorian (localized) calendar
Public Const CAL_GREGORIAN_US = 2                   'Gregorian (U.S.) calendar
Public Const CAL_JAPAN = 3                          'Japanese Emperor Era calendar
Public Const CAL_TAIWAN = 4                         'Taiwan Region Era calendar
Public Const CAL_KOREA = 5                          'Korean Tangun Era calendar
Public Const CAL_HIJRI = 6                          'Hijri (Arabic Lunar) calendar
Public Const CAL_THAI = 7                           'Thai calendar
Public Const CAL_HEBREW = 8                         'Hebrew (Lunar) calendar
Public Const CAL_GREGORIAN_ME_FRENCH = 9            'Gregorian Middle East French calendar
Public Const CAL_GREGORIAN_ARABIC = 10              'Gregorian Arabic calendar
Public Const CAL_GREGORIAN_XLIT_ENGLISH = 11        'Gregorian Transliterated English calendar
Public Const CAL_GREGORIAN_XLIT_FRENCH = 12         'Gregorian Transliterated French calendar

' Calendar Enumeration Value.
Public Const ENUM_ALL_CALENDARS As Long = &HFFFFFFFF 'enumerate all calendars
Public Const CAL_ICALINTVALUE As Long = &H1         'calendar type
Public Const CAL_SCALNAME As Long = &H2             'native name of calendar
Public Const CAL_IYEAROFFSETRANGE As Long = &H3     'starting years of eras
Public Const CAL_SERASTRING As Long = &H4           'era name for IYearOffsetRanges
Public Const CAL_SSHORTDATE As Long = &H5           'short date format string
Public Const CAL_SLONGDATE As Long = &H6            'long date format string
Public Const CAL_SDAYNAME1 As Long = &H7            'native name for Monday
Public Const CAL_SDAYNAME2 As Long = &H8            'native name for Tuesday
Public Const CAL_SDAYNAME3 As Long = &H9            'native name for Wednesday
Public Const CAL_SDAYNAME4 As Long = &HA            'native name for Thursday
Public Const CAL_SDAYNAME5 As Long = &HB            'native name for Friday
Public Const CAL_SDAYNAME6 As Long = &HC            'native name for Saturday
Public Const CAL_SDAYNAME7 As Long = &HD            'native name for Sunday
Public Const CAL_SABBREVDAYNAME1 As Long = &HE      'abbreviated name for Monday
Public Const CAL_SABBREVDAYNAME2 As Long = &HF      'abbreviated name for Tuesday
Public Const CAL_SABBREVDAYNAME3 As Long = &H10     'abbreviated name for Wednesday
Public Const CAL_SABBREVDAYNAME4 As Long = &H11     'abbreviated name for Thursday
Public Const CAL_SABBREVDAYNAME5 As Long = &H12     'abbreviated name for Friday
Public Const CAL_SABBREVDAYNAME6 As Long = &H13     'abbreviated name for Saturday
Public Const CAL_SABBREVDAYNAME7 As Long = &H14     'abbreviated name for Sunday
Public Const CAL_SMONTHNAME1 As Long = &H15         'native name for January
Public Const CAL_SMONTHNAME2 As Long = &H16         'native name for February
Public Const CAL_SMONTHNAME3 As Long = &H17         'native name for March
Public Const CAL_SMONTHNAME4 As Long = &H18         'native name for April
Public Const CAL_SMONTHNAME5 As Long = &H19         'native name for May
Public Const CAL_SMONTHNAME6 As Long = &H1A         'native name for June
Public Const CAL_SMONTHNAME7 As Long = &H1B         'native name for July
Public Const CAL_SMONTHNAME8 As Long = &H1C         'native name for August
Public Const CAL_SMONTHNAME9 As Long = &H1D         'native name for September
Public Const CAL_SMONTHNAME10 As Long = &H1E        'native name for October
Public Const CAL_SMONTHNAME11 As Long = &H1F        'native name for November
Public Const CAL_SMONTHNAME12 As Long = &H20        'native name for December
Public Const CAL_SMONTHNAME13 As Long = &H21        'native name for 13th month (if any)
Public Const CAL_SABBREVMONTHNAME1 As Long = &H22   'abbreviated name for January
Public Const CAL_SABBREVMONTHNAME2 As Long = &H23   'abbreviated name for February
Public Const CAL_SABBREVMONTHNAME3 As Long = &H24   'abbreviated name for March
Public Const CAL_SABBREVMONTHNAME4 As Long = &H25   'abbreviated name for April
Public Const CAL_SABBREVMONTHNAME5 As Long = &H26   'abbreviated name for May
Public Const CAL_SABBREVMONTHNAME6 As Long = &H27   'abbreviated name for June
Public Const CAL_SABBREVMONTHNAME7 As Long = &H28   'abbreviated name for July
Public Const CAL_SABBREVMONTHNAME8 As Long = &H29   'abbreviated name for August
Public Const CAL_SABBREVMONTHNAME9 As Long = &H2A   'abbreviated name for September
Public Const CAL_SABBREVMONTHNAME10 As Long = &H2B  'abbreviated name for October
Public Const CAL_SABBREVMONTHNAME11 As Long = &H2C  'abbreviated name for November
Public Const CAL_SABBREVMONTHNAME12 As Long = &H2D  'abbreviated name for December
Public Const CAL_SABBREVMONTHNAME13 As Long = &H2E  'abbreviated name for 13th month (if any)

'WINVER >= =&H0500 only
Public Const CAL_SYEARMONTH As Long = &H2F          'year month format string



Public Function EnumCalendarProc(lpDateFormatString As Long) As Long

  'application-defined callback function for EnumCalendarInfo
   thisCombo.AddItem StringFromPointer(lpDateFormatString)
   
  'return 1 to continue enumeration
   EnumCalendarProc = 1
   
End Function


Public Function EnumCalendarNameProc(lpDateFormatString As Long) As Long

  'application-defined callback function for EnumCalendarInfo
   Form1.Text2.Text = StringFromPointer(lpDateFormatString)
   
  'return 1 to continue enumeration
   EnumCalendarNameProc = 1

End Function


Private Function StringFromPointer(lpString As Long) As String

   Dim pos As Long
   Dim buffer As String
   
  'pad a string to hold the data
   buffer = Space$(128)
   
  'copy the string pointed to by the return value
   CopyMemory ByVal buffer, lpString, ByVal Len(buffer)
   
  'remove the trailing null and trim
   pos = InStr(buffer, Chr$(0))
   
   If pos Then
      StringFromPointer = Left$(buffer, pos - 1)
   End If

End Function


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 (r > 0)
   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

Form Code

Create a form containing two textboxes (Text1, Text2), a command button (Command1) and six Combo boxes (Combo1-Combo6). Add two labels (Label1, Label2) and add the following code to the form:

Option Explicit


Private Sub Form_Load()

   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2

End Sub


Private Sub Command1_Click()

   Dim LCID As Long
   Dim success As Long
   
   LCID = GetSystemDefaultLCID()
   
  'if the call to obtain the locale
  'identifier failed, subsequent calls
  'will fail too
   If LCID <> 0 Then
   
   '-------------------------------------
     'localized name of language
      Text1.Text = GetUserLocaleInfo(LCID, LOCALE_SLANGUAGE)
      
     'localized name of calendar
      success = GetLocaleCalendarName(LCID)
   
   '-------------------------------------
     'assign the target combo box control
      Set thisCombo = Form1.Combo1
      
        'enumerated system long date formats
         success = GetLocaleDateFormats(LCID, CAL_SLONGDATE)
         If success Then Combo1.ListIndex = 0
         
   '-------------------------------------
     'assign the target combo box control
      Set thisCombo = Form1.Combo2
      
        'enumerated system short date formats
         success = GetLocaleDateFormats(LCID, CAL_SSHORTDATE)
         If success Then Combo2.ListIndex = 0
         
   '-------------------------------------
     'assign the target combo box control
      Set thisCombo = Form1.Combo3
      
        'Constants for the days range from
        '  CAL_SDAYNAME1 = &H7   'Monday to ..
        '  CAL_SDAYNAME7 = &HD   'Sunday
        '
        'This and subsequent routines need to loop through 
        'the values (they are returned only on demand for 
        'the specific value), so a Enum with a
        'For/Next is used.
        '
        'enumerated system day names
         success = GetLocaleCalendarLists(LCID, _
                                          CAL_SDAYNAME1, _
                                          CAL_SDAYNAME7)
         If success Then Combo3.ListIndex = 0
     
   '-------------------------------------
     'assign the target combo box control
      Set thisCombo = Form1.Combo4
      
        'Constants for the days range from
        '  CAL_SABBREVDAYNAME1 = &HE   'Monday to ..
        '  CAL_SABBREVDAYNAME7 = &H14  'Sunday
        'enumerated abbreviated system day names
         success = GetLocaleCalendarLists(LCID, _
                                          CAL_SABBREVDAYNAME1, _
                                          CAL_SABBREVDAYNAME7)
         If success Then Combo4.ListIndex = 0
         
   '-------------------------------------
     'assign the target combo box control
      Set thisCombo = Form1.Combo5
      
        'Constants for the days range from
        '  CAL_SMONTHNAME1 = &H15   'January to ..
        '  CAL_SMONTHNAME13 = &H21  '13th month (if any)
        'enumerated system month names
         success = GetLocaleCalendarLists(LCID, _
                                          CAL_SMONTHNAME1, _
                                          CAL_SMONTHNAME13)
         If success Then Combo5.ListIndex = 0

   '-------------------------------------
     'assign the target combo box control
      Set thisCombo = Form1.Combo6
      
        'Constants for the days range from
        '  CAL_SABBREVMONTHNAME1 = &H22   'January to ..
        '  CAL_SABBREVMONTHNAME13 = &H2E  '13th month (if any)
        'enumerated abbreviated system month names
         success = GetLocaleCalendarLists(LCID, _
                                          CAL_SABBREVMONTHNAME1, _
                                          CAL_SABBREVMONTHNAME13)
         If success Then Combo6.ListIndex = 0

   End If
   
End Sub


Private Sub Combo1_Click()

   Dim tmpFormat As String
   
   tmpFormat = Combo1.List(Combo1.ListIndex)
   Label1.Caption = Format$(Now, tmpFormat)
   
End Sub


Private Sub Combo2_Click()

   Dim tmpFormat As String
   
   tmpFormat = Combo2.List(Combo2.ListIndex)
   Label2.Caption = Format$(Now, tmpFormat)
   
End Sub


Private Function GetLocaleCalendarName(LCID As Long) As Long

  'enumerate the system calendar name(s)
   Dim ret As Long
  
   If LCID Then
   
      ret = EnumCalendarInfo(AddressOf EnumCalendarNameProc, _
                             LCID, _
                             ENUM_ALL_CALENDARS, _
                             CAL_SCALNAME)
   End If
   
   GetLocaleCalendarName = ret

End Function


Private Function GetLocaleDateFormats(LCID As Long, _
                                      CalType As Long) As Long

  'enumerate the system long date formats
   Dim ret As Long
  
   If LCID Then
   
     'enumerate available long date formats
      ret = EnumCalendarInfo(AddressOf EnumCalendarProc, _
                             LCID, _
                             ENUM_ALL_CALENDARS, _
                             CalType)
   End If
   
   GetLocaleDateFormats = ret
   
End Function


Private Function GetLocaleCalendarLists(LCID As Long, _
                                        TMP_CAL_START As Long, _
                                        TMP_CAL_END As Long) As Long

  'enumerate the system items for the range passed
   Dim ret As Long
   Dim item As Long
  
   If LCID Then
   
      For item = TMP_CAL_START To TMP_CAL_END
      
         ret = EnumCalendarInfo(AddressOf EnumCalendarProc, _
                                LCID, _
                                ENUM_ALL_CALENDARS, _
                                item)
                             
      Next
      
   End If
   
   GetLocaleCalendarLists = ret
   
End Function

Comments

Save the program and run. The values displayed should correspond to the calendar strings for your system.

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.

PayPal Link