Public Property Let BackColor(lBackColor As Long)

Allows the setting of the background color for the calendar. The standard colors such as vbWhite, vbRed, etc can be used. Thr RGB function can also be used here.

Public Property Get FontName() As String
Public Property Let FontName(sFontName As String)

The name of the font to use when drawing the numbers and text in the calendar.

Public Property Let FontSize(lFontSize As Long)
Public Property Get FontSize() As Long

The size of the font to use when drawing the numbers and the text in the calendar.

Public Property Let Month(lMonth As Long)
Public Property Get Month() As Long

The number of the month to show. It should be in the range of 1 for January and 12 for December.

Public Property Let Year(lYear As Long)
Public Property Get Year() As Long

Public Sub RedrawCalendar()

Forces the calendar to be redrawn. In general this should not need to be called. It will be called automatically when properties change that would affect the calendar (such as changing the month).

Public Sub NextMonth()

Changes the calendar to show the next month.

Public Sub PreviousMonth()

This sample shows how to use the calendar control. There really is nothing more to do than to drop the calendar control on a form and set the properties appropriately. This example assumes the calendar control is called oCal.

    oCal.Month = 9
    oCal.Year = 2000
    ' will force the calendar to display the calendar for September 2000.

If you have any questions, email us at help@codeoftheweek.com

'----------------------------------------------------------------------
'
'   Module Name:    ucCalendar
'   Written By:     C&D Programming Corp.
'   Create Date:    6/2000
'   Copyright:      Copyright 2000 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'
'----------------------------------------------------------------------

Option Explicit

Private mlMonth As Long ' local variable to store the displayed month
Private mlYear As Long  ' local variable to store the displayed year

Public Property Let BackColor(lBackColor As Long)
    UserControl.BackColor = lBackColor
    RedrawCalendar
End Property

Public Property Let FontName(sFontName As String)
    On Error Resume Next
    UserControl.FontName = sFontName
    RedrawCalendar
End Property

Public Property Get FontName() As String
    FontName = UserControl.FontName
End Property

Public Property Let FontSize(lFontSize As Long)
    UserControl.FontSize = lFontSize
    RedrawCalendar
End Property

Public Property Get FontSize() As Long
    FontSize = UserControl.FontSize
End Property

Public Property Let Month(lMonth As Long)
    mlMonth = lMonth
    RedrawCalendar
End Property

Public Property Get Month() As Long
    Month = mlMonth
End Property

Public Property Let Year(lYear As Long)
    mlYear = lYear
    RedrawCalendar
End Property

Public Property Get Year() As Long
    Year = mlYear
End Property

Public Sub NextMonth()
    ' calculate the next month to display based on the current settings
    If Month = 12 Then
        Month = 1
        Year = Year + 1
    Else
        Month = Month + 1
    End If
End Sub

Public Sub PreviousMonth()
    ' calculate the previous month to display based on the current settings
    If Month = 1 Then
        Month = 12
        Year = Year - 1
    Else
        Month = Month - 1
    End If
End Sub

' calculate the number of days in each month
Private Property Get NumberOfDays() As Long
    Select Case Me.Month
        Case 1, 3, 5, 7, 8, 10, 12
            NumberOfDays = 31
        Case 4, 6, 9, 11
            NumberOfDays = 30
        Case 2
            ' trick to determine leap years.  Take March 1 of the currently
            ' shown year and subtract 1 to determine the last day in
            ' February.
            NumberOfDays = Day(CDate("3/1/" & Me.Year) - 1)
    End Select
End Property

Private Sub UserControl_Initialize()
    ' setup the defaults
    Month = VBA.Month(Now)
    Year = VBA.Year(Now)
    FontName = "Arial"
    FontSize = 8
    BackColor = vbWhite
End Sub

Private Sub UserControl_Paint()
    RedrawCalendar
End Sub

