with: Erik Oosterwal

Search for specific programs or algorithms:

Custom Search

Calendar Creator

This code isn't so much an algorithm as it is a groups of algorithms used together. The first algorithm is a bit of code to find the day of the week for January 1 for any given year. There's probably a formula out there somewhere to do it in one clean step, but this code assigns the starting day for the year 1600, then runs through each year between 1600 and the year you're looking for and adds 1 more to the day of the week for most years and adds two more for leap years.

Within that algorithm there's the simple algorithm for determining whether or not a given year is a leap year in the Gregorian calendar or not. There are roughly 365.2422 days in a year, so for most years we call it 365 days. However, you can see that every four years we get an extra .9688 day (.2422 x 4) so we throw in an extra day in February and call that year a leap year. This means that we're actually counting slightly less than the real time it takes for Earth to go around the sun (1 - .9688 = .0312) so every 25 leap years (100 regular years) we skip adding that extra day to February. Of course this leaves us a bit off again so every 400 years we don't skip adding that extra day to February. (If you think that was hard to understand when reading, you should of been around when I was trying to write that.) Suffice it to say that the basic idea is that any year that's evenly divisible by 4 is a leap year, EXCEPT those that are evenly divisible by 100, UNLESS that year is also evenly divisible by 400. That still leaves us a bit off but the people who get paid to track where Earth is in respect to the sun and the rest of the galaxy call up Dick Clark and tell him to count an extra second on December 31 (called a leap second) so we get to watch the big lighted apple drop down in Times Square and yell "Three... Two... One... One... HAPPY NEW YEAR!!!"

The last bit of algorithm in this code is for formatting the output of the calendar. We have to keep track of the day within the week to make sure we don't print more than 7 days in one week otherwise we have to pay royalties to Michael Jackson for printing Eight Days a Week, and we don't want to get started down THAT road.

The program I 'borrowed' this nifty bit of code from came from a book called More Basic Computer Games that had a collection of printouts of progams from the Creative Computing guys. This bit was part of a larger program that printed Pascal triangles in nifty ways. You can see the bit of code here starting with line number 3260.

So with no further ado, here's the code. I'll add a zip file with the whole Visual Basic program and an executable later.

'   Orginal Author:     Charles H. Lund
'   Modified by:        Erik Oosterwal
'   Completed on:       November 8, 2006
'
'   This program was converted from a listing in an old Basic book from the 1980s.
'
'   Heavy modification was done to convert it to MS Visual Basic, since VB is closer to a truly
'   structured language than the old versions of Basic were.  You won't find any GOTOs in this
'   listing and there are some OOP constructs in there, such as the Text property and references
'   to the Form.  Also, the normal method of using chr(10) and chr(13) to create a carriage
'   return and linefeed are replaced by the Visual Basic constant vbNewLine.  The original
'   program listing simply used separate PRINT statements to get the same results.
'
'   There is no error checking in this program to make sure the selected year is correct.  Feel
'   free to look around on the internet for more information about when the Julian calendar was
'   changed to the Gregorian calendar (which is what this prints out.)  Dates earlier than somewhere
'   in the mid 1500's will be wrong, since most dates from before then used the Julian calendar.
'   Also, this program does not verify the stuff entered in the input field on the VB form to make
'   sure it's even a number, so the results could be screwed up.  Any year entered that's smaller
'   than 1600 will definately be screwed up.
'
'   The output from this program prints all 12 months in a single column.  Most computer screens
'   and printers could easily fit 2 or 3 columns across. You can modify this program by using c1,
'   c2, c3 instead of c to keep track of the day of the week depending on how many columns you want,
'   with each c1, c2, c3 being used for the months in that column.  You only have to do the yearly
'   calculations on the first column, then add the number of days between the start of one column
'   and the next column to get c2, or c3.  You'd also have to modify the headers and when you insert
'   a new line.
'

    Dim c, j, intYear, intMonth, intDay As Integer
    Dim intMonthDays(12) As Integer
    Dim txtMonthName(12), txtOutputString As String
    
    txtMonthName(1) = "January"             ' \
    txtMonthName(2) = "February"            '  |
    txtMonthName(3) = "March"               '  | Initialize all
    txtMonthName(4) = "April"               '  | the names of the
    txtMonthName(5) = "May"                 '  | months.
    txtMonthName(6) = "June"                '  |
    txtMonthName(7) = "July"                '  |
    txtMonthName(8) = "August"              '  |
    txtMonthName(9) = "September"           '  |
    txtMonthName(10) = "October"            '  |
    txtMonthName(11) = "November"           '  |
    txtMonthName(12) = "December"           ' /
    
    intMonthDays(1) = 31                    ' \
    intMonthDays(2) = 28                    '  |
    intMonthDays(3) = 31                    '  | Initialize all
    intMonthDays(4) = 30                    '  | the months with
    intMonthDays(5) = 31                    '  | the number of
    intMonthDays(6) = 30                    '  | days in that month.
    intMonthDays(7) = 31                    '  | February is initialized
    intMonthDays(8) = 31                    '  | with 28, but changed
    intMonthDays(9) = 30                    '  | later if the selected
    intMonthDays(10) = 31                   '  | year is a leap year.
    intMonthDays(11) = 30                   '  |
    intMonthDays(12) = 31                   ' /
        
    c = 6                                   ' Set the intial starting day
    intYear = Val(Text2.Text)               ' Get the desired year from the form
    
    For j = 1600 To intYear - 1 Step 1      ' Check every year between 1600 and the desired year and increase the starting day number
        c = c + 1                           ' Regular years need 1 added to the starting day fo the week
        
        If j Mod 400 = 0 Or (j Mod 4 = 0 And j Mod 100 <> 0) Then c = c + 1     ' If it's a leap year, add an extra day.
    Next j

    If intYear Mod 400 = 0 Or (intYear Mod 4 = 0 And intYear Mod 100 <> 0) Then intMonthDays(2) = 29  ' If it's a leap year, add an extra day to February.

    c = c Mod 7                             ' We've got a number that's larger than the number of days in the week, find the remainder (MOD)
    
    txtOutputString = ""                    ' Clear the output string
    
    For intMonth = 1 To 12                  ' Let's loop through each month
    
