Visual Basic Locale/Regionalization Routines
GetTimeZoneInformation: Past, Current and Future Daylight/Standard Dates
     
Posted:   Sunday April 08, 2001
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP Pro
OS restrictions:   None
Author:   VBnet - Randy Birch, Chip Pearson, Bob Butler, Mathias Schiffer, Mark Boettger
     

Related:  

RegQueryValueEx: Identify Time Zones by Time Zone Bias
GetTimeZoneInformation: Determine when Daylight Saving Time Occurs
GetTimeZoneInformation: Current, Standard and Daylight Bias
GetTimeZoneInformation: Locale Standard and Daylight Time Zone Names

GetTimeZoneInformation: Obtain Dates for Daylight and Standard Time Changes
     
 Prerequisites
None.

This is straightforward code to populate a list with historical and future dates for the transition to/from Daylight Saving Time and Standard Time.

Time zone code was inspired by newsgroup postings by Bob Butler and Excel MVP Chip Pearson. The date adjustment routine was provided by VB MVP Mathias Schiffer, with a correction for dates occurring on the first or last days of the month provided by Mark Boettger.

 BAS Module Code
None.

 Form Code
Add a command button (Command1) and a list box (List1) to a form, 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 TIME_ZONE_ID_UNKNOWN As Long = 1
Private Const TIME_ZONE_ID_STANDARD As Long = 1
Private Const TIME_ZONE_ID_DAYLIGHT As Long = 2
Private Const TIME_ZONE_ID_INVALID As Long = &HFFFFFFFF

Private Const LB_SETTABSTOPS As Long = &H192
Private Const LB_FINDSTRING = &H18F    

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 Type TIME_ZONE_INFORMATION
   Bias As Long
   StandardName(0 To 63) As Byte  'unicode (0-based)
   StandardDate As SYSTEMTIME
   StandardBias As Long
   DaylightName(0 To 63) As Byte  'unicode (0-based)
   DaylightDate As SYSTEMTIME
   DaylightBias As Long
End Type

Private Enum DateFormats
   vbGeneralDate = 0
   vbLongDate = 1
   vbShortDate = 2
   vbLongTime = 3
   vbShortTime = 4
End Enum

Private Declare Function GetTimeZoneInformation Lib "kernel32" _
    (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
    
Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long


Private Sub Form_Load()

   ReDim TabArray(0 To 1) As Long
   
   TabArray(0) = 50
   TabArray(1) = 106
   
  'Clear existing tabs and set new ones
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 2&, TabArray(0))
   List1.Refresh

   Command1.Caption = "Get Time Zone Change Dates"
   
End Sub


Private Sub Command1_Click()

   Dim tzi As TIME_ZONE_INFORMATION
   Dim tziYear As Long
   
  'retrieve time zone info for the system
   Call GetTimeZoneInformation(tzi)
   
  'The .wYear parameter in the StandardTime
  'and DaylightTime members return as 0,
  'and we have to pass a valid year as well.
  'This shows historical dates since DST
  'formally began in 1966, continuing 
  'for 100 years.
   For tziYear = 1966 To 2066
   
     'call method that uses the time zone info
     'returned to calculate the actual dates that
     'daylight/standard time changes
      List1.AddItem tziYear & vbTab & _
                    GetTimezoneChangeDate(tzi.DaylightDate, _
                                          tziYear, _
                                          vbLongDate) & vbTab & _
                    GetTimezoneChangeDate(tzi.StandardDate, _
                                          tziYear, _
                                          vbLongDate)
   Next
   
  'this just locates the current year
  'in the list, making it the top list item
   EnsureItemVisible CStr(Year(Now))
   
End Sub


Private Function GetTimezoneChangeDate(tziDate As SYSTEMTIME, _
                                       ByVal tziYear As Long, _
                                       ByVal dwType As DateFormats) As String

  'thanks to Mathias Schiffer for this routine
  
   Dim tmp As Date
   Dim MonthFirstWeekday As Long

   With tziDate

      Select Case .wDay 'week in month

         Case 1 To 4:   'week 1 to week 4

           'Calculate the first day in the month,
           'and then calculate the appropriate day
           'that the time zone change will occur
            MonthFirstWeekday = Weekday(DateSerial(tziYear, .wMonth, 1)) - 1
            tmp = DateSerial(tziYear, _
                             .wMonth, _
                              (.wDayOfWeek - MonthFirstWeekday + _
                              .wDay * 7) Mod 7 + 1)



         Case 5:        'last week in month

           'Calculate the month's last day,
           'then work back to the appropriate
           'weekday
            tmp = DateSerial(tziYear, .wMonth + 1, 0)
            tmp = DateAdd("d", tmp, _
                          -(Weekday(tmp) - .wDayOfWeek + 7 - 1) Mod 7)

      End Select

   End With
   
  'Now that the date has been calculated,
  'return it in the string format requested
  'In VB6, you can use the FormatDateTime 
  'function to return date in specified format
   GetTimezoneChangeDate = Format$(tmp, "MMMM dd")
   
End Function


Private Function GetTimezoneChangeTime(tzi As SYSTEMTIME, _
                                       ByVal dwType As DateFormats) As String

   Dim tmp As Date
   
   tmp = TimeSerial(tzi.wHour, tzi.wMinute, tzi.wSecond)
   GetTimezoneChangeTime = FormatDateTime(tmp, dwType)
   
End Function


Private Function EnsureItemVisible(ByVal sItem As String) As Long

   Dim index As Long
   
   index = SendMessage(List1.hwnd, LB_FINDSTRING, -1, ByVal sItem)
   
   If index > -1 Then
      List1.ListIndex = index
      List1.TopIndex = index
   End If
      
End Function
 Comments
If your version of VB does not support FormatDateTime, use the following code blocks instead inside the GetTimezoneChangeDate and GetTimezoneChangeTime routines:
  'In VB4-32 or VB5, use Format$ instead in GetTimezoneChangeDate
  Select Case dwType
     Case vbGeneralDate: GetTimezoneChangeDate = Format$(tmp, "general date")
     Case vbLongDate:    GetTimezoneChangeDate = Format$(tmp, "long date")
     Case vbShortDate:   GetTimezoneChangeDate = Format$(tmp, "short date")
  End Select
  
  
  'In VB4-32 or VB5, use Format$ instead in GetTimezoneChangeTime
   Select Case dwType
      Case vbLongTime:  tmp = Format$(tmp, "long time")
      Case vbShortTime: tmp = Format$(tmp, "short time")
   End Select

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter