home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR7 / FOXTAILS.ZIP / GET_DATE.PRG < prev    next >
Text File  |  1992-03-28  |  5KB  |  133 lines
  1. FUNCTION Get_Date
  2. PARAMETER Dt
  3. *    Written by R.L. Coppedge
  4. *    Copyright 1992 dbF Software Productions
  5. *    By the way, dbF also has:
  6. *    SysTrak        A Computer Hardware/Software Inventory System
  7. *    Flags        A Flatfile Application Gen. for db3,4 and Fox
  8. *    ClasAdz        A Classified/Notice system for Networks
  9. *    FerretPro    A collection of FoxPro tools (like this one)
  10. *    Contact dbF for more information.
  11. *    dbF Software Productions
  12. *    P.O. Box 37194
  13. *    Cleve., Ohio 44137-0194
  14. *    CIS: 72117,165
  15. *    (216)491-4581
  16. *
  17. *    This code may be modified, but leave this original notice up
  18. *    here intact, if ya don't mind.  (Add your own comments about
  19. *    how much better you made it if you like)
  20. *    What this function does is display a calendar format so that
  21. *    the user can grab a date.  It isn't a VALIDation, per se, but
  22. *    an entry piece.  See the sample code (SAMPLE, which wins the
  23. *    Irving Forbush Original Program Name of the Year Award) for
  24. *    an example of how this would all work.
  25. Tk = SET("Talk")
  26. M = CMONTH(Dt)
  27. Y = YEAR(Dt)
  28. DEFINE WINDOW Get_Date FROM 2,5 TO 19,50 DOUBLE TITLE "Get A Date"
  29. ACTIVATE WINDOW Get_Date
  30. *    1st we place the skeleton onto the window
  31. @ 0,0 SAY "│" + SPACE(20) + "│"
  32. @ 1,0 SAY "│Su Mo Tu We Th Fr Sa│"
  33. @ 2,0 SAY "├──┬──┬──┬──┬──┬──┬──┤"
  34. @ 3,0 SAY "│  │  │  │  │  │  │  │"
  35. @ 4,0 SAY "├──┼──┼──┼──┼──┼──┼──┤"
  36. @ 5,0 SAY "│  │  │  │  │  │  │  │"
  37. @ 6,0 SAY "├──┼──┼──┼──┼──┼──┼──┤"
  38. @ 7,0 SAY "│  │  │  │  │  │  │  │"
  39. @ 8,0 SAY "├──┼──┼──┼──┼──┼──┼──┤"
  40. @ 9,0 SAY "│  │  │  │  │  │  │  │"
  41. @10,0 SAY "├──┼──┼──┼──┼──┼──┼──┤"
  42. @11,0 SAY "│  │  │  │  │  │  │  │"
  43. @12,0 SAY "├──┼──┼──┼──┼──┼──┼──┤"
  44. @13,0 SAY "│  │  │  │  │  │  │  │"
  45. @14,0 SAY "└──┴──┴──┴──┴──┴──┴──┘"
  46.  
  47. D = Dt
  48. Butn = 0
  49. Cntr = 0
  50. DO WHILE .T.
  51. *    Now we place the title line for month and date
  52.     Tstr = CMONTH(D) + " "+STR(YEAR(D),4)
  53.     Tstr = IIF(LEN(Tstr)/2=INT(LEN(Tstr)/2),Tstr,Tstr+" ")
  54.     Ln1 = "│"+SPACE((20-LEN(Tstr))/2) + Tstr +SPACE((20-LEN(Tstr))/2) +"│"
  55.     @0,0 SAY Ln1
  56. *    Now we figure out how many days there are...
  57.     Dys = IIF(INLIST(MONTH(D),4,6,9,11),30,31)
  58.     IF MONTH(D) = 2            &&    Oh, yeah...February
  59.         Dys = IIF(YEAR(D)/4=INT(YEAR(D)/4) AND YEAR(D)/1000 <> INT(YEAR(D)/1000) ,29,28)
  60.     ENDIF
  61. *    Now, let's place the numbers in their respective spots
  62.     Bd = D-DAY(D)+1
  63.     FOR X = 1 TO 42        &&    There're 42 spaces (7 columns, 6 Rows)
  64.         Shw= IIF(X < DOW(Bd) OR X>=Dys+DOW(Bd),"  ",STR(X-DOW(Bd)+1,2,0))
  65.         @3+INT((X-1)/7)*2, 3*((X-1)-INT((X-1)/7)*7)+1 SAY Shw
  66.     ENDFOR
  67. *    This is kinda tricky...basically the whole thing is 6 Invisible
  68. *    Box GETs with many of the beginning and ending week disabled,
  69. *    depending on the day of the week that the month begins
  70. *    So we have to create for week 1,5,6 the proper PICTURE.
  71.     W1pic = "@*IHT " + REPLICATE(";",7-(DOW(Bd)-1)-1)
  72.     W5num = IIF(Dys-(21+7-(DOW(Bd)-1))>7,7,Dys-(21+7-(DOW(Bd)-1)))
  73.     W5pic = "@*IHT " + REPLICATE(";",W5num-1)
  74.     W6num = Dys-(28+7-(DOW(Bd)-1))
  75.     W6pic = IIF(W6num>0,"@*IHT " + REPLICATE(";",W6num-1),"")
  76.     FOR Nn = 1 TO DAY(Dt) - 1
  77.         KEYBOARD "{RIGHTARROW}"
  78.     ENDFOR
  79.     @3,1+3*(DOW(Bd)-1) GET W1 PICTURE W1pic SIZE 1,2,1 DEFAULT 1 VALID Chk("1")
  80. *    Notice that Week # 2,3,4 are ALWAYS the same.
  81.     @5,1 GET W2 PICTURE "@*IHT ;;;;;;" SIZE 1,2,1 DEFAULT 1 VALID Chk("2")
  82.     @7,1 GET W3 PICTURE "@*IHT ;;;;;;" SIZE 1,2,1 DEFAULT 1 VALID Chk("3")
  83.     @9,1 GET W4 PICTURE "@*IHT ;;;;;;" SIZE 1,2,1 DEFAULT 1 VALID Chk("4")
  84.     @11,1 GET W5 PICTURE W5pic SIZE 1,2,1 DEFAULT 1 VALID Chk("5")
  85.     IF !EMPTY(W6pic)
  86.         @13,1 GET W6 PICTURE W6pic SIZE 1,2,1 DEFAULT 1 VALID Chk("6")
  87.     ENDIF
  88. *    Or the user may want to move by month or year.
  89.     MvPic = "@*VT -M;+M;-Y;+Y;Today;"+DTOC(Dt)
  90.     @3,28 GET Mv PICTURE Mvpic DEFAULT 1 VALID Chk("M")
  91.     READ CYCLE
  92.     IF LASTKEY() = 27        &&    They hit escape...adios!
  93.         RELEASE WINDOW Get_Date
  94.         IF Tk = "ON"
  95.             SET TALK ON
  96.         ENDIF
  97.         RETURN Dt        &&    Return original value.
  98.     ENDIF
  99.     IF Butn = 0            &&    They didn't hit a date number!
  100.         DO CASE
  101.         CASE Mv = 1            &&    Back one month
  102.         D = GOMONTH(D,-1)
  103.         CASE Mv = 2            &&    Forward one month
  104.         D = GOMONTH(D,1)
  105.         CASE Mv = 3            &&    Back one year
  106.         D = GOMONTH(D,-12)
  107.         CASE Mv = 4            &&    Forward one year
  108.         D = GOMONTH(D,12)
  109.         CASE Mv = 5            &&    go to today's date
  110.         D = DATE()
  111.         CASE Mv = 6            &&    Reset to Original Date
  112.         D = Dt
  113.         ENDCASE
  114.         LOOP
  115.     ENDIF
  116.     IF Butn = 1        &&    They hit during the 1st week...
  117.         Andy = STR(W1,2)
  118.     ELSE
  119.         Andy = STR((Butn-1)*7 + EVALUATE("W"+STR(Butn,1)) - DOW(Bd)+1,2)
  120.     ENDIF
  121.     Ans = CTOD(STR(MONTH(D),2)+"/" +Andy + "/"+STR(YEAR(D),4))
  122.     RELEASE WINDOW Get_Date
  123.     IF Tk = "ON"
  124.         SET TALK ON
  125.     ENDIF
  126.     RETURN Ans
  127. ENDDO
  128.  
  129. PROCEDURE Chk
  130. PARAMETER What            &&    We need this to tell which row they hit.
  131. Butn = VAL(What)
  132. RETURN .T.
  133.