home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / calend3.zip / TEST_DAT.PRG < prev    next >
Text File  |  1992-04-26  |  5KB  |  99 lines
  1. /**************************************************************************
  2. ** Test Program for CALENDAR(), prompts user for different date formats. **
  3. ** - Rod Cushman                                                         **
  4. ** 04/26/92 10:07am                                                      **
  5. **************************************************************************/
  6.  
  7. #include "inkey.ch"
  8. #include "box.ch"
  9.  
  10.   dDate   := CtoD("")
  11.   mSelect := Date()
  12.  
  13.   Set Date to British
  14.  
  15.   Set Date Format to GetDateFmt( Set( _SET_DATEFORMAT ), 10, 26,          ;
  16.                                                           "w/r,r/w,,,b/w" )
  17.   nTopRow := 10
  18.   nLftCol := 25
  19. * cl      := "n/W,W+/n,,n/g"                            /* Mono Monitor  */
  20.   cl      := "W/B,B/W,,,I+"                             /* Color Monitor */
  21.   clear
  22. * @ 2,1 Say "Top Row : " get nTopRow    Picture '99'                      ;
  23. *                          Valid ( nTopRow < MaxRow()- 8 .and. nTopRow > 0)
  24. * @ 3,1 Say "Left Col: " get nLftCol    Picture '99'                      ;
  25. *                          Valid ( nLftCol < MaxCol()-21 .and. nLftCol > 0)
  26.   @ 4,1 Say "Color: "    get cl    Picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
  27.   Read
  28.   @ 6,1 Say "Date: "     get dDate Picture '@D'                           ;
  29.         Valid Iif(Empty(dDate),                                           ;
  30.                  (dDate := CALENDAR(dDate, nTopRow, nLftCol, cl),.t.),.t. )
  31.   Read
  32.  
  33. * dDate := CALENDAR(dDate, nTopRow, nLftCol, cl)
  34. * dDate := CALENDAR(Date(), nTopRow, nLftCol, cl)
  35.   @ 23,10 say "You Selected: " + DtoC(dDate)
  36. Return dDate
  37.  
  38.  
  39. /**************************************************************************
  40. ** Function DispWin                                                      **
  41. **      clear window area and draw box for window                        **
  42. **************************************************************************/
  43. Static Function DispWin
  44.   Parameters nT,nL,nB,nR, cColor               /* top row, bot. row, etc */
  45.  
  46.   cColor := Iif( cColor = NIL, SetColor(), cColor)
  47.   SetColor( cColor )
  48.   DispBegin()
  49.   @ nT,nL CLEAR TO nB,nR
  50.   @ nT,nL,nB,nR BOX B_DOUBLE_SINGLE  Color cColor
  51.   DispEnd()
  52. Return  NIL
  53.  
  54.  
  55. /**************************************************************************
  56. ** GetDateFmt( cDefaultFormat, nTop, nLft, cColor )                      **
  57. **      Pop - Up Menu for Date Format selection. Returns character string**
  58. **      for chosen date format...                                        **
  59. **************************************************************************/
  60. Function GetDateFmt( cDefaultFmt, nTop, nLft, cColor )
  61.   Local cFmt   := cDefaultFmt,                                            ;
  62.         nFmt   := 1,                                                      ;
  63.         sWin   := "",                                                     ;
  64.         tTop   := 11,                                                     ;
  65.         tLft   := 63,                                                     ;
  66.         coColr := SetColor()
  67.         acFmt  := {   "mm/dd/yy", "yy.mm.dd", "dd/mm/yy", "dd/mm/yy",     ;
  68.                       "dd.mm.yy", "dd-mm-yy", "yy/mm/dd", "mm-dd-yy",     ;
  69.                       Set( _SET_DATEFORMAT )                              ;
  70.                   }
  71.  
  72.                                    /* Establish Calendar box coordinates */
  73.   tTop     := If(nTop == NIL, 0, If(nTop > MaxRow()-13, MaxRow()-13, nTop))
  74.   tLft     := If(nLft == NIL, 0, If(nLft > MaxCol()-17, MaxCol()-17, nLft))
  75.  
  76.   KeyBoard Chr(K_HOME) + Replicate(Chr(K_DOWN),                           ;
  77.                                              AScan( acFmt, cDefaultFmt)-1 )
  78.   sWin   := SaveScreen(tTop, tLft, tTop+13, tLft+15)
  79.  
  80.   DispBegin()
  81.   SetColor( cColor )
  82.   DispWin( tTop, tLft, tTop+10, tLft+25, cColor )
  83.   @ tTop+ 0, tLft+1 Say    " SELECT FORMAT "  Color cColor
  84.   @ tTop+ 1, tLft+1 Prompt "1)  American - mm/dd/yy "
  85.   @ tTop+ 2, tLft+1 Prompt "2)  ANSI     - yy.mm.dd "
  86.   @ tTop+ 3, tLft+1 Prompt "3)  British  - dd/mm/yy "
  87.   @ tTop+ 4, tLft+1 Prompt "4)  French   - dd/mm/yy "
  88.   @ tTop+ 5, tLft+1 Prompt "5)  German   - dd.mm.yy "
  89.   @ tTop+ 6, tLft+1 Prompt "6)  Italian  - dd-mm-yy "
  90.   @ tTop+ 7, tLft+1 Prompt "7)  Japan    - yy/mm/dd "
  91.   @ tTop+ 8, tLft+1 Prompt "8)  USA      - mm-dd-yy "
  92.   @ tTop+ 9, tLft+1 Prompt "9)  Current  - " + Set( _SET_DATEFORMAT )
  93.   DispEnd()
  94.   Menu to nFmt
  95.  
  96.   SetColor( coColr )
  97.   RestScreen( tTop, tLft, tTop+10, tLft+25, sWin )
  98. Return acFmt[ Iif(Empty(nFmt), 1, nFmt) ]
  99.