' Print the header for the month.  This part of the program can be altered depending on the language
'   the routine is written in and the formatting tools available.  This could very easily be
'   re-written in java script or php to use HTML tables, which would make the formatting very
'   easy and look extremely nice.
        txtOutputString = txtOutputString & "                 " & txtMonthName(intMonth) & " " & intYear & vbNewLine
        txtOutputString = txtOutputString & "+---------------------------------------+" & vbNewLine
        txtOutputString = txtOutputString & "|SUN   MON   TUE   WED   THU   FRI   SAT|" & vbNewLine
        txtOutputString = txtOutputString & "+---------------------------------------+" & vbNewLine
        
        txtOutputString = txtOutputString & Space(6 * c + 3)        ' The very first day of the month must be indented appropriately
        
        For intDay = 1 To intMonthDays(intMonth)                    ' Check each day in the month.
            txtOutputString = txtOutputString & intDay              ' Append the day number to the output string.
            c = c + 1                                               ' Increase the day of the week by 1
            
            If intDay < 9 Then                                      ' If the current month day number is less than 9
                txtOutputString = txtOutputString & "     "         '   move over an extra space before printing the next day number
            Else
                txtOutputString = txtOutputString & "    "          ' Two digit days need one less space between them to be formatted correctly
            End If
            
            If c = 7 Then                                           ' We've reached Saturday...
                txtOutputString = txtOutputString & vbNewLine       '   insert a new line
                c = 0                                               '   reset the day fo the week to 0
                
                If intDay < 9 Then                                  ' If it's a single digit day number
                    txtOutputString = txtOutputString & "   "       '   move over an extra space
                Else
                    txtOutputString = txtOutputString & "  "        ' Two digit days only need 2 spaces at the beginning of the new line.
                End If
            
            End If
            
        Next intDay
        
' Print a nice closing line at the bottom of the month that matches the stuff around the header.
        txtOutputString = txtOutputString & vbNewLine & "+---------------------------------------+" & vbNewLine & vbNewLine & vbNewLine
                
    Next intMonth
        
    Text1.Text = txtOutputString            ' Send the output string to the specified field on the VB input form.

The resulting printout looks like this:

                 January 2006
