Tutorial 7 - Using TDBCalendar with TDBDateX and TDBHolidayX

In this tutorial, you will learn how to use the calendar control can be used together with the TDBHolidayX object. The following sample will not allow a selection to be made on a holiday. In addition, all holidays for months displayed in the calendar will be retrieved.

Start a new project.
From the Visual Basic Project menu, select Components, then check the box labeled ComponentOne True DBCalendar 8.0. Click OK to add the TDBCalendar and control icon to the toolbox. Select References, then select labeled ComponentOne True DBDateX 8.0 and ComponentOne True DBHolidayX 8.0. Click OK to add the TDBDateX and TDBHolidayX objects.
Place a True DBCalendar control (tdbCalendar), a ListBox (lstDetail) and a ListBox (lstHoliday) on the form (Form1) as shown in the following figure.

We will be using code to setup the holiday style and weekends.

Example Title	Copy Code
' Declare a global HolidayX and DateX object. Dim HoliObj As New TDBHolidayX Dim DateObj As New TDBDateX Dim vArray As Variant ' Setup the weekends and holidays. Private Sub Form_Load() ' Turn off the drawing to avoid flickering. tdbCalendar.Redraw = False ' Single selectoin mode. tdbCalendar.MultiSelect = dbiMultiSelectNone ' Retrieve the last Monday in March, 1999. ncnt = DateObj.EnumWeekdays("1999/3/1", "1999/3/31", vArray, dbiMonday, dbiLastWeek) ' Setup the holiday style first. tdbCalendar.HolidayStyles.Add , "friends", "Friends Birthday" With tdbCalendar.HolidayStyles("friends") .Override = dbiOverrideNone ' White. .BackColor = RGB(255, 255, 255) ' Green. .ForeColor = RGB(0, 255, 0) If Not IsNull(ncnt) Or ncnt > 0 Then .Days.Add "TTQ", , vArray(0) End If .Days.Add "DC", , CDate("1999/2/18") .Days.Add "MB", , CDate("1999/3/16") .Days.Add "JS", , CDate("1999/4/3") .Days.Add "FC", , CDate("1999/3/21") .Days.Add "LB", , CDate("1999/5/16") .Days.Add "TZ", , CDate("1999/1/13") End With ' Setup the weekends next. ' Sunday. tdbCalendar.WeekRests(1) = -1 ' Saturday. tdbCalendar.WeekRests(7) = 1 Or 4 ' Setup attribute styles for Sunday and Saturday. tdbCalendar.AttribStyles.Add , "satattrb" With tdbCalendar.AttribStyles("satattrb") ' White. .BackColor = RGB(255, 255, 255) ' Blue. .ForeColor = RGB(0, 0, 255) End With tdbCalendar.AttribStyles.Add , "sunattrb" With tdbCalendar.AttribStyles("sunattrb") ' White. .BackColor = RGB(255, 255, 255) ' Red. .ForeColor = RGB(255, 0, 0) End With ' Apply the attribute styles to the Weekdays settings. With tdbCalendar.WeekDays(1) .Attribute = "sunattrib" .ReflectToTitle = dbiReflectForeColor End With With tdbCalendar.WeekDays(7) .Attribute = "satattrib" .ReflectToTitle = dbiReflectForeColor End With ' Use the holiday style (Friends Birthday). tdbCalendar.UseStyles = "friends" ' The HolidayX object needs to use the same setting as that of the controls. HoliObj.HolidayStyles.Add , "friends" Set HoliObj.HolidayStyles(1) = tdbCalendar.HolidayStyles("friends") ' Copy the weekend days settings. HoliObj.WeekRests(1) = tdbCalendar.WeekRests(1) HoliObj.WeekRests(7) = tdbCalendar.WeekRests(7) ' Use the same holiday styles as that of the controls. HoliObj.UseStyles = tdbCalendar.UseStyles tdbCalendar.Value = CDate("1999/2/1") ' Turn the drawing back on. tdbCalendar.Redraw = True End Sub

Example Title

Copy Code

' Declare a global HolidayX and DateX object.

