home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE5 / CUA_SAMP.ZIP / CALENDAR.PRG < prev    next >
Encoding:
Text File  |  1994-06-24  |  35.6 KB  |  976 lines
  1.  
  2. *.............................................................................
  3. *
  4. *   Program Name: CALENDAR.DFM        Copyright: Borland International
  5. *   Date Created: 01/24/94             Language: dBASE 5.0
  6. *   Time Created: 10:20:02               Author: Borland dBASE R&D
  7. *   /brief/library.src
  8. *.............................................................................
  9.  
  10. #include "dkeys.hdb"
  11.  
  12. #define kAmerican  1
  13. #define kANSI      2
  14. #define kBritish   3
  15. #define kGerman    4
  16. #define kItalian   5
  17. #define kJapan     6
  18. #define kUSA       7
  19. #define kMDYString 8
  20. #define kDMYString 9
  21.  
  22. #define kTop 1
  23.  
  24. #define ALLTRIM(kStr) LTRIM(RTRIM(kStr))
  25.  
  26. *.........................................................................
  27. * Procedure Name:   Calendar
  28. * Parameters:       None
  29. * Ext Memvars:      None
  30. * Description:      Displays a monthly calendar starting with the current
  31. *                   month
  32. *.........................................................................
  33. PROCEDURE Calendar
  34.     PRIVATE i, lVoid
  35.  
  36.     #include "TALKOFF.HDB"
  37.  
  38.     IF TYPE("_CmdWindow.dbCalndr.Top") = "N"    && if another instance is active
  39.         * if the user released the public arrays, rebuild the calendar
  40.         IF (TYPE("dB5___wk[1]") # "C") .OR. (TYPE("dB5___dat[1]") # "C")
  41.             DO CalExit
  42.             DO DefCalndr
  43.         ELSE    
  44.             lVoid = _CmdWindow.dbCalndr.Open()  && everything's ok
  45.         ENDIF    
  46.     ELSE
  47.         DO DefCalndr    
  48.     ENDIF
  49.  
  50. RETURN
  51.  
  52.  
  53. *.........................................................................
  54. * Procedure Name:   DefCalndr
  55. * Parameters:       None
  56. * Ext Memvars:      None
  57. * Description:      Defines the calendar form
  58. *.........................................................................
  59. PROCEDURE DefCalndr
  60.     PRIVATE lVoid, lSTalk, i
  61.     
  62.     lSTalk = SET("TALK") = "ON"
  63.  
  64.     SET TALK OFF
  65.     
  66.     RELEASE db5___wk
  67.     PUBLIC ARRAY db5___wk[6]         && holds week character strings
  68.     RELEASE db5___dat
  69.     PUBLIC ARRAY db5___dat[42]       && holds individual dates of the month
  70.  
  71.     FOR m->i = 1 TO 6
  72.         dB5___wk[i] = SPACE(26)
  73.     ENDFOR
  74.     
  75.     #include "DBCALNDR.DFM"
  76.  
  77.     _CmdWindow.dbCalndr = dbCalndr
  78.  
  79.     DO InitDates WITH DATE()
  80.  
  81.     dbCalndr.Today.Text = " " + GetToday() + " "
  82.     DO GetCoords WITH SUBSTR(dbCalndr.Today.Text,2,2)
  83.  
  84.     dbCalndr.lSTalk = m->lSTalk
  85.     
  86.     DO UpdateProp
  87.             
  88.     lVoid = dbCalndr.Open()
  89. RETURN
  90.  
  91.  
  92. *.................................................................
  93. * Procedure Name:   SetTalk
  94. * Parameters:       None
  95. * Description:      Saves the value of SET TALK and sets TALK OFF
  96. *.................................................................
  97. PROCEDURE SetTalk
  98.     IF (TYPE("dB5___wk[1]") # "C") .OR. (TYPE("dB5___dat[1]") # "C")
  99.         DO CalExit
  100.         DO DefCalndr
  101.     ENDIF    
  102.     
  103.     IF TYPE("_CmdWindow.dbCalndr.lSTalk") = "L"
  104.         _CmdWindow.dbCalndr.lSTalk = SET("TALK") = "ON"
  105.     ELSE    
  106.         dbCalndr.lSTalk = SET("TALK") = "ON"
  107.     ENDIF
  108.         
  109.     SET TALK OFF
  110. RETURN
  111.  
  112.  
  113. *............................................................................
  114. * Procedure Name:   ResetTalk
  115. * Parameters:       None
  116. * Ext Memvars:      This.TalkEnter
  117. * Description:      Resets the value of SET TALK based on the value when the
  118. *                   object got focus
  119. *............................................................................
  120. PROCEDURE ResetTalk
  121.     IF _CmdWindow.dbCalndr.lSTalk
  122.         SET TALK ON
  123.     ELSE
  124.         SET TALK OFF
  125.     ENDIF
  126. RETURN
  127.  
  128.  
  129. *..........................................................................
  130. * Procedure Name:   GoToday
  131. * Parameters:       None
  132. * Ext Memvars:      _CmdWindow.dbCalndr
  133. * Description:      Makes the system date the current date on the calendar
  134. *..........................................................................
  135. PROCEDURE GoToday
  136.     _CmdWindow.dbCalndr.dNewDate = DATE()
  137.     DO InitDates WITH _CmdWindow.dbCalndr.dNewDate
  138.     DO UpdateProp
  139.     _CmdWindow.dbCalndr.nDay = DAY(_CmdWindow.dbCalndr.dNewDate)
  140.     _CmdWindow.dbCalndr.Today.Text = " " + STR(_CmdWindow.dbCalndr.nDay, 2, 0) + " "
  141.     DO GetCoords WITH SUBSTR(_CmdWindow.dbCalndr.Today.Text,2,2)
  142. RETURN
  143.  
  144.  
  145. *...........................................................................
  146. * Procedure Name:   GetCoords
  147. * Parameters:       cDStr, a string containing a number representing a date
  148. * Ext. Memvars:     _CmdWindow.dbCalndr
  149. * Description:      computes the row/column coordinates to print today's
  150. *                   date in the calendar page
  151. *...........................................................................
  152. PROCEDURE GetCoords
  153. PARAMETERS cDStr
  154.     PRIVATE i, lExact
  155.  
  156.     lExact = SET("EXACT") = "ON"   && save setting of SET EXACT
  157.  
  158.     SET EXACT ON
  159.  
  160.     FOR m->i = 1 TO 42
  161.         * search for today's date in the array of dates
  162.         IF cDStr = dB5___dat[m->i]  
  163.             EXIT             && exit the loop when found
  164.         ENDIF
  165.     ENDFOR
  166.  
  167.     IF .NOT. m->lExact
  168.         SET EXACT OFF        && restore the SET EXACT setting
  169.     ENDIF
  170.  
  171.     *.................................................
  172.     * find the row that the date should be printed in
  173.     *.................................................
  174.     DO CASE
  175.         CASE (m->i >= 1) .AND. (m->i <= 7)
  176.             _CmdWindow.dbCalndr.Today.Top = kTop + 3
  177.         CASE (m->i >= 8) .AND. (m->i <= 14)
  178.             _CmdWindow.dbCalndr.Today.Top = kTop + 4
  179.         CASE (m->i >= 15) .AND. (m->i <= 21)
  180.             _CmdWindow.dbCalndr.Today.Top = kTop + 5
  181.         CASE (m->i >= 22) .AND. (m->i <= 28)
  182.             _CmdWindow.dbCalndr.Today.Top = kTop + 6
  183.         CASE (m->i >= 29) .AND. (m->i <= 35)
  184.             _CmdWindow.dbCalndr.Today.Top = kTop + 7
  185.         CASE (m->i >= 36) .AND. (m->i <= 42)
  186.             _CmdWindow.dbCalndr.Today.Top = kTop + 8
  187.     ENDCASE
  188.  
  189.     *.............................................................
  190.     * find the starting column that the date should be printed in
  191.     *.............................................................
  192.     DO CASE
  193.         CASE (m->i = 1) .OR. (m->i = 8) .OR. (m->i = 15) .OR. (m->i = 22) .OR. (m->i = 29) .OR. (m->i = 36)                       
  194.             _CmdWindow.dbCalndr.Today.Left = 1
  195.         CASE (m->i = 2) .OR. (m->i = 9) .OR. (m->i = 16) .OR. (m->i = 23) .OR. (m->i = 30) .OR. (m->i = 37)
  196.             _CmdWindow.dbCalndr.Today.Left = 5
  197.         CASE (m->i = 3) .OR. (m->i = 10) .OR. (m->i = 17) .OR. (m->i = 24) .OR. (m->i = 31) .OR. (m->i = 38)
  198.             _CmdWindow.dbCalndr.Today.Left = 9
  199.         CASE (m->i = 4) .OR. (m->i = 11) .OR. (m->i = 18) .OR. (m->i = 25) .OR. (m->i = 32) .OR. (m->i = 39)
  200.             _CmdWindow.dbCalndr.Today.Left = 13
  201.         CASE (m->i = 5) .OR. (m->i = 12) .OR. (m->i = 19) .OR. (m->i = 26) .OR. (m->i = 33) .OR. (m->i = 40)
  202.             _CmdWindow.dbCalndr.Today.Left = 17
  203.         CASE (m->i = 6) .OR. (m->i = 13) .OR. (m->i = 20) .OR. (m->i = 27) .OR. (m->i = 34) .OR. (m->i = 41)
  204.             _CmdWindow.dbCalndr.Today.Left = 21
  205.         CASE (m->i = 7) .OR. (m->i = 14) .OR. (m->i = 21) .OR. (m->i = 28) .OR. (m->i = 35) .OR. (m->i = 42)
  206.             _CmdWindow.dbCalndr.Today.Left = 25
  207.     ENDCASE
  208. RETURN
  209.  
  210.  
  211. *..........................................................................
  212. * Function Name:    GetToday
  213. * Parameters:       None
  214. * Ext. Memvars:     None
  215. * Return Value:     String, day if current month, "" if not
  216. * Description:      if value of nMth is within the current month, a string
  217. *                   representing the value of the day is returned.  If not
  218. *                   the current month an empty string is returned.
  219. *..........................................................................
  220. FUNCTION GetToday
  221.     SET TALK OFF 
  222. RETURN STR(DAY(DATE()),2,0)
  223.  
  224.  
  225. *...........................................................................
  226. * Procedure Name:   ChkArrow
  227. * Parameters:       None
  228. * Ext. Memvars:     _CmdWindow.dbCalndr
  229. * Description:      Processes keystoke or mouseclick on _CmdWindow.dbCalndr.  If right
  230. *                   key, or click in right place, then does PrevMth or 
  231. *                   NextMth, or changes highlighted date
  232. *...........................................................................
  233. PROCEDURE CheckArw
  234.     PRIVATE i, nTmp, nRow, nCol
  235.     
  236.     SET TALK OFF
  237.     
  238.     nRow = event.MouseRow
  239.     nCol = event.MouseColumn
  240.  
  241.     DO CASE
  242.         CASE event.eventType = evKeyDown            && keyboard event
  243.             DO CASE
  244.                 CASE event.KeyValue = kbRight       && right arrow    
  245.                     _CmdWindow.dbCalndr.nDay = IIF(_CmdWindow.dbCalndr.nDay < DAY(_CmdWindow.dbCalndr.dLast),;
  246.                         _CmdWindow.dbCalndr.nDay + 1, 1)
  247.                     _CmdWindow.dbCalndr.Today.Text = " " + STR(_CmdWindow.dbCalndr.nDay,2,0) + " "
  248.                     DO GetCoords WITH SUBSTR(_CmdWindow.dbCalndr.Today.Text,2,2)
  249.                 CASE event.KeyValue = kbLeft      && left arrow
  250.                     _CmdWindow.dbCalndr.nDay = IIF(_CmdWindow.dbCalndr.nDay > 1, _CmdWindow.dbCalndr.nDay - 1,;
  251.                         DAY(_CmdWindow.dbCalndr.dLast))
  252.                     _CmdWindow.dbCalndr.Today.Text = " " + STR(_CmdWindow.dbCalndr.nDay,2,0) + " "
  253.                     DO GetCoords WITH SUBSTR(_CmdWindow.dbCalndr.Today.Text,2,2)
  254.                 CASE (event.KeyValue = kbUp) .AND. (.NOT.(event.KeyAlt))      && up arrow
  255.                     IF _CmdWindow.dbCalndr.nDay >= 8  && if the 8th of the month or >
  256.                         _CmdWindow.dbCalndr.nDay = _CmdWindow.dbCalndr.nDay - 7
  257.                     ELSE    && < 8th, goto same weekday at bottom of month
  258.                         nTmp = DOW(Num2Date(_CmdWindow.dbCalndr.nDay, _CmdWindow.dbCalndr.nMth,;
  259.                             _CmdWindow.dbCalndr.nYear))    && get DOW of current day                                                                             
  260.                         * starting from the end of the month, find the first
  261.                         * day with the same day of the week as the current
  262.                         * day 
  263.                         FOR m->i = 42 TO 1 STEP -1
  264.                             IF VAL(dB5___dat[m->i]) > 0   && if there is a number
  265.                                 * if the DOW of day in dB5___dat[i] = nTmp
  266.                                 IF DOW(Num2Date(VAL(dB5___dat[m->i]),; 
  267.                                     _CmdWindow.dbCalndr.nMth, _CmdWindow.dbCalndr.nYear)) = nTmp
  268.                                     * set nDay to this date
  269.                                     _CmdWindow.dbCalndr.nDay = VAL(dB5___dat[m->i])
  270.                                     EXIT    && exit the loop
  271.                                 ENDIF
  272.                             ENDIF
  273.                         ENDFOR
  274.                     ENDIF
  275.                     _CmdWindow.dbCalndr.Today.Text = " " + STR(_CmdWindow.dbCalndr.nDay,2,0) +" "
  276.                     DO GetCoords WITH SUBSTR(_CmdWindow.dbCalndr.Today.Text,2,2)
  277.                 CASE (event.KeyValue = kbDown) .AND. (.NOT.(event.KeyAlt))  && downarrow
  278.                     * if current day is at least 7 days prior to the last
  279.                     * day of the month
  280.                     IF _CmdWindow.dbCalndr.nDay <= (DAY(_CmdWindow.dbCalndr.dLast) - 7)
  281.                         _CmdWindow.dbCalndr.nDay = _CmdWindow.dbCalndr.nDay + 7   && add a week
  282.                     ELSE
  283.                         nTmp = DOW(Num2Date(_CmdWindow.dbCalndr.nDay, _CmdWindow.dbCalndr.nMth,; 
  284.                             _CmdWindow.dbCalndr.nYear))    && DOW of present day
  285.                         * search month starting at beginning of month for the
  286.                         * first day with the same DOW as the present day
  287.                         FOR i = 1 TO 42 STEP 1
  288.                             IF VAL(dB5___dat[m->i]) > 0   && if a day
  289.                                 * if DOW = DOW of present day, reset day to 
  290.                                 * new day in first week
  291.                                 IF DOW(Num2Date(VAL(dB5___dat[m->i]),; 
  292.                                     _CmdWindow.dbCalndr.nMth, _CmdWindow.dbCalndr.nYear)) = m->nTmp
  293.                                     _CmdWindow.dbCalndr.nDay = VAL(dB5___dat[m->i])
  294.                                     EXIT
  295.                                 ENDIF
  296.                             ENDIF
  297.                         ENDFOR
  298.                     ENDIF
  299.                     _CmdWindow.dbCalndr.Today.Text = " " + STR(_CmdWindow.dbCalndr.nDay,2,0) + " "
  300.                     DO GetCoords WITH SUBSTR(_CmdWindow.dbCalndr.Today.Text,2,2)
  301.             ENDCASE
  302.         CASE event.eventType = evMouseDown        && mouse event
  303.             DO CASE
  304.                 CASE m->nRow = 1
  305.                     DO CASE
  306.                         CASE m->nCol = 20
  307.                             DO PrevMth
  308.                         CASE m->nCol = 23
  309.                             DO NextMth
  310.                     ENDCASE
  311.                 CASE (m->nRow >= 4) .AND. (m->nRow <= 9)
  312.                     nTmp = MHiLite(m->nRow, m->nCol)
  313.                     IF (m->nTmp > 0) .AND. (LEN(ALLTRIM(dB5___dat[m->nTmp])) > 0)
  314.                         DO GetCoords WITH dB5___dat[m->nTmp]
  315.                         _CmdWindow.dbCalndr.Today.Text = " " + dB5___dat[m->nTmp] + " "
  316.                         _CmdWindow.dbCalndr.nDay = VAL(dB5___dat[m->nTmp])
  317.                     ENDIF
  318.             ENDCASE
  319.     ENDCASE
  320.     
  321. RETURN
  322.  
  323.  
  324. *.............................................................................
  325. * Function Name:    MHiLite
  326. * Parameters:       nRow - the row the mouse was clicked on
  327. *                   nCol - the column the mouse was clicked on
  328. * Return Value:     nRet - the index into dB5___dat[] that falls under nRow,nCol
  329. * Ext Memvars:      None
  330. * Description:      Determines which member of the array dB5___dat[] was clicked
  331. *                   on with the mouse.  Returns the index into the array.
  332. *.............................................................................
  333. FUNCTION MHiLite
  334. PARAMETERS nRow, nCol
  335.     PRIVATE nTmp, nRet    
  336.  
  337.     DO CASE
  338.         CASE m->nRow = 4
  339.             nTmp =  0
  340.         CASE m->nRow = 5
  341.             nTmp =  7
  342.         CASE m->nRow = 6
  343.             nTmp = 14
  344.         CASE m->nRow = 7
  345.             nTmp = 21
  346.         CASE m->nRow = 8
  347.             nTmp = 28
  348.         CASE m->nRow = 9
  349.             nTmp = 35
  350.     ENDCASE
  351.  
  352.     DO CASE
  353.         CASE (m->nCol = 2) .OR. (m->nCol = 3)
  354.             nRet = 1 + m->nTmp
  355.         CASE (m->nCol = 6) .OR. (m->nCol = 7)
  356.             nRet = 2 + m->nTmp
  357.         CASE (m->nCol = 10) .OR. (m->nCol = 11)
  358.             nRet = 3 + m->nTmp
  359.         CASE (m->nCol = 14) .OR. (m->nCol = 15)
  360.             nRet = 4 + m->nTmp
  361.         CASE (m->nCol = 18) .OR. (m->nCol = 19)
  362.             nRet = 5 + m->nTmp
  363.         CASE (m->nCol = 22) .OR. (m->nCol = 23)
  364.             nRet = 6 + m->nTmp
  365.         CASE (m->nCol = 26) .OR. (m->nCol = 27)
  366.             nRet = 7 + m->nTmp
  367.         OTHERWISE
  368.             nRet = 0
  369.     ENDCASE
  370.  
  371. RETURN m->nRet
  372.  
  373.  
  374. *.............................................................................
  375. * Procedure Name:   PrevMth
  376. * Parameters:       None
  377. * Ext Memvars:      None
  378. * Description:      Creates a date memvar with a value in the month previous
  379. *                   to the month currently being viewed in the calendar.
  380. *                   Then it calls the functions to create a new calendar page
  381. *                   with the new date.  Finally it updates the object
  382. *                   properties to display the new calendar page.
  383. *.............................................................................
  384. PROCEDURE PrevMth
  385.     PRIVATE nTmp
  386.  
  387.     SET TALK OFF
  388.  
  389.     nTmp = _CmdWindow.dbCalndr.nDay    && save current day
  390.  
  391.     DO InitDates WITH (_CmdWindow.dbCalndr.dFirst - 10)
  392.     DO UpdateProp
  393.     _CmdWindow.dbCalndr.nDay = IIF(m->nTmp <= DAY(_CmdWindow.dbCalndr.dLast), m->nTmp,; 
  394.         DAY(_CmdWindow.dbCalndr.dLAST))
  395.     _CmdWindow.dbCalndr.Today.Text = " " + STR(_CmdWindow.dbCalndr.nDay, 2, 0) + " "
  396.     DO GetCoords WITH SUBSTR(_CmdWindow.dbCalndr.Today.Text,2,2)
  397.     _CmdWindow.dbCalndr.Today.Text = " " + STR(_CmdWindow.dbCalndr.nDay, 2, 0) + " "
  398. RETURN
  399.  
  400.  
  401. *.............................................................................
  402. * Procedure Name:   NextMth
  403. * Parameters:       None
  404. * Ext Memvars:      None
  405. * Description:      Creates a date memvar with a value in the month following
  406. *                   the month currently being viewed in the calendar.
  407. *                   Then it calls the functions to create a new calendar page
  408. *                   with the new date.  Finally it updates the object
  409. *                   properties to display the new calendar page.
  410. *.............................................................................
  411. PROCEDURE NextMth
  412.     PRIVATE nTmp
  413.  
  414.     SET TALK OFF
  415.  
  416.     nTmp = _CmdWindow.dbCalndr.nDay    && save current day
  417.  
  418.     DO InitDates WITH (_CmdWindow.dbCalndr.dLast + 10)
  419.     DO UpdateProp
  420.     _CmdWindow.dbCalndr.nDay = IIF(m->nTmp <= DAY(_CmdWindow.dbCalndr.dLast), m->nTmp,; 
  421.         DAY(_CmdWindow.dbCalndr.dLAST))
  422.     _CmdWindow.dbCalndr.Today.Text = " " + STR(_CmdWindow.dbCalndr.nDay, 2, 0) + " "
  423.     DO GetCoords WITH SUBSTR(_CmdWindow.dbCalndr.Today.Text,2,2)
  424.     _CmdWindow.dbCalndr.Today.Text = " " + STR(_CmdWindow.dbCalndr.nDay, 2, 0) + " "
  425. RETURN
  426.  
  427.  
  428. *..........................................................................
  429. * Procedure Name:   UpdateProp
  430. * Parameters:       None
  431. * Ext Memvars:      _CmdWindow.dbCalndr
  432. * Description:      updates various text properties of _CmdWindow.dbCalndr to display
  433. *                   a new month.
  434. *..........................................................................
  435. PROCEDURE UpdateProp
  436.     _CmdWindow.dbCalndr.CalMth.Text = _CmdWindow.dbCalndr.cMYStr
  437.     _CmdWindow.dbCalndr.Week1.Text = dB5___wk[1]
  438.     _CmdWindow.dbCalndr.Week2.Text = dB5___wk[2]
  439.     _CmdWindow.dbCalndr.Week3.Text = dB5___wk[3]
  440.     _CmdWindow.dbCalndr.Week4.Text = dB5___wk[4]
  441.     _CmdWindow.dbCalndr.Week5.Text = dB5___wk[5]
  442.     _CmdWindow.dbCalndr.Week6.Text = dB5___wk[6]
  443. RETURN
  444.  
  445.  
  446. *......................................................................
  447. * Procedure Name:   SetDate
  448. * Parameters:       None
  449. * Ext Memvars:      _CmdWindow.dbCalndr
  450. * Description:      Creates a dialog for the user to enter a new date.
  451. *                   Then changes the calendar date to the new date.
  452. *......................................................................
  453. PROCEDURE SetDate
  454.     PRIVATE lVoid
  455.  
  456.     _CmdWindow.dbCalndr.dNewDate = Num2Date(_CmdWindow.dbCalndr.nDay, _CmdWindow.dbCalndr.nMth,; 
  457.                                  _CmdWindow.dbCalndr.nYear)
  458.                                  
  459.     #include "NEWDATE.DFM"
  460.     
  461.     IF (NewDate.Top) > (NLines() - 10)
  462.         NewDate.Top = NLines() - 10
  463.     ENDIF
  464.     
  465.     IF NewDate.Left > 50
  466.         NewDate.Left = 50
  467.     ENDIF    
  468.  
  469.     NewDate.lSCent = SET("CENTURY") = "ON"
  470.     SET CENTURY ON
  471.  
  472.     NewDate.e1.Value = _CmdWindow.dbCalndr.dNewDate
  473.     lVoid = NewDate.e1.SetFocus()            
  474.             
  475.     lVoid = NewDate.ReadModal()
  476.     
  477.     IF (NewDate.lFlag) .AND. (_CmdWindow.dbCalndr.dNewDate # NewDate.e1.Value)
  478.         _CmdWindow.dbCalndr.dNewDate = NewDate.e1.Value
  479.         DO InitDates WITH _CmdWindow.dbCalndr.dNewDate
  480.         DO UpdateProp
  481.         _CmdWindow.dbCalndr.nDay = DAY(_CmdWindow.dbCalndr.dNewDate)
  482.         _CmdWindow.dbCalndr.Today.Text = " " + STR(_CmdWindow.dbCalndr.nDay, 2, 0) + " "
  483.         DO GetCoords WITH SUBSTR(_CmdWindow.dbCalndr.Today.Text,2,2)
  484.     ENDIF
  485.     
  486.     IF .NOT. NewDate.lSCent
  487.         SET CENTURY OFF
  488.     ENDIF
  489.         
  490.     lVoid = NewDate.Release()
  491.     RELEASE NewDate
  492. RETURN 
  493.  
  494.  
  495. *...........................................................................
  496. * Procedure Name:   InitDates
  497. * Parameters:       dDate, date to use as the basis for building a calendar
  498. * Ext. Memvars:     dFirst, cMYStr
  499. * Description:      Initializes an array with the days of the month for
  500. *                   printing in the calendar.  Also sets some housekeeping
  501. *                   variables
  502. *...........................................................................
  503. PROCEDURE InitDates
  504. PARAMETERS dDate
  505.     PRIVATE nStart, nEnd, i, j, n
  506.  
  507.     SET TALK OFF        && Work around for SET TALK bug    
  508.  
  509.     _CmdWindow.dbCalndr.dFirst = FDoM(m->dDate)   && date of first day of month
  510.     _CmdWindow.dbCalndr.dLast  = LDoM(m->dDate)   && date of last day of month
  511.     _CmdWindow.dbCalndr.nDay   = DAY(m->dDate)    && current day
  512.     _CmdWindow.dbCalndr.nMth   = MONTH(m->dDate)  && current month
  513.     _CmdWindow.dbCalndr.nYear  = YEAR(m->dDate)   && current year
  514.     _CmdWindow.dbCalndr.cMYStr = SPACE(16)     && string holding current month and year
  515.  
  516.     nStart = DOW(_CmdWindow.dbCalndr.dFirst)   && day of week of first day of month
  517.     nEnd   = DAY(_CmdWindow.dbCalndr.dLast)    && day (numeric) of last day of month
  518.     n      = 1                      && day counter
  519.  
  520.     *..............................................................
  521.     * initialize the date array with the days of the current month
  522.     *..............................................................
  523.     FOR m->i = 1 TO 42
  524.         IF (m->i >= m->nStart) .AND. (m->n <= m->nEnd)  && if between 1st and last of mth
  525.             dB5___dat[m->i] = STR(m->n,2,0)
  526.             n = m->n + 1
  527.         ELSE
  528.             dB5___dat[m->i] = "  "    && if no date, use spaces
  529.         ENDIF
  530.     ENDFOR
  531.  
  532.     * create month/year string for top of calendar
  533.     _CmdWindow.dbCalndr.cMYStr = CMONTH(_CmdWindow.dbCalndr.dFirst)
  534.     DO WHILE LEN(_CmdWindow.dbCalndr.cMYStr) < 8    && month name must be 8 characters
  535.         * add leading spaces (if necessary)
  536.         _CmdWindow.dbCalndr.cMYStr = " " + _CmdWindow.dbCalndr.cMYStr
  537.     ENDDO
  538.     _CmdWindow.dbCalndr.cMYStr = _CmdWindow.dbCalndr.cMYStr + " " + STR(YEAR(_CmdWindow.dbCalndr.dFirst),4,0);
  539.         + "   " && + CHR(30) + "  " + CHR(31)
  540.  
  541.     n = 1
  542.  
  543.     *......................................
  544.     * build text strings for calendar page 
  545.     *......................................
  546.     FOR m->i = 1 TO 6
  547.         dB5___wk[m->i] = ""                       && clear week string
  548.         FOR m->j = 1 TO 7
  549.             * add date to week
  550.             dB5___wk[m->i] = dB5___wk[m->i] + dB5___dat[m->n]
  551.             IF j < 7                        && if not Saturday
  552.                 * add space before next date
  553.                 dB5___wk[m->i] = dB5___wk[m->i] + "  "
  554.             ENDIF
  555.             n = m->n + 1                       && next date in month
  556.         ENDFOR
  557.     ENDFOR
  558.  
  559. RETURN
  560.  
  561.  
  562. *....................................................
  563. * Procedure Name:   CalExit
  564. * Parameters:       None
  565. * Ext Memvars:      _CmdWindow.dbCalndr, db5___wk, dB5___dat
  566. * Description:      Closes and releases the calendar
  567. *....................................................
  568. PROCEDURE CalExit
  569.     PRIVATE lVoid
  570.     
  571.     lVoid = _CmdWindow.dbCalndr.Close()
  572.     lVoid = _CmdWindow.dbCalndr.Release()
  573.     _CmdWindow.dbCalndr = .F.
  574.     RELEASE dbCalndr, dB5___wk, dB5___dat
  575. RETURN
  576.  
  577.  
  578. *............................................................................
  579. * Procedure Name:   CopyDate
  580. * Parameters:       None
  581. * Ext Memvars:      None
  582. * Description:      Copies the selected date to the clipboard or to an entry
  583. *                   field.  Copies in the format selected in the options 
  584. *                   menu.
  585. *............................................................................
  586. PROCEDURE CopyDate
  587.     PRIVATE cDate, lSCent, cTmp, dTmp, cSDate
  588.     
  589.     cDate = DTOC(DATE())
  590.  
  591.     cSDate = SET("DATE")
  592.     SET DATE TO AMERICAN
  593.     dTmp = CTOD(STR(_CmdWindow.dbCalndr.nMth,2,0) + "/" + STR(_CmdWindow.dbCalndr.nDay,2,0);
  594.                 + "/" + STR(_CmdWindow.dbCalndr.nYear,4,0))
  595.     SET DATE TO &cSDate
  596.  
  597.     DO CASE
  598.         CASE _CmdWindow.dbCalndr.nDateFmt = kAmerican
  599.             SET DATE TO AMERICAN
  600.             cDate = DTOC(m->dTmp)
  601.         CASE _CmdWindow.dbCalndr.nDateFmt = kANSI
  602.             SET DATE TO ANSI
  603.             cDate = DTOC(m->dTmp)
  604.         CASE _CmdWindow.dbCalndr.nDateFmt = kBritish
  605.             SET DATE TO BRITISH
  606.             cDate = DTOC(m->dTmp)
  607.         CASE _CmdWindow.dbCalndr.nDateFmt = kGerman
  608.             SET DATE TO GERMAN
  609.             cDate = DTOC(m->dTmp)
  610.         CASE _CmdWindow.dbCalndr.nDateFmt = kItalian
  611.             SET DATE TO ITALIAN
  612.             cDate = DTOC(m->dTmp)
  613.         CASE _CmdWindow.dbCalndr.nDateFmt = kJapan
  614.             SET DATE TO JAPAN
  615.             cDate = DTOC(m->dTmp)
  616.         CASE _CmdWindow.dbCalndr.nDateFmt = kUSA
  617.             SET DATE TO USA
  618.             cDate = DTOC(m->dTmp)
  619.         CASE _CmdWindow.dbCalndr.nDateFmt = kMDYString
  620.             lSCent = SET("CENTURY") = "ON"
  621.             SET CENTURY ON
  622.             SET DATE TO &cSDate
  623.             cDate = MDY(m->dTmp)
  624.             IF .NOT. lSCent 
  625.                 SET CENTURY OFF
  626.             ENDIF    
  627.         CASE _CmdWindow.dbCalndr.nDateFmt = kDMYString
  628.             lSCent = SET("CENTURY") = "ON"
  629.             SET CENTURY ON
  630.             SET DATE TO &cSDate
  631.             cDate = DMY(m->dTmp)
  632.             IF .NOT. lSCent 
  633.                 SET CENTURY OFF
  634.             ENDIF    
  635.     ENDCASE
  636.  
  637.     _Clipboard.InsertLine = m->cDate
  638.     _Clipboard.ExtendSelection = .T.
  639.     _Clipboard.Column = 1
  640.     _Clipboard.ExtendSelection = .F.
  641.     
  642.     SET DATE TO &cSDate
  643. RETURN
  644.  
  645.  
  646. *..........................................................................
  647. * Procedure Name:   DateFrmt
  648. * Parameters:       None
  649. * Ext Memvars:      None
  650. * Description:      Sets the format of dates when copied from the calendar
  651. *..........................................................................
  652. PROCEDURE DateFrmt
  653.     PRIVATE nRet, nTmp, lVoid, lSCent, oRef, lFnd, i, n, cDStr
  654.     
  655.     nTmp = _CmdWindow.dbCalndr.nDateFmt
  656.     
  657.     lSCent = SET("CENTURY") = "ON"
  658.     SET CENTURY ON
  659.  
  660.     #include "SELDATE.DFM"
  661.  
  662.     IF (SelDate.Top) > (NLines() - 20)
  663.         SelDate.Top = NLines() - 20
  664.     ENDIF
  665.     
  666.     IF SelDate.Left > 50
  667.         SelDate.Left = 50
  668.     ENDIF
  669.     
  670.     IF m->nTmp > 0
  671.         m->i = 1
  672.         oRef = SelDate.r1
  673.         DO WHILE oRef.ClassName = "RADIOBUTTON"
  674.             IF m->i = m->nTmp
  675.                 oRef.Value = .T.
  676.                 lVoid = oRef.SetFocus()
  677.                 EXIT
  678.             ENDIF
  679.             oRef = oRef.After
  680.             i = m->i + 1
  681.         ENDDO
  682.     ELSE
  683.         cDStr = SET("DATE")
  684.         DO CASE
  685.             CASE ((m->cDStr = "AMERICAN") .OR. (m->cDStr = "MDY"))
  686.                 SelDate.r1.Value = .T.
  687.                 lVoid = SelDate.r1.SetFocus()
  688.             CASE m->cDStr = "ANSI"
  689.                 SelDate.r2.Value = .T.
  690.                 lVoid = SelDate.r2.SetFocus()
  691.             CASE ((m->cDStr = "BRITISH") .OR. (m->cDStr = "FRENCH") .OR. (m->cDStr = "DMY"))
  692.                 SelDate.r3.Value = .T.
  693.                 lVoid = SelDate.r3.SetFocus()
  694.             CASE m->cDStr = "GERMAN"                    
  695.                 SelDate.r4.Value = .T.
  696.                 lVoid = SelDate.r4.SetFocus()
  697.             CASE m->cDStr = "ITALIAN"
  698.                 SelDate.r5.Value = .T.
  699.                 lVoid = SelDate.r5.SetFocus()
  700.             CASE ((m->cDStr = "JAPAN") .OR. (m->cDStr = "YMD"))
  701.                 SelDate.r6.Value = .T.
  702.                 lVoid = SelDate.r6.SetFocus()
  703.             CASE m->cDStr = "USA"
  704.                 SelDate.r7.Value = .T.
  705.                 lVoid = SelDate.r7.SetFocus()
  706.         ENDCASE
  707.     ENDIF    
  708.  
  709.     lVoid = SelDate.ReadModal()
  710.  
  711.     IF SelDate.lFlag
  712.         DO CASE
  713.             CASE SelDate.r1.Value
  714.                 _CmdWindow.dbCalndr.nDateFmt = kAmerican
  715.             CASE SelDate.r2.Value
  716.                 _CmdWindow.dbCalndr.nDateFmt = kANSI
  717.             CASE SelDate.r3.Value
  718.                 _CmdWindow.dbCalndr.nDateFmt = kBritish
  719.             CASE SelDate.r4.Value
  720.                 _CmdWindow.dbCalndr.nDateFmt = kGerman
  721.             CASE SelDate.r5.Value
  722.                 _CmdWindow.dbCalndr.nDateFmt = kItalian
  723.             CASE SelDate.r6.Value
  724.                 _CmdWindow.dbCalndr.nDateFmt = kJapan
  725.             CASE SelDate.r7.Value
  726.                 _CmdWindow.dbCalndr.nDateFmt = kUSA
  727.             CASE SelDate.r8.Value
  728.                 _CmdWindow.dbCalndr.nDateFmt = kMDYString
  729.             CASE SelDate.r9.Value
  730.                 _CmdWindow.dbCalndr.nDateFmt = kDMYString
  731.         ENDCASE                
  732.     ENDIF
  733.     
  734.     lVoid = SelDate.Release()
  735.     RELEASE SelDate
  736.     
  737.     IF .NOT. lSCent
  738.         SET CENTURY OFF
  739.     ENDIF    
  740.     
  741. RETURN
  742.  
  743.  
  744. *.............................................................................
  745. * Procedure Name:   CHUsing
  746. * Parameters:       None
  747. * Ext Memvars:      None
  748. * Description:      Displays help information on how to select and copy dates
  749. *                   from the calendar, and how to change months.
  750. *.............................................................................
  751. PROCEDURE CHUsing
  752.     * TBD
  753. RETURN
  754.  
  755.  
  756. *............................................................
  757. * Procedure Name:   CHAbout
  758. * Parameters:       None
  759. * Ext Memvars:      None
  760. * Description:      Displays an "About" box for the calendar
  761. *............................................................
  762. PROCEDURE CHAbout
  763.     PRIVATE lVoid
  764.     
  765.     #include "CHABOUT.DFM"
  766.  
  767.     lVoid = HAbout.ReadModal()
  768.     
  769.     lVoid = HAbout.Release()
  770.     RELEASE HAbout
  771. RETURN
  772.  
  773.  
  774. *..........................................
  775. * Procedure Name:   PrAbout
  776. * Parameters:       None
  777. * Ext Memvars:      HAbout
  778. * Description:      Closes the form HAbout
  779. *..........................................
  780. PROCEDURE PrAbout
  781.     PRIVATE lVoid
  782.     
  783.     lVoid = HAbout.Close()
  784. RETURN    
  785.  
  786.  
  787. *......................................................................
  788. * Procedure Name:   IDEHelp
  789. * Parameters:       None
  790. * Ext Memvars:      None
  791. * Description:      Calls the help system with current object's HelpID
  792. *......................................................................
  793. PROCEDURE IDEHelp
  794.     PRIVATE lVoid
  795.     
  796.     _SysHelp.HelpID = This.HelpID
  797.     lVoid = _SysHelp.ReadModal()
  798. RETURN    
  799.  
  800.  
  801. *...........................................................................
  802. * Function Name:    Num2Date
  803. * Parameters:       nDay  - numeric representing a specific day of a month
  804. *                   nMth  - numeric representing a month (1 - 12)
  805. *                   nYear - numeric representing a year
  806. * Return Value:     d - numerics combined to form a date
  807. * Ext Memvars:      None
  808. * Description:      Takes 3 numeric arguments and attempts to create a date
  809. *                   from them.
  810. *...........................................................................
  811. FUNCTION Num2Date
  812.     PARAMETERS nDay, nMth, nYear
  813.  
  814.     PRIVATE d, cSDate
  815.     
  816.     cSDate = SET("DATE")
  817.     
  818.     SET DATE TO AMERICAN
  819.  
  820.     IF (TYPE("m->nDay") = "N") .AND. (TYPE("m->nMth") = "N") .AND.; 
  821.         (TYPE("m->nYear") = "N")
  822.         d = CTOD(STR(m->nMth,2,0) + "/" + STR(m->nDay,2,0) + "/" + STR(m->nYear,4,0))
  823.     ELSE
  824.         d = {}
  825.     ENDIF
  826.     
  827.     SET DATE TO &cSDate
  828.  
  829. RETURN d
  830.  
  831.  
  832. *........................................................................
  833. * Procedure Name:   PrOK
  834. * Parameters:       None
  835. * Ext Memvars:      NewDate    
  836. * Description:      Processes the OK button, sets a flag so that changes
  837. *                   get committed.
  838. *........................................................................
  839. PROCEDURE PrOK
  840.     PRIVATE lVoid
  841.     
  842.     NewDate.lFlag = .T.
  843.     lVoid = NewDate.Close()
  844. RETURN
  845.  
  846.  
  847. *............................................................................
  848. * Procedure Name:   PrCancel
  849. * Parameters:       None
  850. * Ext Memvars:      NewDate
  851. * Description:      Processes the Cancel button, sets a flag so that changes
  852. *                   are NOT committed
  853. *............................................................................
  854. PROCEDURE PrCancel
  855.     PRIVATE lVoid
  856.     
  857.     NewDate.lFlag = .F.
  858.     lVoid = NewDate.Close()
  859. RETURN
  860.  
  861.  
  862.  
  863. *........................................................................
  864. * Procedure Name:   Pr1OK
  865. * Parameters:       None
  866. * Ext Memvars:      SelDate    
  867. * Description:      Processes the OK button, sets a flag so that changes
  868. *                   get committed.
  869. *........................................................................
  870. PROCEDURE Pr1OK
  871.     PRIVATE lVoid 
  872.     
  873.     SelDate.lFlag = .T.
  874.     lVoid = SelDate.Close()
  875. RETURN
  876.  
  877.  
  878. *............................................................................
  879. * Procedure Name:   Pr1Cancel
  880. * Parameters:       None
  881. * Ext Memvars:      SelDate
  882. * Description:      Processes the Cancel button, sets a flag so that changes
  883. *                   are NOT committed
  884. *............................................................................
  885. PROCEDURE Pr1Cancel
  886.     PRIVATE lVoid 
  887.     
  888.     SelDate.lFlag = .F.
  889.     lVoid = SelDate.Close()
  890. RETURN
  891.  
  892.  
  893. *............................................................................
  894. * Function Name:    nLines
  895. * Parameters:       None
  896. * Ext Memvars:      None
  897. * Return Value:     numeric, the number of lines on the display
  898. * Description:      returns the number of lines on the display, based on the
  899. *                   current display mode.  If SET STATUS is on, the status
  900. *                   bar is treated as the last line.
  901. *............................................................................
  902. FUNCTION NLines
  903.     PRIVATE n
  904.     
  905.     n = VAL(RIGHT(ALLTRIM(SET("DISPLAY")),2))
  906.  
  907.     IF n = 0
  908.         n = 25
  909.     ENDIF
  910.     
  911.     IF SET("STATUS") = "ON"
  912.         n = m->n - 2
  913.     ENDIF    
  914.     
  915. RETURN m->n           
  916.  
  917.  
  918. *.....................................................................
  919. * The following functions are from the dUFLP library maintained by
  920. * Ken Mayer of Team Borland.  These functions are in the public 
  921. * domain.  The library may be downloaded from the Borland dBASE Forum
  922. * on CompuServe.
  923. *.....................................................................
  924.  
  925.  
  926. FUNCTION FDoM
  927. *-----------------------------------------------------------------------
  928. *-- Programmer..: Kenneth Chan [ZAK] (CIS: 72662,1305)
  929. *-- Date........: 01/05/1993
  930. *-- Notes.......: First Day of Month 
  931. *-- Written for.: dBASE IV, 1.5
  932. *-- Rev. History: 01/05/1993 -- Original Release
  933. *-- Calls.......: None
  934. *-- Called by...: Any
  935. *-- Usage.......: FDoM(<dArg>)
  936. *-- Example.....: ?FDOM(date())
  937. *-- Returns.....: Date
  938. *-- Parameters..: dArg = a Date argument -- function returns first day
  939. *--                      of the month of this date.
  940. *-----------------------------------------------------------------------
  941.  
  942.    parameter dArg
  943.  
  944. RETURN m->dArg - day( m->dArg ) + 1
  945. *-- EoF: FDoM()
  946.  
  947.  
  948. FUNCTION LDoM
  949. *-----------------------------------------------------------------------
  950. *-- Programmer..: Ken Chan [HazMatZak] (CIS: 72662,1305)
  951. *-- Date........: 02/26/1992
  952. *-- Notes.......: Last Day of Month -- Zak wrote this one up as a MUCH
  953. *--               shorter and more straightforward version of one I did.
  954. *--               >sigh<.  This function returns the date of the last
  955. *-                day of the month.
  956. *-- Written for.: dBASE IV, 1.1
  957. *-- Rev. History: 02/26/1992 -- Original Release
  958. *-- Calls.......: None
  959. *-- Called by...: Any
  960. *-- Usage.......: LDoM(<dDate>)
  961. *-- Example.....: ? LDoM(DATE())
  962. *-- Returns.....: dBASE Date
  963. *-- Parameters..: dDate  -- date to work from ...
  964. *-----------------------------------------------------------------------
  965.  
  966.    parameter dDate
  967.    private dNxtMonth
  968.    
  969.    dNxtMonth = m->dDate - day( m->dDate ) + 45 && middle of next month
  970.    
  971. RETURN m->dNxtMonth - day( m->dNxtMonth )
  972. *-- EoF: LDoM()
  973.  
  974.  
  975. * $Log:   /cms/dav.v/src/ide/calendar.prg,v  $
  976.