|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
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 |
|
|
|
|||||
|
|||||
|
|||||
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |