Option Explicit

' Create module global variables
Dim mgiCurrentMonth As Integer
Dim mgiCurrentYear As Integer
Dim mgiCurrentDay As Integer
Dim mgiStartMonth As Integer
Dim mgiStartDay As Integer
Dim mgiStartYear As Integer
Dim mgiStartDOW As Integer ' What day of the week does the 1st fall on
Dim mgiLastDOW As Integer  ' What is the last day of the week
Dim mgsDayNames(0 To 6) As String * 3   ' The names of the days. Change this for different languages
Dim mgsPickDate As String ' This is the global variable used to transfer the date in

Sub Calender_DblClick ()
Dim s As String

    If Calender.Text <> "" And Calender.CellSelected = True Then
        ' Put the date in a module global varible to be picked up elsewhere
        mgsPickDate = Calender.Text + "/" + Str$(mgiCurrentMonth) + "/" + Str$(mgiCurrentYear)
    End If

End Sub

Sub DoCalender (lsStartDate As Variant)
Dim lsStartString As String, liX As Integer, liY As Integer

    ' Find the first day of the week for the month
    mgiStartMonth = Month(lsStartDate)
    mgiCurrentMonth = mgiStartMonth
    mgiStartYear = Year(lsStartDate)
    mgiCurrentYear = mgiStartYear
    mgiCurrentDay = Day(lsStartDate)
    lsStartString = "1/" + Str$(mgiStartMonth) + "/" + Str$(mgiStartYear)
    mgiStartDOW = Weekday(Format$(lsStartString, "dd/mm/yyyy"))
    DateCaption.Caption = Format$(lsStartDate, "mmmm yyyy")
    
    On Error Resume Next
    For liX = 27 To 32
        lsStartString = Str$(liX) + "/" + Str$(mgiStartMonth) + "/" + Str$(mgiStartYear)
        liY = Weekday(Format$(lsStartString, "dd/mm/yyyy"))
        If Err <> 0 Then
            Err = 0
            Exit For
        End If
    Next liX
    mgiLastDOW = liX - 1

    ' Clear out the calender to remove any previous data
    For liX = 0 To 6
        For liY = 1 To 6
            Calender.Col = liX
            Calender.Row = liY
            Calender.Text = ""
        Next liY
    Next liX

    ' Now fill in the dates
    Calender.Col = mgiStartDOW - 1 ' Weekdays go 1 to 7, cols go 0 to 6
    Calender.Row = 1
    For liX = 1 To mgiLastDOW
        Calender.Text = liX
        liY = Calender.Col + 1
        If liY = 7 Then
            Calender.Col = 0
            Calender.Row = Calender.Row + 1
        Else
            Calender.Col = Calender.Col + 1
        End If
    Next liX


End Sub

Sub Form_Load ()
Dim liX As Integer

    mgsDayNames(0) = "Sun"
    mgsDayNames(1) = "Mon"
    mgsDayNames(2) = "Tue"
    mgsDayNames(3) = "Wed"
    mgsDayNames(4) = "Thu"
    mgsDayNames(5) = "Fri"
    mgsDayNames(6) = "Sat"

    ' Set up the calender days
    Calender.Row = 0
    For liX = 0 To 6
        Calender.Col = liX
        Calender.ColAlignment(liX) = 2
        Calender.Text = mgsDayNames(liX)
    Next liX

End Sub

Sub GetDate_Click ()
    
    GetDate.Enabled = False
    CalenderForm.Visible = True
    mgsPickDate = ""   ' For this demonstration we just test for the date string being there
    DoCalender Now
    Do While mgsPickDate = ""
        DoEvents
    Loop
    CalenderForm.Visible = False
    DateField.Caption = Format$(mgsPickDate, "dd-mmm-yyyy") ' Display the date
    GetDate.Enabled = True

End Sub

Sub Next_Click ()
Dim ls As String

    mgiCurrentMonth = mgiCurrentMonth + 1
    If mgiCurrentMonth = 13 Then
        mgiCurrentMonth = 1
        mgiCurrentYear = mgiCurrentYear + 1
    End If
    ls = Str$(mgiCurrentDay) + "/" + Str$(mgiCurrentMonth) + "/" + Str$(mgiCurrentYear)
    DoCalender ls

End Sub

Sub Previous_Click ()
Dim ls As String

    mgiCurrentMonth = mgiCurrentMonth - 1
    If mgiCurrentMonth = 0 Then
        mgiCurrentMonth = 12
        mgiCurrentYear = mgiCurrentYear - 1
    End If
    ls = Str$(mgiCurrentDay) + "/" + Str$(mgiCurrentMonth) + "/" + Str$(mgiCurrentYear)
    DoCalender ls
End Sub