'**********************************************************************
'A Calendar For Windows 95 (ver 1.0) March 2000
'written by John Davenport
'email: timelord@zebra.net 
'**********************************************************************
$INCLUDE "RAPIDQ.INC"

Declare SUB ShowMonth (month%, day%, year%)
Declare FUNCTION LeapYear (y as Integer) as Integer
Declare FUNCTION DateNum (month%, day%, year%) as Long
Declare FUNCTION DayNum (month%, day%, year%) as Integer
Declare FUNCTION MonthDays (month%, year%) as Integer
Declare FUNCTION MonthName (month%) as String

Dim cal as QForm
Dim week as QLabel
Dim date(37) as QLabel
Dim font as QFont

curMonth% = VAL(LEFT$(DATE$,2))
curDay% = VAL(MID$(DATE$, 4, 2)) 
curYear% = VAL(RIGHT$(DATE$, 4))

CALL ShowMonth curMonth%, curDay%, curYear%

cal.Center
cal.BorderStyle = bsDialog
cal.Height = 140
cal.Width = 155 

week.Parent = cal
week.Caption = "Su Mo Tu We Th Fr Sa"
week.Top = 2
week.Left = 5

cal.ShowModal
'*********************************************************************
FUNCTION DateNum (month%, day%, year%) as LONG
 startYear% = 1900
 january% = 1
 daysPerYr& = 365
 If year% < startYear% then
    tooEarly% = TRUE
 End if   
 If month% < 1 or month% > 12 then 
    badMonth% = TRUE
 End if
 If day% < 1 or day% > MonthDays (month%, year%) then
    badDay% = TRUE
 End if
 If tooEarly% = TRUE or badMonth% = TRUE or badDay% = TRUE then
    DateNum = 0
    EXIT FUNCTION
 End if
 num& = daysPerYr& * (year% - startYear%)
 For curYear% = startYear% to year% - 1 STEP 4 
   if LeapYear (curYear%) then 
     num& = num& + 1
   end if
 Next curYear%
 For curMonth% = january% to month% - 1
   num& = num& + MonthDays (curMonth%, year%)
 Next curMonth%
 num& = num& + day%
 DateNum = num&
END FUNCTION

FUNCTION DayNum (month%, day%, year%) as INTEGER
 d& = DateNum (month%, day%, year%)
 If d& <> 0 then 
    dow% = d& MOD 7 + 1
 Else
    dow% = 0
 End if
 DayNum = dow%
END FUNCTION


FUNCTION LeapYear (y as integer) as Integer
 If (y MOD 400 = 0) or (y MOD 4 = 0) and (y MOD 100 <> 0) then
    LeapYear = TRUE
 else
    LeapYear = FALSE
 End if 
END FUNCTION

FUNCTION MonthDays (month%, year%) as Integer
 Select Case month%
  Case 2
       days% = 28
       If LeapYear (year%) = TRUE then  
          days% = days% + 1	
       End if  
  Case 4, 6, 9, 11
       days% = 31
  Case else
       days% = 31 
  End select
       MonthDays = days% 
END FUNCTION

FUNCTION MonthName (month%) as String
      m$ = "January   February  March     April    "
 m$ = m$ + "May       June      July      August   "
 m$ = m$ + "September October   November  December "
 mn$ = Mid$(m$, (month% - 1) * 10 + 1, 10)
 mn$ = RTrim$(mn$)
 MonthName = mn$
END FUNCTION

SUB ShowMonth (month%, day%, year%)
    firstDay% = DayNum (month%, 1, year%)
    monthLength% = MonthDays (month%, year%)
    cal.Caption = MonthName (month%) + " " + STR$(curYear%)
    curDate% = 0
    For curDay% = 1 to 37
       If curDay% = firstDay% and curDate% = 0 then
          isFirstDay% = TRUE
       else 
          isFirstDay% = FALSE
       End if
       If curDate% > 0 and curDate% < monthLength% then
          isInMonth% = TRUE
       else
           isInMonth% = FALSE
       End if  
       If isFirstDay% = TRUE or IsInMonth% = TRUE then
          curDate% = curDate% + 1 
          If curDate% < 10 then
             Font.Name = "  " + str$(curDate%)
          Else 
            Font.Name = str$(curDate%) 
          End if
       else
          Font.Name = "  "
       End if
       If curDate% = VAL(MID$(DATE$, 4, 2)) then
          Font.Color = &HFF0000
       else
          Font.Color = &H000000  
       End if  
         date(curDay%).Parent = cal
         date(curDay%).Font = Font
         date(curDay%).Caption = Font.Name
         read date(curDay%).Top
         read date(curDay%).Left
    Next curDay%
END SUB
'********************************************************************
data 20,5,20,25,20,45,20,65,20,85,20,105,20,125
data 35,5,35,25,35,45,35,65,35,85,35,105,35,125
data 50,5,50,25,50,45,50,65,50,85,50,105,50,125
data 65,5,65,25,65,45,65,65,65,85,65,105,65,125  
data 80,5,80,25,80,45,80,65,80,85,80,105,80,125
data 95,5,95,25