Attribute VB_Name = "basHijriDateOffset"
Option Compare Binary
Option Explicit

' REQUIRES the following modules from \SOURCE\Part02\TIMEZONE on the CD:
'       reg.bas
'       key.cls
'       keys.cls
'       value.cls
'       values.cls
' For registry support


' Returns whether the user has specified an offset in th control
' panel for the Hijri Calendar. This is only possible on Arabic
' localized or enabled versions of Windows prior to Windows
' 2000 but is available on all versions for Windows 2000 and
' better
'
' The key is the following reg key:
'   HKCU\Control Panel\International
' The value name is:
'   AddHijriDate
' The possible values are:
'   -2          AddHijriDate -2
'   -1          AddHijriDate
'   0           <blank value or value name not present>
'   +1          AddHijriDate+1
'   +2          AddHijriDate+2

' Unfortunately, GetLocaleInfo does not support a way to retrieve the value
'
' Used by OUTLOOK to handle Hijri dates, ignored by everyone else though.

Private Const ERR_INVALIDPROPERTYVALUE = 380
Private Const ERR_INVALIDPROCEDURECALLORARGUMENT = 5

Public Function Offset() As Integer
On Error GoTo Offset_Err
    Dim hKeyRoot As Key
    Dim hKeyLocaleInfo As Key
    Dim regval As Value
    Dim stLocaleInfo As String
    Dim stInc As String
    
    stLocaleInfo = "Control Panel\International"
    
    Set hKeyRoot = New Key
    hKeyRoot.Handle = HKEY_CURRENT_USER
    Set hKeyLocaleInfo = hKeyRoot.OpenSubKey(stLocaleInfo)
    
    Set regval = hKeyLocaleInfo.Values("AddHijriDate")
    
    If Len(regval.Value) = 0 Then
        ' The key is present, but without a value, which means no offset
        Offset = 0
    Else
        stInc = Mid$(regval.Value, 13)
        Select Case stInc
            Case vbNullString
                ' There is no offset number which means -1, basically
                Offset = -1
            Case "-3", "-2", "-1", "+1", "+2", "+3"
                ' Note that the -1 case should be impossible, and the +/-3
                ' case are not possible until Whistler (prior versions max-ed
                ' out at +/-2
                Offset = Val(stInc)
            Case Else
                ' Someone messed up the reg key
                Err.Raise ERR_INVALIDPROPERTYVALUE
        End Select
    End If
    
Offset_Exit:
    Exit Function

Offset_Err:
    Select Case Err.Number
        Case ERR_INVALIDPROPERTYVALUE
            ' registry format not expected!
            Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
        Case ERR_INVALIDPROCEDURECALLORARGUMENT
            Offset = 0
        Case Else
            ' unknown error
            Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End Select
    Resume Offset_Exit
    
End Function