MonthView Control - Can I Highlight Multiple Non-Contiguous Dates With a Gray Oval?

I am using the MonthView control in a VB6 project. If I click a date, a gray oval appears behind the date number. If I click a different date, the gray oval behind the previous clicked date will disappear. I don't believe you can select multiple, non-contiguous dates (although you can select a range). I want the user to be able to click multiple non-contiguous dates, with each showing the gray oval. And if they click one of those dates a second time the gray oval would disappear. Can this be accomplished? Is there any way to draw or remove the gray ovals, regardless of the user's clicking? My goal is to save the dates that have been clicked in a file. The next time the user runs the program, it would read the file and draw the gray oval over the previously clicked dates.
Thank you.

The control doesn't support that feature, you could create your own form with a calendar and write code to do exactly what you need.
I searched in the Code Base forum, there isn't anything I saw there but maybe this is a starting point https://www.vbforums.com/showthread....rol-using-code

EDIT:
This is a super simple example of a way to do this with just code:

Code:

---

Option Explicit
' ********  need Microsoft Scripting reference *********
Public selectedDates As Dictionary ' hold the selected dates
Dim formIsLoading As Boolean
Const selectedDayHighlight = &HFFFF&
Const deselectedDayBackground = &H8000000F

Private Sub drpMonth_Click()
    ' user selected a month to view
    If Not formIsLoading Then FillCalendar drpMonth.ListIndex + 1, CInt(drpYear.Text)
End Sub

Private Sub drpYear_Click()
    ' user selected a year to view
    If Not formIsLoading Then FillCalendar drpMonth.ListIndex + 1, CInt(drpYear.Text)
End Sub

Private Sub Form_Load()
    Dim x As Integer
   
    formIsLoading = True
   
    FillMonthNames
    FillYears
   
    ' highlight the current month in the dropdown
    For x = 0 To drpMonth.ListCount - 1
      If drpMonth.List(x) = Format(Now, "MMM") Then
            drpMonth.ListIndex = x
            Exit For
      End If
    Next x
   
    ' highlight the current year in the dropdown
    For x = 0 To drpYear.ListCount - 1
      If drpYear.List(x) = CStr(Year(Now)) Then
            drpYear.ListIndex = x
            Exit For
      End If
    Next x
   
    ' fill the calendar with current month / year days
    FillCalendar Month(Now), Year(Now)
   
    DoEvents
       
    Set selectedDates = New Dictionary
    formIsLoading = False
End Sub

Private Sub lblDay_Click(Index As Integer)
   
    Dim fullDate As String
   
    fullDate = drpMonth.ListIndex + 1 & "/" & lblDay(Index).Caption & "/" & drpYear.Text
   
    ' toggle the background to indicate a date is selected
    If lblDay(Index).BackColor = &H8000000F Then
        ' show selected add to list of dates (yellow)
        lblDay(Index).BackColor = selectedDayHighlight
        selectedDates.Add fullDate, fullDate
    Else
        ' deselect the date and remove from list of dates
        lblDay(Index).BackColor = deselectedDayBackground
        selectedDates.Remove fullDate
    End If
   
End Sub

Sub FillMonthNames()
    drpMonth.Clear
    drpMonth.AddItem "Jan"
    drpMonth.AddItem "Feb"
    drpMonth.AddItem "Mar"
    drpMonth.AddItem "Apr"
    drpMonth.AddItem "May"
    drpMonth.AddItem "Jun"
    drpMonth.AddItem "Jul"
    drpMonth.AddItem "Aug"
    drpMonth.AddItem "Sep"
    drpMonth.AddItem "Oct"
    drpMonth.AddItem "Nov"
    drpMonth.AddItem "Dec"
End Sub

Sub FillYears()
    Dim yr As Integer
   
    drpYear.Clear
    For yr = Year(Now) - 1 To Year(Now) + 5
        drpYear.AddItem yr
    Next yr
   
End Sub

