cdate.cls

Visual Basic 6 大学教程的代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CDate1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' Fig. 16.5
' Class CDate1 definition
Option Explicit

Private mMonth As Integer
Private mDay As Integer
Private mYear As Integer

Private Sub Class_Initialize()
   mDay = 1
   mMonth = 1
   mYear = 1900
End Sub

Public Property Get Day() As Integer
   Day = mDay
End Property

Public Property Let Day(ByVal dy As Integer)
   mDay = ValidateDay(dy)
End Property

Public Property Get Month() As Integer
   Month = mMonth
End Property

Public Property Let Month(ByVal mth As Integer)
   mMonth = ValidateMonth(mth)
End Property

Public Property Get year() As Integer
   year = mYear
End Property

Public Property Let year(ByVal yr As Integer)
   mYear = yr   ' Could also be validated by programmer
End Property

Public Function ToString() As String
   ToString = mMonth & "/" & mDay & "/" & mYear
End Function

Public Sub SetDate(ByVal dy As Integer, ByVal mth As Integer, _
                   ByVal yr As Integer)
   mMonth = ValidateMonth(mth)
   mDay = ValidateDay(dy)
   mYear = yr
End Sub

Private Function ValidateMonth(ByVal mth As Integer) As Integer
   ValidateMonth = IIf((mth > 0 And mth <= 12), mth, 1)
End Function

Private Function ValidateDay(ByVal dy As Integer) As Integer
   Dim daysPerMonth()
   
   daysPerMonth = Array(0, 31, 28, 31, 30, 31, 30, 31, 31, _
                        30, 31, 30, 31)
   
   If dy > 0 And dy <= daysPerMonth(mMonth) Then
      ValidateDay = dy
      Exit Function
   End If
   
   If mMonth = 2 And dy = 29 And (mYear Mod 400 = 0 Or _
                                 mYear Mod 4 = 0 And _
                                 mYear Mod 100 <> 0) Then
      ValidateDay = dy
      Exit Function
   End If
   
   ' An invalid day was passed to ValidateDay
   ' Set the day to a default value of 1
   ValidateDay = 1
End Function