' version 23-06-2015 ' compile with: fbc -s console Function wd(m As Integer, d As Integer, y As Integer) As Integer ' Zellerish ' 0 = Sunday, 1 = Monday, 2 = Tuesday, 3 = Wednesday ' 4 = Thursday, 5 = Friday, 6 = Saturday If m < 3 Then ' If m = 1 Or m = 2 Then m += 12 y -= 1 End If Return (y + (y \ 4) - (y \ 100) + (y \ 400) + d + ((153 * m + 8) \ 5)) Mod 7 End Function ' ------=< MAIN >=------ ' only months with 31 day can have five weekends ' these months are: January, March, May, July, August, October, December ' in nr: 1, 3, 5, 7, 8, 10, 12 ' the 1e day needs to be on a friday (= 5) Dim As String month_names(1 To 12) => {"January","February","March",_ "April","May","June","July","August",_ "September","October","November","December"} Dim As Integer m, yr, total, i, j, yr_without(200) Dim As String answer For yr = 1900 To 2100 ' Gregorian calendar answer = "" For m = 1 To 12 Step 2 If m = 9 Then m = 8 If wd(m , 1 , yr) = 5 Then answer = answer + month_names(m) + ", " total = total + 1 End If Next If answer <> "" Then Print Using "#### | "; yr; Print Left(answer, Len(answer) -2) ' get rid of extra " ," Else i = i + 1 yr_without(i) = yr End If Next Print Print "nr of month for 1900 to 2100 that has five weekends";total Print Print i;" years don't have months with five weekends" For j = 1 To i Print yr_without(j); " "; If j Mod 8 = 0 Then Print Next Print ' empty keyboard buffer While InKey <> "" : Wend Print : Print "hit any key to end program" Sleep End