INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Visual Basic (Microsoft) Versions 5/6 FAQ

Windows API

Display all Time Zones by SBerthold
Posted: 27 Nov 07

The following will list all available time zones, their bias to universal time, and their current time, based on your system's clock.
(also, clicking the column header will toggle sort)

1. Add a Project Controls reference to the
"Microsoft Hierarchical FlexGrid Control 6.0"

2. Add a Form
3. Add to the Form a Command button (Command1)
4. Also add to the form the HFlexGrid control (MSFlexGrid1)
5. In the code window of the form, paste the following:

CODE

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 REGTIMEZONEINFORMATION
   Bias As Long
   StandardBias As Long
   DaylightBias As Long
   StandardDate As SYSTEMTIME
   DaylightDate As SYSTEMTIME
End Type

Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS = 0&
Private Const KEY_ALL_ACCESS = &H3F

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
   Alias "RegOpenKeyExA" ( _
   ByVal hKey As Long, _
   ByVal lpSubKey As String, _
   ByVal ulOptions As Long, _
   ByVal samDesired As Long, _
   phkResult As Long) _
As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
   Alias "RegQueryValueExA" ( _
   ByVal hKey As Long, _
   ByVal lpszValueName As String, _
   ByVal lpdwReserved As Long, _
   lpdwType As Long, _
   lpData As Any, _
   lpcbData As Long) _
As Long

Private Declare Function RegEnumKey Lib "advapi32.dll" _
   Alias "RegEnumKeyA" ( _
   ByVal hKey As Long, _
   ByVal dwIndex As Long, _
   ByVal lpName As String, _
   ByVal cbName As Long) _
As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
   ByVal hKey As Long) _
As Long

Private mHKey_SubKey As String

Private Sub Form_Load()
    With Me
        .Caption = "Time Zones information"
        .Width = 8625
        .Height = 11880
    End With
    With Command1
        .Caption = "Get Time &Zones"
        .Move 840, 240, 3255, 375
    End With
    
    With MSFlexGrid1
        .Redraw = False
        .FixedCols = 0
        .Cols = 5
        .Rows = 1

        .ColWidth(0) = 25 * Screen.TwipsPerPixelX
        .ColWidth(1) = 200 * Screen.TwipsPerPixelX
        .ColWidth(2) = 35 * Screen.TwipsPerPixelX
        .ColWidth(3) = 50 * Screen.TwipsPerPixelX
        .ColWidth(4) = 75 * Screen.TwipsPerPixelX
        
        .Move 840, 720, .ColWidth(0) + .ColWidth(1) + .ColWidth(2) + .ColWidth(3) + .ColWidth(4) + 350, 10338
        
        .Row = 0
        .TextMatrix(0, 1) = "Time Zone"
        .TextMatrix(0, 2) = "Bias"
        .TextMatrix(0, 3) = "Day"
        .TextMatrix(0, 4) = "Current Time"
        .Redraw = True
    End With
    mHKey_SubKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones"
    'if needed for W95 use: "SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones"  (use API GetVersionEx to determine OS Version))
End Sub

Private Sub Command1_Click()
    Dim lRetVal         As Long, lResult As Long, lCurrentIDX As Long, hKeyResult As Long
    Dim strBuffer       As String
    Dim TimeZoneName    As String
    Dim TimeZoneBias    As Long, lCounter As Long
    Dim strGridRow      As String
    Dim dtZoneTime      As Date
    
    MSFlexGrid1.Redraw = False
    
    lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, mHKey_SubKey, 0, KEY_ALL_ACCESS, hKeyResult)

    If lRetVal = ERROR_SUCCESS Then
        Do
           strBuffer = String(32, 0)
           lResult = RegEnumKey(hKeyResult, lCurrentIDX, strBuffer, 32&)
           
           If lResult = ERROR_SUCCESS Then
        
              TimeZoneName = Left(strBuffer, 32)
              TimeZoneBias = GetTZBias(TimeZoneName)
              dtZoneTime = DateAdd("n", TimeZoneBias, Date)
              
              strGridRow = CStr(lCurrentIDX + 1) & vbTab & Left$(TimeZoneName, InStr(1, TimeZoneName, Chr$(0)) - 1)
              strGridRow = strGridRow & vbTab & Format$(TimeZoneBias / 60, "0.0")
              strGridRow = strGridRow & vbTab & Format$(dtZoneTime, "DDDD") & vbTab & Format$(dtZoneTime, "HH:NN:SS")
              MSFlexGrid1.AddItem strGridRow
           End If
        
           lCurrentIDX = lCurrentIDX + 1
        
        Loop While lResult = ERROR_SUCCESS

        Call RegCloseKey(hKeyResult)
   End If
   
   MSFlexGrid1.Redraw = True
End Sub

Private Function GetTZBias(TimeZoneName As String) As Long
   Dim TZI As REGTIMEZONEINFORMATION
   Dim lRetVal As Long, hKeyResult As Long, lngData As Long

   lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, mHKey_SubKey & "\" & TimeZoneName, 0&, KEY_ALL_ACCESS, hKeyResult)
    If lRetVal = ERROR_SUCCESS Then
        lRetVal = RegQueryValueEx(hKeyResult, "TZI", 0&, ByVal 0&, TZI, Len(TZI))
        If lRetVal = ERROR_SUCCESS Then GetTZBias = TZI.Bias
    End If
End Function

Private Sub MSFlexGrid1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Static LastColSort      As Long
    Static LastSortOrder    As Long
    
    If Button = vbLeftButton Then
        With MSFlexGrid1
            If .MouseRow = 0 Then
                .col = .MouseCol
                LastSortOrder = CLng(Not CBool(LastSortOrder))
                Select Case .MouseCol
                    Case 1
                        .Sort = flexSortStringNoCaseDescending + LastSortOrder
                    Case 2, 3, 4
                        .col = 2
                        .Sort = flexSortNumericDescending + LastSortOrder
                    Case Else
                        .Sort = flexSortNumericDescending + LastSortOrder
                End Select
                
                LastColSort = .col
            End If
        End With
    End If
End Sub

Back to Visual Basic (Microsoft) Versions 5/6 FAQ Index
Back to Visual Basic (Microsoft) Versions 5/6 Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close