Public Sub RedrawCalendar()
    Dim lWidth As Long
    Dim lHeight As Long
    Dim x As Long
    Dim lDayCount As Long   ' number of days in a week
    Dim lWeekCount As Long  ' number of weeks to show in the grid
    Dim lDayNum As Long     ' counter variable to loop through the days
    Dim lCellWidth As Long  ' width of a day cell
    Dim lCellHeight As Long ' height of a day cell
    Dim lStartDay As Long   ' weekday to start the month with
    Dim lColumn As Long     ' which column we are currently in when
                            ' drawing the days
    Dim lRow As Long        ' the row
    Dim lDayWidth As Long   ' width of the day text
    Dim sDay As String      ' name of the weekday (such as Mon, Tue)
    Dim sMonth As String    ' name of the month.

    ' perform some initial calculations to determine various
    ' heights and widths of the cells.
    lWidth = UserControl.ScaleWidth
    lHeight = UserControl.ScaleHeight
    lDayCount = 7
    lWeekCount = 7
    lCellWidth = lWidth / lDayCount
    lCellHeight = lHeight / lWeekCount

    ' clear calendar
    Line (UserControl.ScaleLeft, UserControl.ScaleTop)-(lWidth - 10, lHeight - 10), vbWhite, BF

    ' draw day separators.  We use lCellHeight because we do not need to
    ' draw the lines into the top portion of the first row (where the month
    ' and names of the days go).
    For x = 1 To lDayCount - 1
        Line (x * (lWidth / lDayCount), lCellHeight)-(x * (lWidth / lDayCount), lHeight), , BF
    Next

    ' draw week separators - do not draw into the first row
    For x = 2 To lWeekCount - 1
        Line (0, x * (lHeight / lWeekCount))-(lWidth, x * (lHeight / lWeekCount)), , BF
    Next

    ' fill in day numbers
    lStartDay = WeekDay(CDate(Me.Month & "/1/" & Me.Year))
    lColumn = lStartDay - 1
    lRow = 1
    For lDayNum = 1 To NumberOfDays
        ' put numbers in the upper left of each cell.
        ' we can use centering logic here as shown below for each day
        UserControl.CurrentX = lColumn * lCellWidth
        UserControl.CurrentY = lRow * lCellHeight
        UserControl.Print lDayNum;
        lColumn = lColumn + 1
        ' if we hit the last column, wrap back around to the
        ' first column.
        If lColumn >= lDayCount Then
            lColumn = 0
            lRow = lRow + 1
        End If
    Next

    ' fill in day headings
    Line (UserControl.ScaleLeft, UserControl.ScaleTop)-(lCellWidth * lDayCount, lCellHeight), vbButtonFace, BF
    Line (UserControl.ScaleLeft, UserControl.ScaleTop)-(lCellWidth * lDayCount, lCellHeight), , B

    ' draw month centered using the language that the format command returns.
    UserControl.CurrentY = 0
    sMonth = Format$(CDate(CDate(Month & "/1/" & Year)), "mmmm yyyy")
    UserControl.CurrentX = (UserControl.ScaleWidth - UserControl.TextWidth(sMonth)) / 2
    UserControl.Print sMonth;

    ' fill in the names of the days along the top of the grid
    For lDayNum = 0 To 6
        ' names go on the bottom half of the first row.
        UserControl.CurrentY = lCellHeight / 2
        ' we use 7/2/2000 because we know this is a sunday.  This will
        ' allow us to have a language independent calendar
        sDay = Format$(CDate(CDate("7/2/2000") + lDayNum), "ddd")
        lDayWidth = UserControl.TextWidth(sDay)
        Debug.Print sDay, lDayWidth
        ' This allows us to center the day names within each day.
        UserControl.CurrentX = lDayNum * lCellWidth + ((lCellWidth - lDayWidth) / 2)
        UserControl.Print sDay;
    Next

    ' draw border around entire calendar
    Line (ScaleLeft, ScaleTop)-(lWidth - 10, lHeight - 10), , B
End Sub