Dim HoliObj As New TDBHolidayX

Dim DateObj As New TDBDateX

Dim vArray As Variant

 

' Setup the weekends and holidays.

Private Sub Form_Load()

 

    ' Turn off the drawing to avoid flickering.

    tdbCalendar.Redraw = False

 

    ' Single selectoin mode.

    tdbCalendar.MultiSelect = dbiMultiSelectNone

 

    ' Retrieve the last Monday in March, 1999.

    ncnt = DateObj.EnumWeekdays("1999/3/1", "1999/3/31", vArray, dbiMonday, dbiLastWeek)

   

    ' Setup the holiday style first.

    tdbCalendar.HolidayStyles.Add , "friends", "Friends Birthday"

    With tdbCalendar.HolidayStyles("friends")

        .Override = dbiOverrideNone

 

        ' White.

        .BackColor = RGB(255, 255, 255)

       

        ' Green.

        .ForeColor = RGB(0, 255, 0)    

        If Not IsNull(ncnt) Or ncnt > 0 Then

            .Days.Add "TTQ", , vArray(0)

        End If

        .Days.Add "DC", , CDate("1999/2/18")

        .Days.Add "MB", , CDate("1999/3/16")

        .Days.Add "JS", , CDate("1999/4/3")

        .Days.Add "FC", , CDate("1999/3/21")

        .Days.Add "LB", , CDate("1999/5/16")

        .Days.Add "TZ", , CDate("1999/1/13")

    End With

 

    ' Setup the weekends next.

    ' Sunday.

    tdbCalendar.WeekRests(1) = -1       

 

    ' Saturday.

    tdbCalendar.WeekRests(7) = 1 Or 4   

 

    ' Setup attribute styles for Sunday and Saturday.

    tdbCalendar.AttribStyles.Add , "satattrb"

    With tdbCalendar.AttribStyles("satattrb")

 

        ' White.

        .BackColor = RGB(255, 255, 255)

 

        ' Blue.

        .ForeColor = RGB(0, 0, 255)    

    End With

 

    tdbCalendar.AttribStyles.Add , "sunattrb"

    With tdbCalendar.AttribStyles("sunattrb")

 

        ' White.

        .BackColor = RGB(255, 255, 255)

 

        ' Red.

        .ForeColor = RGB(255, 0, 0)    

    End With

 

    ' Apply the attribute styles to the Weekdays settings.

    With tdbCalendar.WeekDays(1)

        .Attribute = "sunattrib"

        .ReflectToTitle = dbiReflectForeColor

    End With

 

    With tdbCalendar.WeekDays(7)

        .Attribute = "satattrib"

        .ReflectToTitle = dbiReflectForeColor

    End With

 

    ' Use the holiday style (Friends Birthday).

    tdbCalendar.UseStyles = "friends"

 

 

    ' The HolidayX object needs to use the same setting as that of the controls.

    HoliObj.HolidayStyles.Add , "friends"

    Set HoliObj.HolidayStyles(1) = tdbCalendar.HolidayStyles("friends")

 

    ' Copy the weekend days settings.

    HoliObj.WeekRests(1) = tdbCalendar.WeekRests(1)

    HoliObj.WeekRests(7) = tdbCalendar.WeekRests(7)

 

    ' Use the same holiday styles as that of the controls.

    HoliObj.UseStyles = tdbCalendar.UseStyles

    tdbCalendar.Value = CDate("1999/2/1")

 

    ' Turn the drawing back on.

    tdbCalendar.Redraw = True

End Sub

This code will obtain the information on the selected date and holidays in the displayed month.

Example Title	Copy Code
' Don't let the selector end on a holiday. Private Sub tdbCalendar_Change() ' Create an instance of the Day object. Dim DayObj As Variant ' Pass the date to the HolidayX object for processing. HoliObj.Value = tdbCalendar.Value ' Check if Date is a holiday. If HoliObj.ValueType And 1 Then ' Move to next workday. tdbCalendar.Value = HoliObj.AdjustDate(, 1) End If End Sub

Example Title

Copy Code

' Don't let the selector end on a holiday.

