home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Basic / Q_BASIC.450 / CAL.BAS < prev    next >
BASIC Source File  |  1987-09-23  |  5KB  |  177 lines
  1. DEFINT A-Z               ' Default variable type is integer
  2.  
  3. ' Define a data type for the names of the months and the
  4. ' number of days in each:
  5. TYPE MonthType
  6.    Number AS INTEGER     ' Number of days in the month
  7.    MName AS STRING * 9   ' Name of the month
  8. END TYPE
  9.  
  10. ' Declare procedures used:
  11. DECLARE FUNCTION IsLeapYear% (N%)
  12. DECLARE FUNCTION GetInput% (Prompt$, Row%, LowVal%, HighVal%)
  13.  
  14. DECLARE SUB PrintCalendar (Year%, Month%)
  15. DECLARE SUB ComputeMonth (Year%, Month%, StartDay%, TotalDays%)
  16.  
  17. DIM MonthData(1 TO 12) AS MonthType
  18.  
  19. ' Initialize month definitions from DATA statements below:
  20. FOR I = 1 TO 12
  21.    READ MonthData(I).MName, MonthData(I).Number
  22. NEXT
  23.  
  24. ' Main loop, repeat for as many months as desired:
  25. DO
  26.  
  27.    CLS
  28.  
  29.    ' Get year and month as input:
  30.    Year = GetInput("Year (1899 to 2099): ", 1, 1899, 2099)
  31.    Month = GetInput("Month (1 to 12): ", 2, 1, 12)
  32.  
  33.    ' Print the calendar:
  34.    PrintCalendar Year, Month
  35.  
  36.    ' Another Date?
  37.    LOCATE 13, 1         ' Locate in 13th row, 1st column
  38.    PRINT "New Date? ";  ' Keep cursor on same line
  39.    LOCATE , , 1, 0, 13  ' Turn cursor on and make it one
  40.                         ' character high
  41.    Resp$ = INPUT$(1)    ' Wait for a key press
  42.    PRINT Resp$          ' Print the key pressed
  43.  
  44. LOOP WHILE UCASE$(Resp$) = "Y"
  45. END
  46.  
  47. ' Data for the months of a year:
  48. DATA January, 31, February, 28, March, 31
  49. DATA April, 30, May, 31, June, 30, July, 31, August, 31
  50. DATA September, 30, October, 31, November, 30, December, 31
  51. '
  52. ' ====================== COMPUTEMONTH ========================
  53. '     Computes the first day and the total days in a month.
  54. ' ============================================================
  55. '
  56. SUB ComputeMonth (Year, Month, StartDay, TotalDays) STATIC
  57.    SHARED MonthData() AS MonthType
  58.    CONST LEAP = 366 MOD 7
  59.    CONST NORMAL = 365 MOD 7
  60.  
  61.    ' Calculate total number of days (NumDays) since 1/1/1899.
  62.  
  63.    ' Start with whole years:
  64.    NumDays = 0
  65.    FOR I = 1899 TO Year - 1
  66.       IF IsLeapYear(I) THEN         ' If year is leap, add
  67.          NumDays = NumDays + LEAP   ' 366 MOD 7.
  68.       ELSE                          ' If normal year, add
  69.          NumDays = NumDays + NORMAL ' 365 MOD 7.
  70.       END IF
  71.    NEXT
  72.  
  73.    ' Next, add in days from whole months:
  74.    FOR I = 1 TO Month - 1
  75.       NumDays = NumDays + MonthData(I).Number
  76.    NEXT
  77.  
  78.    ' Set the number of days in the requested month:
  79.    TotalDays = MonthData(Month).Number
  80.  
  81.    ' Compensate if requested year is a leap year:
  82.    IF IsLeapYear(Year) THEN
  83.  
  84.       ' If after February, add one to total days:
  85.       IF Month > 2 THEN
  86.          NumDays = NumDays + 1
  87.  
  88.       ' If February, add one to the month's days:
  89.       ELSEIF Month = 2 THEN
  90.          TotalDays = TotalDays + 1
  91.  
  92.       END IF
  93.    END IF
  94.  
  95.    ' 1/1/1899 was a Sunday, so calculating "NumDays MOD 7"
  96.    ' gives the day of week (Sunday = 0, Monday = 1, Tuesday = 2,
  97.    ' and so on) for the first day of the input month:
  98.    StartDay = NumDays MOD 7
  99. END SUB
  100. '
  101. ' ======================== GETINPUT ==========================
  102. '       Prompts for input, then tests for a valid range.
  103. ' ============================================================
  104. '
  105. FUNCTION GetInput (Prompt$, Row, LowVal, HighVal) STATIC
  106.  
  107.    ' Locate prompt at specified row, turn cursor on and
  108.    ' make it one character high:
  109.    LOCATE Row, 1, 1, 0, 13
  110.    PRINT Prompt$;
  111.  
  112.    ' Save column position:
  113.    Column = POS(0)
  114.  
  115.    ' Input value until it's within range:
  116.    DO
  117.       LOCATE Row, Column   ' Locate cursor at end of prompt
  118.       PRINT SPACE$(10)     ' Erase anything already there
  119.       LOCATE Row, Column   ' Relocate cursor at end of prompt
  120.       INPUT "", Value      ' Input value with no prompt
  121.    LOOP WHILE (Value < LowVal OR Value > HighVal)
  122.  
  123.    ' Return valid input as value of function:
  124.    GetInput = Value
  125.  
  126. END FUNCTION
  127. '
  128. ' ====================== ISLEAPYEAR ==========================
  129. '         Determines if a year is a leap year or not.
  130. ' ============================================================
  131. '
  132. FUNCTION IsLeapYear (N) STATIC
  133.  
  134.    ' If the year is evenly divisible by 4 and not divisible
  135.    ' by 100, or if the year is evenly divisible by 400, then
  136.    ' it's a leap year:
  137.    IsLeapYear = (N MOD 4 = 0 AND N MOD 100 <> 0) OR (N MOD 400 = 0)
  138. END FUNCTION
  139. '
  140. ' ===================== PRINTCALENDAR ========================
  141. '     Prints a formatted calendar given the year and month.
  142. ' ============================================================
  143. '
  144. SUB PrintCalendar (Year, Month) STATIC
  145. SHARED MonthData() AS MonthType
  146.  
  147.    ' Compute starting day (Su M Tu ...) and total days
  148.    ' for the month:
  149.    ComputeMonth Year, Month, StartDay, TotalDays
  150.    CLS
  151.    Header$ = RTRIM$(MonthData(Month).MName) + "," + STR$(Year)
  152.  
  153.    ' Calculates location for centering month and year:
  154.    LeftMargin = (35 - LEN(Header$)) \ 2
  155.  
  156.    ' Print header:
  157.    PRINT TAB(LeftMargin); Header$
  158.    PRINT
  159.    PRINT "Su    M   Tu    W   Th    F   Sa"
  160.    PRINT
  161.  
  162.    ' Recalculate and print tab to the first day
  163.    ' of the month (Su M Tu ...):
  164.    LeftMargin = 5 * StartDay + 1
  165.    PRINT TAB(LeftMargin);
  166.  
  167.    ' Print out the days of the month:
  168.    FOR I = 1 TO TotalDays
  169.       PRINT USING "##   "; I;
  170.  
  171.       ' Advance to the next line when the cursor
  172.       ' is past column 32:
  173.       IF POS(0) > 32 THEN PRINT
  174.    NEXT
  175.  
  176. END SUB
  177.