Zjištění datumů a přechodů mezi časy

Postup:
Na formulář přidejte 4 textboxy, label a tlačítko. Pak zapište:
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 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 ((32 * 2) - 1)) As Byte  'unicode
   StandardDate As SYSTEMTIME
   StandardBias As Long
   DaylightName(0 To ((32 * 2) - 1)) As Byte  'unicode
   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 Sub Form_Load()

   Command1.Caption = "Zjištění informací"
   
End Sub


Private Sub Command1_Click()

   Label1.Caption = Format$(Now, "long date")
   
   Text1.Text = GetDaylightChangeDate(vbLongDate)
   Text2.Text = GetDaylightChangeTime(vbLongTime)
   
   Text3.Text = GetStandardChangeDate(vbLongDate)
   Text4.Text = GetStandardChangeTime(vbLongTime)


End Sub


Private Function GetDaylightChangeDate(dwType As DateFormats) As String

   Dim tzi As TIME_ZONE_INFORMATION
   Dim tmp As String
   
   Call GetTimeZoneInformation(tzi)
   
   tmp = DateSerial(Year(Now), _
                    tzi.DaylightDate.wMonth, _
                    tzi.DaylightDate.wDay)
                                   

   Select Case dwType
      Case vbGeneralDate: tmp = Format$(tmp, "general date")
      Case vbLongDate:    tmp = Format$(tmp, "long date")
      Case vbShortDate:   tmp = Format$(tmp, "short date")
   End Select
   
   GetDaylightChangeDate = tmp
   
End Function


Private Function GetStandardChangeDate(dwType As DateFormats) As String

   Dim tzi As TIME_ZONE_INFORMATION
   Dim tmp As String
   
   Call GetTimeZoneInformation(tzi)
   
   tmp = DateSerial(Year(Now), _
                    tzi.StandardDate.wMonth, _
                    tzi.StandardDate.wDay)
                                   

   Select Case dwType
      Case vbGeneralDate: tmp = Format$(tmp, "general date")
      Case vbLongDate:    tmp = Format$(tmp, "long date")
      Case vbShortDate:   tmp = Format$(tmp, "short date")
   End Select
   
   GetStandardChangeDate = tmp
   
End Function


Private Function GetDaylightChangeTime(dwType As DateFormats) As Date

   Dim tzi As TIME_ZONE_INFORMATION
   Dim tmp As Date
   
   Call GetTimeZoneInformation(tzi)
   
   tmp = TimeSerial(tzi.DaylightDate.wHour, _
                    tzi.DaylightDate.wMinute, _
                    tzi.DaylightDate.wSecond)
   
   Select Case dwType
      Case vbLongTime:  tmp = Format$(tmp, "long time")
      Case vbShortTime: tmp = Format$(tmp, "short time")
   End Select
   
   GetDaylightChangeTime = tmp
   
End Function


Private Function GetStandardChangeTime(dwType As DateFormats) As Date

   Dim tzi As TIME_ZONE_INFORMATION
   Dim tmp As Date
   
   Call GetTimeZoneInformation(tzi)
   
   tmp = TimeSerial(tzi.StandardDate.wHour, _
                    tzi.StandardDate.wMinute, _
                    tzi.StandardDate.wSecond)
   
   Select Case dwType
      Case vbLongTime:  tmp = Format$(tmp, "long time")
      Case vbShortTime: tmp = Format$(tmp, "short time")
   End Select
   
   GetStandardChangeTime = tmp
   
End Function

Zpět