Visual Basic

Sometimes You Have to Get Strict

The previous pages have introduced a number of elements that when used together provide a nearly complete way of applying a better windowing algorithm than that provided by default. You can take an alternative track here. Instead of trying to make the language more flexible, you can make it stricter by using a class and subclassed functions in the same way as before. This time, however, you'll reject any date expressions that do not have any century information in them.

At the center of this strategy is an algorithm that can tell whether a date expression has a century in it. Listing 8-4 shows the CStrictDate class that uses this algorithm to test any expressions as they are assigned, rejecting those that fail its test. This class can be used in place of the Date data type to enforce a strict policy of Year 2000 compliance on all dates stored. The class will reject the assignment of a date expression where the century information is not present.

At the center of this class is the bPiIsStrictDate function, which performs a job similar to Visual Basic's IsDate function. In the case ofbPiIsStrictDate, an extra test is performed to make sure that the passed expression not only can be converted to a Date, but is also unambiguous.

Listing 8-4 The CStrictDate Class

  ' This is an implementation of a Strict Date data type.
  ' In this class, only valid and unambiguous dates are
  ' stored. If an assignment is attempted using an
  ' ambiguous date expression such as '02/02/98,' this
  ' is rejected as if it were an invalid value.
  Option Explicit
  ' This is where the date is actually stored.
  ' As all dates this defaults to '1899-12-30'.
  Private m_dteInternalDate       As Date
  ' This is the error that is raised if an attempt is
  ' made to assign an invalid date (as VB's Date does).
  Private Const ERROR_TYPE_MISMATCH   As Long = 13
  Private Function bPiIsStrictDate(ByVal Expression As Variant) _
                                   As Boolean
  ' This function will return true if the passed
  ' date expression is a valid and unambiguous date.
  ' If the expression is either ambiguous or
  ' invalid, it will return false.
      Dim bIsDate     As Boolean
      ' OK, VB can do the hard work. Can this value
      ' be converted to a date?
      bIsDate = VBA.Information.IsDate(Expression)
      ' Additional check if the literal is a string.
      ' Is it an ambiguous date?
      If bIsDate = True And VarType(Expression) = vbString Then
          ' Search for the year within the passed string literal.
          If 0 = InStr(1, _
              VBA.Conversion.CStr(Expression), _
              VBA.DateTime.Year(VBA.Conversion.CDate(Expression)), _
              vbTextCompare) Then
              ' We could not find the full 4-digit year in the
              ' passed literal; therefore the date is ambiguous
              ' and so we mark it as invalid.
              bIsDate = False
          End If
      End If
      ' Return whether this is a valid date or not.
      bPiIsStrictDate = bIsDate
  End Function
  Public Property Get DateValue() As Variant
      ' Return the date value stored internally.
      DateValue = m_dteInternalDate
  End Property
  Public Property Let DateValue(ByVal Expression As Variant)
      If bPiIsStrictDate(Expression) Then
              ' If the date expression does conform to our
              ' validation rules, store it.
              m_dteInternalDate = VBA.Conversion.CDate(Expression)
              ' Otherwise emulate VB and raise a standard error.
              Err.Raise ERROR_TYPE_MISMATCH
      End If
  End Property
  Public Property Get IsLeapYear() As Boolean
  ' This read-only property indicates
  ' whether the stored Date value is in
  ' a leap year.
      IsLeapYear = 29 _
                 = VBA.DateTime.Day(VBA.DateTime.DateSerial( _
                   VBA.DateTime.Year(m_dteInternalDate), 2, 29))
  End Property