home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / GETDATE.PRG < prev    next >
Encoding:
Text File  |  1991-04-29  |  4.0 KB  |  117 lines
  1. /*
  2.     Function: GETDATE()
  3.     System: GRUMPFISH LIBRARY
  4.     Author: Greg Lief
  5.     Copyright (c) 1988-90, Greg Lief
  6.     Clipper 5.01 version
  7.     Compile instructions: clipper getdate /n/w/a
  8.  
  9.     Procs & Funcs: GETDATE()
  10.  
  11.           Calls: CALENDBOX()    (function  in $CALENDA.PRG)
  12.                : NEXTMONTH()    (function  in $CALENDA.PRG)
  13. */
  14.  
  15. //───── begin preprocessor directives
  16.  
  17. #include "grump.ch"
  18. #include "inkey.ch"
  19. #define CURRENTYEAR     substr(dtos(mdate), 1, 4)
  20. #define CURRENTDAY      substr(dtos(mdate), 7)
  21.  
  22. //───── end preprocessor directives
  23.  
  24. function getdate(mdate, mtop, mleft, maincolor)
  25. local row, tdate, lastday, newrow, newcol, tempdate, datecoords, ;
  26.       xx, redraw, olddelete := set(_SET_DELETED, .T.), keypress
  27.  
  28. //───── use system date as starting date if not passed as parameter
  29. //───── determine screen position and color if not passed as parameters
  30. mdate := if(empty(mdate), date(), mdate)
  31. default mtop to 6
  32. default mleft to 28
  33. default maincolor to ColorSet(C_CALENDAR, .T.)
  34.  
  35. GFSaveEnv( { mtop, mleft, mtop + 13, mleft + 23 }, 0 )  // shut off cursor
  36. datecoords := CalendBox(.f., mtop, mleft, mdate, maincolor, .t.)
  37. //───── commence main keypress loop
  38. do while .t.
  39.    redraw := .f.
  40.    keypress := ginkey(0)
  41.    tdate := mdate                  && store highlighted date
  42.    newrow := CURRENTDAY_ROW
  43.    newcol := CURRENTDAY_COL
  44.    do case
  45.  
  46.    case keypress == K_DOWN .or. keypress == K_UP   // forward/backward one week
  47.       mdate += if(keypress = 24, 7, -7)
  48.       newrow  += if(keypress = 24, 1, -1)
  49.  
  50.    case keypress == K_LEFT         // go back one day
  51.       mdate--
  52.       //───── did we just go from sunday to saturday??
  53.       newrow := if(dow(mdate) = 7, CURRENTDAY_ROW - 1, CURRENTDAY_ROW)
  54.       newcol := if(dow(mdate) = 7, mleft + 19, CURRENTDAY_COL - 3)
  55.  
  56.    case keypress == K_RIGHT       // go forward one day
  57.       mdate++
  58.       //───── did we just go from saturday to sunday??
  59.       newrow := if(dow(mdate) = 1, CURRENTDAY_ROW + 1, CURRENTDAY_ROW)
  60.       newcol := if(dow(mdate) = 1, mleft + 1, CURRENTDAY_COL + 3)
  61.  
  62.    case keypress == K_PGUP        // go back one month
  63.       if month(mdate) == 1        // going to December of previous year
  64.          mdate := stod( str(val(CURRENTYEAR)-1, 4) + '12' + CURRENTDAY)
  65.       else
  66.          //───── check for validity of current date in previous month
  67.          //───── i.e., cannot go from march 31 to february 31, etcetera
  68.          tempdate := ctod('')
  69.          do while empty(tempdate)
  70.             tempdate := stod(CURRENTYEAR + if(month(mdate) < 11, '0', '') + ;
  71.                         ltrim(str(month(mdate) - 1)) + CURRENTDAY)
  72.             mdate--
  73.          enddo
  74.          mdate := tempdate
  75.       endif
  76.  
  77.    case keypress == K_PGDN        // go forward one month
  78.       mdate := NextMonth(mdate)
  79.  
  80.    case keypress == K_HOME        // go to first day
  81.       newrow := FIRSTDAY_ROW
  82.       newcol := FIRSTDAY_COL
  83.       mdate := stod(substr(dtos(mdate), 1, 6) + '01')
  84.  
  85.    case keypress == K_END         // go to last day
  86.       newrow := LASTDAY_ROW
  87.       newcol := LASTDAY_COL
  88.       mdate := stod(substr(dtos(mdate), 1, 6) + str(LASTDAY_NUMBER, 2))
  89.  
  90.    case keypress == K_ENTER .or. keypress == K_ESC   // enter or esc - quit
  91.       exit
  92.  
  93.    otherwise                  // any other keystroke
  94.       loop
  95.  
  96.    endcase
  97.    //───── if we changed months, redraw calendar
  98.    if month(tdate) != month(mdate) .or. redraw
  99.       datecoords := CalendBox(.f., mtop, mleft, mdate, maincolor)
  100.    else
  101.       @ CURRENTDAY_ROW, CURRENTDAY_COL ssay str(day(tdate),2) ;
  102.             color '+' + maincolor
  103.       @ newrow, newcol ssay str(day(mdate), 2) color '*+' + maincolor
  104.       //───── store new row/column coordinates for highlighted date
  105.       CURRENTDAY_ROW := newrow
  106.       CURRENTDAY_COL := newcol
  107.    endif
  108. enddo
  109.  
  110. GFRestEnv()
  111. return if(keypress == K_ENTER, mdate, ctod(""))
  112.  
  113. * end function GetDate()
  114. *--------------------------------------------------------------------*
  115.  
  116. * eof getdate.prg
  117.