home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / dateget.zip / DATEGET.PRG
Text File  |  1991-06-02  |  3KB  |  105 lines
  1. * USAGE:
  2. *
  3. * DO DateGet WITH datebeg,bg_dte,dateend,eg_dte,dateemy
  4. *
  5. *   datebeg...  .T. = The proceedure will     get a Beginning Date
  6. *               .F. = The proceedure will not get a Beginning Date
  7. *
  8. *   bg_dte....  The default beginning date
  9. *
  10. *   dateend...  .T. = The proceedure will     get an Ending Date
  11. *               .F. = The proceedure will not get an Ending Date
  12. *
  13. *   eg_dte....  The default ending date
  14. *
  15. *   dateemy...  .T. The date will be obtained in MM/YY format
  16. *                     bg_dte will be returned as the first day of the month
  17. *                     eg_dte will be returned as the last  day of the month
  18. *
  19. *               .F. The date will be obtained in MM/DD/YY format
  20. *
  21. *   EOM(mdate)  A UDF() that returns the date of the last day in the month
  22. *                 and year of mdate
  23.  
  24.  
  25. PROCEDURE DateGet
  26. PARAMETER datebeg,bg_dte,dateend,eg_dte,datemy
  27. PRIVATE beg_msg,beg_dte,end_msg,end_dte,date_pict,old_talk
  28. IF .NOT. (datebeg .OR. dateend)
  29.   RETURN TO Main_Mnu
  30. ENDIF
  31. old_talk=SET("TALK")
  32. SET TALK OFF
  33. SET BORDER TO SINGLE
  34. DEFINE WINDOW dateget FROM 10,10 TO 16,47 COLOR W+/BG,BG+/N,BG+/N
  35. ACTIVATE WINDOW dateget
  36. beg_msg=IIF(dateend,'Beginning ','Enter ')+'Date - '+;
  37.   IIF(datemy,'[MM/YY]','[MM/DD/YY]')
  38. beg_dte=IIF(datemy,LEFT(DTOC(bg_dte),3)+RIGHT(DTOC(bg_dte),2),bg_dte)
  39. end_msg=IIF(datebeg,'   Ending ','Enter ')+'Date - '+;
  40.   IIF(datemy,'[MM/YY]','[MM/DD/YY]')
  41. end_dte=IIF(datemy,LEFT(DTOC(eg_dte),3)+RIGHT(DTOC(eg_dte),2),eg_dte)
  42. date_pict=IIF(datemy,'99/99','99/99/99')
  43. ON KEY LABEL LEFTARROW ?? ""
  44. ON KEY LABEL RIGHTARROW ?? ""
  45. ON KEY LABEL UPARROW ?? ""
  46. ON KEY LABEL DNARROW ?? ""
  47. DO WHILE .T.
  48.   IF datebeg
  49.     @ 1,1 SAY beg_msg GET beg_dte PICTURE date_pict
  50.   ENDIF
  51.   IF dateend
  52.     @ 3,1 SAY end_msg GET end_dte PICTURE date_pict
  53.   ENDIF
  54.   CLEAR TYPEAHEAD
  55.   READ
  56.   IF LASTKEY()=27
  57.     EXIT
  58.   ENDIF
  59.   IF datemy
  60.     IF datebeg
  61.       beg_dte=CTOD(LEFT(beg_dte,3)+'01'+RIGHT(beg_dte,3))
  62.     ENDIF
  63.     IF dateend
  64.       end_dte=CTOD(LEFT(end_dte,3)+'01'+RIGHT(end_dte,3))
  65.       end_dte=EOM(end_dte,0)
  66.     ENDIF
  67.   ENDIF
  68.   DO CASE
  69.     CASE datebeg .AND. dateend .AND. beg_dte>end_dte
  70.       ? CHR(7)
  71.       LOOP
  72.     CASE datebeg .AND. dateend
  73.       bg_dte=beg_dte
  74.       eg_dte=end_dte
  75.     CASE datebeg
  76.       bg_dte=beg_dte
  77.     CASE dateend
  78.       eg_dte=end_dte
  79.   ENDCASE
  80.   EXIT
  81. ENDDO
  82. ON KEY LABEL LEFTARROW
  83. ON KEY LABEL RIGHTARROW
  84. ON KEY LABEL UPARROW
  85. ON KEY LABEL DNARROW
  86. SET TALK &old_talk
  87. RELEASE WINDOW dateget
  88. RETURN
  89.  
  90.  
  91. FUNCTION EOM
  92. PARAMETERS date_now,months
  93. PRIVATE mdate,yr,mo,mo_use,yr_use
  94. IF months>=0
  95.   yr_use=YEAR(date_now)+INT(months/12)
  96.   mo_use=MONTH(date_now)+MOD(months,12)
  97. ELSE
  98.   yr=YEAR(date_now)+INT(months/12)
  99.   mo=MONTH(date_now)-MOD(ABS(months),12)
  100.   mo_use=IIF(mo<1,mo+12,mo)
  101.   yr_use=IIF(mo<1,yr-1,yr)
  102. ENDIF
  103. RETURN CTOD(STR(mo_use+1,2)+'/01/'+STR(yr_use,4))-1
  104.  
  105.