Private Sub tdbCalendar_Change()

 

    ' Create an instance of the Day object.

    Dim DayObj As Variant

 

    ' Pass the date to the HolidayX object for processing.

    HoliObj.Value = tdbCalendar.Value

 

    ' Check if Date is a holiday.

    If HoliObj.ValueType And 1 Then

 

       ' Move to next workday.

        tdbCalendar.Value = HoliObj.AdjustDate(, 1) 

    End If

End Sub

This code will account for the scrolling of the calendar.

Example Title	Copy Code
' Pickup the holidays for the months being displayed. Private Sub tdbCalendar_Scroll(StartDate As Date, EndDate As Date) ' Declare variables that will be used. Dim DateArray As Variant Dim DtRange As Integer ' Pickup all the holidays in the range. (Weekends will not be picked up). DtRange = HoliObj.DatesInRange(StartDate, EndDate, DateArray, 2) ' Clear the list and add contents into the list. lstHoliday.Clear lstHoliday.AddItem DtRange For I = 0 To DtRange - 1 lstHoliday.AddItem Format(DateArray(I), "dd/mmm/yyyy") Next I End Sub

Example Title

Copy Code

' Pickup the holidays for the months being displayed.

Private Sub tdbCalendar_Scroll(StartDate As Date, EndDate As Date)

 

    ' Declare variables that will be used.

    Dim DateArray As Variant

    Dim DtRange As Integer

   

    ' Pickup all the holidays in the range. (Weekends will not be picked up).

    DtRange = HoliObj.DatesInRange(StartDate, EndDate, DateArray, 2)

 

    ' Clear the list and add contents into the list.

    lstHoliday.Clear

    lstHoliday.AddItem DtRange

    For I = 0 To DtRange - 1

        lstHoliday.AddItem Format(DateArray(I), "dd/mmm/yyyy")

    Next I

End Sub

This code will obtain the information from the Holiday list.

Example Title	Copy Code
' Process the Click event of the lstHoliday listbox. Private Sub lstHoliday_Click() ' Declare variable used. Dim bln As Boolean Dim DteObj As Day ' First check to see if there are any holidays. If lstHoliday.ListCount <> 0 Then ' Pickup the Day object for holiday. bln = HoliObj.IsDateInStyle(CDate(lstHoliday.List(lstHoliday.ListIndex)), DteObj, dbiFirstMatch) ' Clear the lstDetail listbox. lstDetail.Clear ' Make sure the object existed. If bln = true ' Display detail information. lstDetail.AddItem "Name:" & DteObj.Name lstDetail.AddItem "Date:" & Format(DteObj.Date, "dd/mmm/yyyy") lstDetail.AddItem "Date2:" & Format(DteObj.Date2, "dd/mmm/yyyy") lstDetail.AddItem "Key:" & DteObj.Key End If End If End Sub

Example Title

Copy Code

' Process the Click event of the lstHoliday listbox.

Private Sub lstHoliday_Click()

 

    ' Declare variable used.

    Dim bln As Boolean

    Dim DteObj As Day

 

    ' First check to see if there are any holidays.

    If lstHoliday.ListCount <> 0 Then

 

        ' Pickup the Day object for holiday.

        bln = HoliObj.IsDateInStyle(CDate(lstHoliday.List(lstHoliday.ListIndex)), DteObj, dbiFirstMatch)

 

        ' Clear the lstDetail listbox.

        lstDetail.Clear

 

        ' Make sure the object existed.

        If bln = true

 

            ' Display detail information.

            lstDetail.AddItem "Name:" & DteObj.Name

            lstDetail.AddItem "Date:" & Format(DteObj.Date, "dd/mmm/yyyy")

            lstDetail.AddItem "Date2:" & Format(DteObj.Date2, "dd/mmm/yyyy")

            lstDetail.AddItem "Key:" & DteObj.Key

        End If

    End If

End Sub

Run the program and observe the following:

Click on a holiday date. Notice that you cannot set it to the holiday.
Notice that the holiday information for the displayed month(s) is shown in the lstHoliday.

This concludes Tutorial 7.