home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OS2BAS.ZIP / CAL.BAS < prev    next >
BASIC Source File  |  1989-07-28  |  12KB  |  338 lines
  1. '***********************************************************
  2. '* 
  3. '* Program Name: Cal.BAS
  4. '*
  5. '* Description : This is the fully-converted version of
  6. '*               CAL.BAS. It takes advantage of more PM
  7. '*               features. Specifically, it uses a menu
  8. '*               and dialog box instead of using WinInput
  9. '*               for input. WinPrint is still used, since
  10. '*               text output is still appropriate, but lines
  11. '*               were added to make the output look more
  12. '*               like a calendar.
  13. '*
  14. '* Changes:      Menu and dialog instead of WinInput.
  15. '*               ClientWndProc modified for menu and dialog
  16. '*               flFrameFlags& added OR FCFMENU
  17. '*               WinCreateStdWindow added IDMENU
  18. '*               ClientWndProc1 added (dialog procedure)
  19. '*               GetInput removed
  20. '*               DrawBoxes added
  21. '***********************************************************
  22.  
  23. '*********         Initialization section        ***********
  24.  
  25. DEFINT A-Z               ' Default variable type is integer
  26.  
  27. ' Define a data type for the names of the months and the
  28. ' number of days in each:
  29. TYPE MonthType
  30.    Number AS INTEGER     ' Number of days in the month
  31.    MName AS STRING * 9   ' Name of the month
  32. END TYPE
  33.  
  34. ' Declare procedures used:
  35. DECLARE FUNCTION IsLeapYear% (N%)
  36.  
  37. DECLARE SUB PrintCalendar (hwnd&, hps&, Year%, Month%)
  38. DECLARE SUB ComputeMonth (Year%, Month%, StartDay%, TotalDays%)
  39. REM $INCLUDE: 'PMBase.BI'
  40. REM $INCLUDE: 'OS2Def.BI'
  41. REM $INCLUDE: 'WinStdIO.BI'
  42. REM $INCLUDE: 'WinDialg.BI'        Needed for WinDlgBox, etc.
  43. REM $INCLUDE: 'WinMan1.BI'         Needed for DrawBoxes (WinQueryWindowRect)
  44. REM $INCLUDE: 'GpiLine.BI'         Needed for DrawBoxes (GpiLine,GpiBox)
  45. REM $INCLUDE: 'GpiArea.BI'         Needed for DrawBoxes (DROOUTLINE)
  46. REM $INCLUDE: 'GpiChar.BI'         Needed for DrawBoxes (GpiQueryCharBox)
  47. DECLARE FUNCTION RegBas1&         'Needed for registering Dialog procedure
  48. CONST IDDLG = 1                   'Constants for menu and dialog
  49. CONST IDYEAR = 1
  50. CONST IDMONTH = 2
  51. CONST IDMENU = 2
  52.  
  53. DIM MonthData(1 TO 12) AS MonthType
  54.  
  55. ' Initialize month definitions from DATA statements below:
  56. FOR I = 1 TO 12
  57.    READ MonthData(I).MName, MonthData(I).Number
  58. NEXT
  59.  
  60. DIM aqmsg AS QMSG
  61.  
  62. flFrameFlags& = FCFTITLEBAR      OR FCFSYSMENU OR _
  63.                 FCFSIZEBORDER    OR FCFMINMAX  OR _
  64.                 FCFSHELLPOSITION OR FCFTASKLIST OR_
  65.                 FCFMENU          '*** FCFMENU added
  66.  
  67. szClientClass$ = "ClassName" + CHR$(0)
  68.  
  69. hab& = WinInitialize(0)
  70. hmq& = WinCreateMsgQueue(hab&, 0)
  71.  
  72. bool% = WinRegisterClass(_
  73.           hab&,_
  74.           MakeLong(VARSEG(szClientClass$), SADD(szClientClass$)),_
  75.           RegBas,_
  76.           0,_
  77.           0)
  78.  
  79. hwndFrame& = WinCreateStdWindow (_
  80.           HWNDDESKTOP,_
  81.           WSVISIBLE,_
  82.           MakeLong (VARSEG(flFrameFlags&), VARPTR(flFrameFlags&)),_
  83.           MakeLong (VARSEG(szClientClass$), SADD(szClientClass$)),_
  84.           0,_
  85.           0,_
  86.           0,_
  87.           IDMENU,_                       '**** IDMENU added
  88.           MakeLong (VARSEG(hwndClient&), VARPTR(hwndClient&)))
  89.  
  90. '**************         Message loop         ***************
  91.  
  92. WHILE WinGetMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)), 0, 0, 0)
  93.   bool% = WinDispatchMsg(hab&, MakeLong(VARSEG(aqmsg), VARPTR(aqmsg)))
  94. WEND
  95.  
  96. '***********         Finalize section        ***************
  97.  
  98. bool% = WinDestroyWindow(hwndFrame&)
  99. bool% = WinDestroyMsgQueue(hmq&)
  100. bool% = WinTerminate(hab&)
  101.  
  102. END
  103.  
  104. '***********         Window procedure        ***************
  105.  
  106. '****
  107. '** ClientWndProc was modified by removing WinInput:
  108. '**
  109. '**          WMCHAR is removed
  110. '**          WMPAINT only does one operation (PrintCalendar)
  111. '**          WMCOMMAND added
  112. FUNCTION ClientWndProc& (hwnd&, msg%, mp1&, mp2&) STATIC
  113.      SHARED Year%, Month%
  114.      DIM ClientRect AS RECTL
  115.      ClientWndProc&=0
  116.      SELECT CASE msg%
  117.      CASE WMCREATE      'Get current date for initial calendar
  118.         Month% = VAL(LEFT$(DATE$,2))
  119.         Year% = VAL(RIGHT$(DATE$,4))
  120.      CASE WMPAINT
  121.         bool% = WinInvalidateRect(hwnd&, 0, 0)
  122.         hps&  = WinBeginPaint(hwnd&, 0,_
  123.                 MakeLong(VARSEG(ClientRect), VARPTR(ClientRect)))
  124.             ' Print the calendar:
  125.             PrintCalendar hwnd&, hps&, Year%, Month%
  126.         bool% = WinEndPaint(hps&)
  127.      CASE WMCOMMAND      'Triggered by Menu
  128.  
  129.         'Accept input from dialog box (NOTE: RegBas1 --> ClientWndProc1)
  130.         bool% = WinDlgBox(HWNDDESKTOP, hwnd&, RegBas1&, 0, IDDLG, 0)
  131.  
  132.         'Invalidate window to cause WMPAINT
  133.         bool% = WinInvalidateRect(hwnd&, 0, 0)
  134.      CASE ELSE        'Pass control to system for other messages
  135.         ClientWndProc& = WinDefWindowProc(hwnd&, msg%, mp1&, mp2&)
  136.      END SELECT
  137. END FUNCTION
  138.  
  139. FUNCTION ClientWndProc1& (hwnd&, msg%, mp1&, mp2&) STATIC
  140.     SHARED Year%, Month%
  141.     DIM YearString AS STRING * 5
  142.     DIM MonthString AS STRING * 3
  143.     ClientWndProc1& = 0
  144.     SELECT CASE msg%
  145.        CASE WMCOMMAND     'Triggered by button
  146.           bool% = WinQueryDlgItemText(hwnd&,_
  147.                              IDYEAR,_
  148.                              5,_
  149.                              MakeLong(VARSEG(YearString),VARPTR(YearString)))
  150.           bool% = WinQueryDlgItemText(hwnd&,_
  151.                              IDMONTH,_
  152.                              3,_
  153.                              MakeLong(VARSEG(MonthString),VARPTR(MonthString)))
  154.  
  155.           'Check bounds
  156.           TempYear% = VAL(YearString)
  157.           TempMonth% = VAL(MonthString)
  158.           IF (TempYear%>0) AND (TempMonth%>0) AND (TempMonth%<13) THEN
  159.              Year% = TempYear%
  160.              Month% = TempMonth%
  161.           END IF
  162.  
  163.           bool% = WinDisMissDlg(hwnd&, 1)
  164.        CASE ELSE
  165.           ClientWndProc1& = WinDefDlgProc(hwnd&, msg%, mp1&, mp2&)
  166.     END SELECT
  167. END FUNCTION
  168.  
  169. ' Data for the months of a year:
  170. DATA January, 31, February, 28, March, 31
  171. DATA April, 30, May, 31, June, 30, July, 31, August, 31
  172. DATA September, 30, October, 31, November, 30, December, 31
  173. '
  174. ' ====================== COMPUTEMONTH ========================
  175. '     Computes the first day and the total days in a month.
  176. ' ============================================================
  177. '
  178. SUB ComputeMonth (Year, Month, StartDay, TotalDays) STATIC
  179.    SHARED MonthData() AS MonthType
  180.    CONST LEAP = 366 MOD 7
  181.    CONST NORMAL = 365 MOD 7
  182.  
  183.    ' Calculate total number of days (NumDays) since 1/1/1899.
  184.  
  185.    ' Start with whole years:
  186.    NumDays = 0
  187.    FOR I = 1899 TO Year - 1
  188.       IF IsLeapYear(I) THEN         ' If year is leap, add
  189.          NumDays = NumDays + LEAP   ' 366 MOD 7.
  190.       ELSE                          ' If normal year, add
  191.          NumDays = NumDays + NORMAL ' 365 MOD 7.
  192.       END IF
  193.    NEXT
  194.  
  195.    ' Next, add in days from whole months:
  196.    FOR I = 1 TO Month - 1
  197.       NumDays = NumDays + MonthData(I).Number
  198.    NEXT
  199.  
  200.    ' Set the number of days in the requested month:
  201.    TotalDays = MonthData(Month).Number
  202.  
  203.    ' Compensate if requested year is a leap year:
  204.    IF IsLeapYear(Year) THEN
  205.  
  206.       ' If after February, add one to total days:
  207.       IF Month > 2 THEN
  208.          NumDays = NumDays + 1
  209.  
  210.       ' If February, add one to the month's days:
  211.       ELSEIF Month = 2 THEN
  212.          TotalDays = TotalDays + 1
  213.  
  214.       END IF
  215.    END IF
  216.  
  217.    ' 1/1/1899 was a Sunday, so calculating "NumDays MOD 7"
  218.    ' gives the day of week (Sunday = 0, Monday = 1, Tuesday = 2,
  219.    ' and so on) for the first day of the input month:
  220.    StartDay = NumDays MOD 7
  221. END SUB
  222. '
  223. ' ====================== ISLEAPYEAR ==========================
  224. '         Determines if a year is a leap year or not.
  225. ' ============================================================
  226. '
  227. FUNCTION IsLeapYear (N) STATIC
  228.  
  229.    ' If the year is evenly divisible by 4 and not divisible
  230.    ' by 100, or if the year is evenly divisible by 400, then
  231.    ' it's a leap year:
  232.    IsLeapYear = (N MOD 4 = 0 AND N MOD 100 <> 0) OR (N MOD 400 = 0)
  233. END FUNCTION
  234. '
  235. ' ===================== PRINTCALENDAR ========================
  236. '     Prints a formatted calendar given the year and month.
  237. ' ============================================================
  238. '
  239. SUB PrintCalendar (hwnd&, hps&, Year, Month) STATIC
  240. SHARED MonthData() AS MonthType
  241.  
  242.    ' Compute starting day (Su M Tu ...) and total days
  243.    ' for the month:
  244.    ComputeMonth Year, Month, StartDay, TotalDays
  245.    WinCLS hwnd&, hps&
  246.    Header$ = RTRIM$(MonthData(Month).MName) + "," + STR$(Year)
  247.  
  248.    ' Calculates location for centering month and year:
  249.    LeftMargin = (35 - LEN(Header$)) \ 2
  250.  
  251.    ' Print header:
  252.    WinPrintS hps&, SPACE$(LeftMargin)
  253.    WinPrint hps&, Header$
  254.    WinPrint hps&, ""
  255.    Row = WinCSRLIN(hwnd&, hps&)
  256.       WinLocate hwnd&, hps&, Row, 1 + 0 * 5
  257.       WinPrint hps&, "Su"
  258.       WinLocate hwnd&, hps&, Row, 1 + 1 * 5
  259.       WinPrint hps&, " M"
  260.       WinLocate hwnd&, hps&, Row, 1 + 2 * 5
  261.       WinPrint hps&, "Tu"
  262.       WinLocate hwnd&, hps&, Row, 1 + 3 * 5
  263.       WinPrint hps&, " W"
  264.       WinLocate hwnd&, hps&, Row, 1 + 4 * 5
  265.       WinPrint hps&, "Th"
  266.       WinLocate hwnd&, hps&, Row, 1 + 5 * 5
  267.       WinPrint hps&, " F"
  268.       WinLocate hwnd&, hps&, Row, 1 + 6 * 5
  269.       WinPrint hps&, "Sa"
  270.       WinPrint hps&, ""
  271.  
  272.    ' Recalculate and print tab to the first day
  273.    ' of the month (Su M Tu ...):
  274.    Row = WinCSRLIN (hwnd&, hps&)
  275.    Column = 1 + StartDay * 5
  276.  
  277.    ' Print out the days of the month:
  278.    FOR I = 1 TO TotalDays
  279.       II$ = LTRIM$(RTRIM$(STR$(I)))
  280.       IF LEN(II$) = 1 THEN II$ = " " + II$
  281.       WinLocate hwnd&, hps&, Row, Column
  282.       WinPrintS hps&, II$
  283.       Column = Column + 5
  284.  
  285.       ' Advance to the next line when the cursor
  286.       ' is past column 32:
  287.       IF Column > 32 THEN
  288.         Row = Row + 1
  289.         Column = 1
  290.       END IF
  291.    NEXT
  292.    IF Column = 1 THEN Row = Row - 1
  293.    CALL DrawBoxes(hwnd&, hps&, Row - 3)     '**** DrawBoxes added
  294. END SUB
  295.  
  296. '**** DrawBoxes added to draw lines around calendar.
  297. SUB DrawBoxes(hwnd&, hps&, NumRows%)
  298.     DIM prcl AS RECTL
  299.     DIM psizfxBox AS SIZEF
  300.     DIM ptl AS POINTL
  301.  
  302.     'Check size of window and character
  303.     bool% = WinQueryWindowRect(hwnd&, MakeLong(VARSEG(prcl), VARPTR(prcl)))
  304.     bool% = GpiQueryCharBox(hps&,_
  305.                             MakeLong&(VARSEG(psizfxBox), VARPTR(psizfxBox)))
  306.  
  307.     'DeltaX/Y and BottomOfCalendar used to ease drawing boxes
  308.     DeltaX! = psizfxBox.cx / &H10000
  309.     DeltaY! = psizfxBox.cy / &H10000
  310.     BottomOfCalendar& = prcl.yTop - (DeltaY! * (NumRows% + 3.25))
  311.  
  312.     'Draw full box:
  313.     CALL WinLocate(hwnd&, hps&, 3, 1)
  314.     ptl.x = DeltaX! * 7 * 5
  315.     ptl.y = BottomOfCalendar&
  316.     bool% = GpiBox (hps&,_
  317.                     DROOUTLINE,_
  318.                     MakeLong(VARSEG(ptl), VARPTR(ptl)), 0, 0)
  319.  
  320.     'Draw vertical lines
  321.     FOR I% = 1 TO 6
  322.        ptl.x = ((5 * I%) - 1) * DeltaX!
  323.        ptl.y = BottomOfCalendar& + (NumRows% + 1.25) * DeltaY!
  324.        bool% = GpiMove(hps&, MakeLong(VARSEG(ptl), VARPTR(ptl)))
  325.        ptl.y = BottomOfCalendar&
  326.        bool% = GpiLine(hps&, MakeLong(VARSEG(ptl), VARPTR(ptl)))
  327.     NEXT I%
  328.  
  329.     'Draw horizontal lines
  330.     FOR I% = 1 TO NumRows% - 1
  331.        ptl.x = 0
  332.        ptl.y = BottomOfCalendar& + I% * DeltaY!
  333.        bool% = GpiMove(hps&, MakeLong(VARSEG(ptl), VARPTR(ptl)))
  334.        ptl.x = 7 * 5 * DeltaX!
  335.        bool% = GpiLine(hps&, MakeLong(VARSEG(ptl), VARPTR(ptl)))
  336.     NEXT I%
  337. END SUB
  338.