home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / CALEND3 / TESTTIME.PRG < prev   
Text File  |  1992-04-12  |  4KB  |  86 lines
  1. /**************************************************************************
  2. ** TESTTIME.PRG                                                          **
  3. **      Test Program for CALENDAR(), outputs to file the beginning,      **
  4. **      ending and current system date.  Program creates a data file for **
  5. **      another program written by KinWah Nelson Ng, which creates a     **
  6. **      plot of the data created by this program and another related     **
  7. **      module.                                                          **
  8. **                                      Mod User:       Rod Cushman      **
  9. **                                      Mod Date:       04/12/92 03:44pm **
  10. **************************************************************************/
  11.  
  12. #include "Inkey.ch"
  13. #include "Box.ch"
  14.  
  15.   BegDate := CtoD("")
  16.   EndDate := CtoD("")
  17.   CurDate := Date()
  18.   mSelect := Date()
  19.   nTopRow      := 10
  20.   nLftCol      := 25
  21. * cColor      := "n/W,W+/n,,n/g"                        /* Mono Monitor  */
  22.   cColor      := "W/B,B/W,,,I+"                         /* Color Monitor */
  23.   Clear
  24.  
  25. * @ 2,1 say "Top Row : " get nTopRow    Picture '99'                      ;
  26. *                          Valid ( nTopRow < MaxRow()- 8 .and. nTopRow > 0)
  27. * @ 3,1 say "Left Col: " get nLftCol    Picture '99'                      ;
  28. *                          Valid ( nLftCol < MaxCol()-21 .and. nLftCol > 0)
  29. * @ 4,1 say "Color: "    get cColor    Picture '!!!!!!!!!!!!!!!!!!!!!!!!!!'
  30. * Read
  31.  
  32. * dDate  := CALENDAR(dDate, nTopRow, nLftCol, cColor)
  33.  
  34.  
  35.   aDates := GetDateRng( Date(), BegDate, EndDate, nTopRow, nLftCol, cColor)
  36.  
  37.   @ 20,10 say "You Selected: ( " + DtoC(aDates[1])+", "+DtoC(aDates[2])+" )"
  38.   @ 21,10 say "Difference =  " + StrZero( aDates[2] - aDates[1] , 4, 0)
  39.   @ 22,10 Say "Today's Date: " + DtoC( Date() )
  40.   @ 23,10 Say "Diff(CurDate,BegDate) : " + StrZero(Date()-aDates[1],4,0)+ ;
  41.               "   Diff(CurDate,EndDate) : " +StrZero(Date()-aDates[2],4,0)
  42.   @ 24,10 Say "Press Any Key"
  43.   InKey(0)
  44. Return NIL
  45.  
  46.  
  47. /**************************************************************************
  48. ** GetDateRng( nDefaultDate, dBegDate, dEndDate, nTop, nLft, cColor)     **
  49. **      Pop - Up Edit of Date Range, returns validated range.            **
  50. **************************************************************************/
  51. Static Function GetDateRng( nDefaultDate, dBegDate, dEndDate, nTop, nLft, ;
  52.                          cColor )
  53.   Local sWin := SaveScreen(nTop, nLft, nTop+4, nLft+27),                  ;
  54.         oGetList := GetList
  55.    GetList := {}                              /* Save old GetList, Reset */
  56.    DispWin( nTop, nLft, nTop+4, nLft+27, cColor )
  57.    @ nTop+ 0, nLft+3 Say     " SELECT DATE RANGE "  Color cColor
  58.    @ nTop+ 1, nLft+1 Say "BEGINNING DATE "   Get dBegDate Picture '@D'    ;
  59.         Valid Iif(Empty(dBegDate),                                        ;
  60.              (dBegDate:=CALENDAR(dBegDate,nTop+1,nLft+29,cColor),.t.),.t.)
  61.    @ nTop+ 3, nLft+1 Say "ENDING DATE    "   Get dEndDate Picture '@D'    ;
  62.         Valid Iif(Empty(dEndDate),                                        ;
  63.              (dEndDate:=CALENDAR(dEndDate,nTop,nLft+29,cColor),.t.),.t.)  ;
  64.              .and. (dEndDate > dBegDate)
  65.    Read
  66.  
  67.    RestScreen( nTop, nLft, nTop+4, nLft+27, sWin )
  68.    GetList := oGetList                          /* Restore prior GetList */
  69. Return { dBegDate, dEndDate }
  70.  
  71.  
  72. /**************************************************************************
  73. ** Function DispWin                                                      **
  74. **      clear window area and draw box for window                        **
  75. **************************************************************************/
  76. Static Function DispWin
  77.   Parameters nT,nL,nB,nR, cColor               /* top row, bot. row, etc */
  78.  
  79.   cColor := Iif( cColor = NIL, SetColor(), cColor)
  80.   SetColor( cColor )
  81.   DispBegin()
  82.   @ nT,nL CLEAR TO nB,nR
  83.   @ nT,nL,nB,nR BOX B_DOUBLE_SINGLE  Color cColor
  84.   DispEnd()
  85. Return  NIL
  86.