Sub FillCalendar(forMonth As Integer, forYear As Integer)
    ' fill up the day labels with the days
   
    Dim firstDayOfMonth As Date
    Dim firstDayName As String
    Dim startingDayLabelIndex As Integer
    Dim nextMonthNumber As Integer
    Dim numberOfDaysInTheMonth As Integer
    Dim labelIndex As Integer
    Dim dayNumber As Integer
    Dim fullDate As String
   
    ' what day name is the first day of the month
    firstDayOfMonth = CDate(CStr(forMonth) & "/1/" & CStr(forYear))
    firstDayName = Format(firstDayOfMonth, "ddd")
   
    Select Case firstDayName
        Case "Sun"
            startingDayLabelIndex = 0
        Case "Mon"
            startingDayLabelIndex = 1
        Case "Tue"
            startingDayLabelIndex = 2
        Case "Wed"
            startingDayLabelIndex = 3
        Case "Thu"
            startingDayLabelIndex = 4
        Case "Fri"
            startingDayLabelIndex = 5
        Case "Sat"
            startingDayLabelIndex = 6
    End Select
   
    nextMonthNumber = IIf(forMonth = 12, 1, forMonth + 1)
   
    numberOfDaysInTheMonth = Format((CDate(CStr(nextMonthNumber) & "/1/" & CStr(forYear)) - 1), "dd")
   
    ' fill in the labels
    labelIndex = 0
    dayNumber = 1
    Do While labelIndex < 35 ' number of labels for dates
       
        ' reset the background when building the calendar
        lblDay(labelIndex).BackColor = deselectedDayBackground
       
        If labelIndex < startingDayLabelIndex Then
            ' blank out first week days not needed
            lblDay(labelIndex).Caption = ""
           
        ElseIf dayNumber <= numberOfDaysInTheMonth Then
            ' fill the label with the date
            lblDay(labelIndex).Caption = dayNumber
           
            If Not formIsLoading Then
                ' has the date been previously selected, if so color the background to
                ' indicate that it has
                fullDate = drpMonth.ListIndex + 1 & "/" & CStr(dayNumber) & "/" & drpYear.Text
                If selectedDates.Exists(fullDate) Then lblDay(labelIndex).BackColor = selectedDayHighlight
            End If
           
            dayNumber = dayNumber + 1
           
        Else
            ' blank out end of the calendar days not needed
            lblDay(labelIndex).Caption = ""
        End If
       
        labelIndex = labelIndex + 1
    Loop
   
   
End Sub

---

the project / form is attached, I'm sure there are way more clever ways to get this done of course but if you don't want to create your own control.

edit2: I should add that you get the list of selected dates from the dictionary of the same name

Hi jdelano,

I'm sorry for not replying sooner. The email notification I was sent went to my Promotions tab in Gmail and I only noticed it a short while ago.

I like what you sent! It does just what I want. I will look at your code, as well as the code in the thread you sent a link to, to get a better understanding of how it works.

I didn't mention this is my question, but I would actually like to display 4 months at a time, each side by side. I'll look at the .frm file to see how it might be done.
If you have any thoughts it would be greatly appreciated.

Thanks so much!

You're welcome, happy to help.

I'd copy the day labels as they are already in an array to the new sections for the other months, the current click event will be used for them as well.
Modify the first fill of the calendar, so it fills each of the calendars on the form; llbDay(0) - lblDay(34) is month one. lnlDay(35) - lblDay(69) is month two and so on.
I'd use the Tag property of the day label to hold the full date and add that to the selected dates dictionary.

Will you allow the user to change the 4 months that are displayed?


EDIT: see if this gives you what you're looking for ... you'll need to format things the way you want them

Code:

---

Option Explicit
' ********  need Microsoft Scripting reference *********
Public selectedDates As Dictionary ' hold the selected dates

Dim formIsLoading As Boolean
Dim fourMonths(1 To 4) As Date

Const selectedDayBackground = &HFFFF&
Const deselectedDayBackground = &H8000000F

Private Sub btnNextFourMonths_Click()
   
    'increment the displayed calendars
    DisplayFourMonths "Next"
   
    btnPrevFourMonths.Enabled = True ' allow this button to be clicked
End Sub

Private Sub btnPrevFourMonths_Click()
    'decrement the displayed calendars
    DisplayFourMonths "Prev"
   
    ' disable the prev button if the first month displayed is the same as the current month
    btnPrevFourMonths.Enabled = Not (Month(Now) = Month(fourMonths(1)))
   
End Sub

Private Sub DisplayFourMonths(Direction As String)

    ' calc the inital 4 months to display
    Dim monthNumber As Integer
       
    If fourMonths(1) = "12:00:00 AM" Or Direction = "Prev" Then
        ' nothing is displayed yet start with the current month
       
        If Direction = "Prev" Then
            ' the prev button was clicked, go back 4 months
            fourMonths(1) = DateAdd("m", -4, fourMonths(1))
        Else
            fourMonths(1) = CDate(Month(Now) & "/1/" & Year(Now))
        End If
       
    Else
        ' user has selected to move the to next set of 4 months
        fourMonths(1) = DateAdd("m", 4, fourMonths(1))
    End If
   
    fourMonths(2) = DateAdd("m", 1, fourMonths(1))
    fourMonths(3) = DateAdd("m", 1, fourMonths(2))
    fourMonths(4) = DateAdd("m", 1, fourMonths(3))
   
    ' fill the calendars with the 4 months
    For monthNumber = 1 To 4
        FillCalendar monthNumber, fourMonths(monthNumber)
    Next monthNumber
   
    DoEvents