+---------------------------------------+
|SUN   MON   TUE   WED   THU   FRI   SAT|
+---------------------------------------+
   1     2     3     4     5     6     7     
   8     9    10    11    12    13    14    
  15    16    17    18    19    20    21    
  22    23    24    25    26    27    28    
  29    30    31    
+---------------------------------------+


                 February 2006
+---------------------------------------+
|SUN   MON   TUE   WED   THU   FRI   SAT|
+---------------------------------------+
                     1     2     3     4     
   5     6     7     8     9    10    11    
  12    13    14    15    16    17    18    
  19    20    21    22    23    24    25    
  26    27    28    
+---------------------------------------+


                 March 2006
+---------------------------------------+
|SUN   MON   TUE   WED   THU   FRI   SAT|
+---------------------------------------+
                     1     2     3     4     
   5     6     7     8     9    10    11    
  12    13    14    15    16    17    18    
  19    20    21    22    23    24    25    
  26    27    28    29    30    31    
+---------------------------------------+


                 April 2006
+---------------------------------------+
|SUN   MON   TUE   WED   THU   FRI   SAT|
+---------------------------------------+
                                       1     
   2     3     4     5     6     7     8     
   9    10    11    12    13    14    15    
  16    17    18    19    20    21    22    
  23    24    25    26    27    28    29    
  30    
+---------------------------------------+


                 May 2006
+---------------------------------------+
|SUN   MON   TUE   WED   THU   FRI   SAT|
+---------------------------------------+
         1     2     3     4     5     6     
   7     8     9    10    11    12    13    
  14    15    16    17    18    19    20    
  21    22    23    24    25    26    27    
  28    29    30    31    
+---------------------------------------+


                 June 2006
+---------------------------------------+
|SUN   MON   TUE   WED   THU   FRI   SAT|
+---------------------------------------+
                           1     2     3     
   4     5     6     7     8     9    10    
  11    12    13    14    15    16    17    
  18    19    20    21    22    23    24    
  25    26    27    28    29    30    
+---------------------------------------+


                 July 2006
+---------------------------------------+
|SUN   MON   TUE   WED   THU   FRI   SAT|
+---------------------------------------+
                                       1     
   2     3     4     5     6     7     8     
   9    10    11    12    13    14    15    
  16    17    18    19    20    21    22    
  23    24    25    26    27    28    29    
  30    31    
+---------------------------------------+


                 August 2006
+---------------------------------------+
|SUN   MON   TUE   WED   THU   FRI   SAT|
+---------------------------------------+
               1     2     3     4     5     
   6     7     8     9    10    11    12    
  13    14    15    16    17    18    19    
  20    21    22    23    24    25    26    
  27    28    29    30    31    
+---------------------------------------+


                 September 2006
+---------------------------------------+
|SUN   MON   TUE   WED   THU   FRI   SAT|
+---------------------------------------+
                                 1     2     
   3     4     5     6     7     8     9    
  10    11    12    13    14    15    16    
  17    18    19    20    21    22    23    
  24    25    26    27    28    29    30    
  
+---------------------------------------+


                 October 2006
+---------------------------------------+
|SUN   MON   TUE   WED   THU   FRI   SAT|
+---------------------------------------+
   1     2     3     4     5     6     7     
   8     9    10    11    12    13    14    
  15    16    17    18    19    20    21    
  22    23    24    25    26    27    28    
  29    30    31    
+---------------------------------------+


                 November 2006
+---------------------------------------+
|SUN   MON   TUE   WED   THU   FRI   SAT|
+---------------------------------------+
                     1     2     3     4     
   5     6     7     8     9    10    11    
  12    13    14    15    16    17    18    
  19    20    21    22    23    24    25    
  26    27    28    29    30    
+---------------------------------------+


                 December 2006
+---------------------------------------+
|SUN   MON   TUE   WED   THU   FRI   SAT|
+---------------------------------------+
                                 1     2     
   3     4     5     6     7     8     9    
  10    11    12    13    14    15    16    
  17    18    19    20    21    22    23    
  24    25    26    27    28    29    30    
  31    
+---------------------------------------+

Discuss computer algorithms and other computer science topics at the Computer Algorithms blog page.

Computer Science 101

Dressing for Success

Calendar Creator

All code and original algorithms are © Erik Oosterwal - 1987-2008