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