End Sub

Private Sub Form_Load()
   
    formIsLoading = True
   
    DisplayFourMonths "Next"
       
    Set selectedDates = New Dictionary
    formIsLoading = False
   
End Sub

Private Sub lblDay_Click(Index As Integer)
   
    ' toggle the background to indicate a date is selected
    If lblDay(Index).BackColor = deselectedDayBackground Then
        ' show selected add to list of dates (yellow)
        lblDay(Index).BackColor = selectedDayBackground
        selectedDates.Add lblDay(Index).Tag, lblDay(Index).Tag
    Else
        ' deselect the date and remove from list of dates
        lblDay(Index).BackColor = deselectedDayBackground
        selectedDates.Remove lblDay(Index).Tag
    End If
   
End Sub

Sub FillCalendar(monthNo As Integer, firstDayOfMonth As Date)
    ' fill up the day labels with the days
   
    Dim firstDayName As String
    Dim startingDayLabelIndex As Integer
    Dim endingDayLabelIndex As Integer
   
    Dim numberOfDaysInTheMonth As Integer
    Dim labelIndex As Integer
    Dim dayNumber As Integer
    Dim fullDate As String
   
    ' what day name is the first day of the month
    firstDayName = Format(firstDayOfMonth, "ddd")
   
    Select Case firstDayName
        Case "Sun"
            startingDayLabelIndex = 0
        Case "Mon"
            startingDayLabelIndex = 1
        Case "Tue"
            startingDayLabelIndex = 2
        Case "Wed"
            startingDayLabelIndex = 3
        Case "Thu"
            startingDayLabelIndex = 4
        Case "Fri"
            startingDayLabelIndex = 5
        Case "Sat"
            startingDayLabelIndex = 6
    End Select
   
    numberOfDaysInTheMonth = Format(DateAdd("m", 1, firstDayOfMonth) - 1, "dd")
   
    ' set month header
    lblMonthYear(monthNo - 1).Caption = Format(firstDayOfMonth, "MMM YYYY")
   
    ' fill in the labels
    Select Case monthNo
        Case 1
            labelIndex = 0
        Case 2
            labelIndex = 35
        Case 3
            labelIndex = 70
        Case 4
            labelIndex = 105
    End Select
   
    ' depending on which month is being filled in change where the starting day index will be
    startingDayLabelIndex = startingDayLabelIndex + labelIndex
    endingDayLabelIndex = labelIndex + 35
   
    dayNumber = 1
    Do While labelIndex < endingDayLabelIndex ' number of labels for dates in a month
       
        ' reset the background when building the calendar
        lblDay(labelIndex).BackColor = deselectedDayBackground
       
        If labelIndex < startingDayLabelIndex Then
            ' blank out first week days not needed
            lblDay(labelIndex).Caption = ""
           
        ElseIf dayNumber <= numberOfDaysInTheMonth Then
            ' fill the label with the date
            lblDay(labelIndex).Caption = dayNumber
           
            fullDate = Month(firstDayOfMonth) & "/" & CStr(dayNumber) & "/" & Year(firstDayOfMonth)
            lblDay(labelIndex).Tag = fullDate
           
            If Not formIsLoading Then
                ' has the date been previously selected, if so color the background to
                ' indicate that it has
                If selectedDates.Exists(lblDay(labelIndex).Tag) Then
                    lblDay(labelIndex).BackColor = selectedDayBackground
                End If
            End If
           
            dayNumber = dayNumber + 1
           
        Else
            ' blank out end of the calendar days not needed
            lblDay(labelIndex).Caption = ""
        End If
       
        labelIndex = labelIndex + 1
    Loop
   
   
End Sub

---

Hi jdelano,

That is fabulous! I can't tell you how much work that saved me. I won't need the ability for the user to change the 4 months. It will always contain the current month, the two prior months, and next month.
This is so much better than working with MonthView and trying to understand its quirks. Thanks again!!

Sincerely, Curtis

You're welcome, happy to lend a hand.