home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a075 / 1.img / TOOLKIT1.EXE / SST902.PRG < prev    next >
Encoding:
Text File  |  1989-08-08  |  8.6 KB  |  244 lines
  1. *******************
  2.  
  3. PROCEDURE Calend
  4.  
  5.    PARAMETERS p, l, v
  6.  
  7.    PRIVATE _poprow, _popcol, _inmont, _inyear, _inday, _curcol
  8.    PRIVATE _calendscr, _oldcolor, _begdate, _mkdate, _base, _enddate, _retto
  9.    PRIVATE _qaz, _dispdate, _justcolor, _currow, _retins, _ncolor, _date
  10.    PRIVATE _days, _dates[31], _chandle, _ctemp, _ccct
  11.  
  12.    SETKEYOFF()
  13.  
  14.    _date     = DATE()
  15.    _inmont   = MONTH(_date)
  16.    _inyear   = YEAR(_date)
  17.    _inday    = DAY(_date)
  18.    _chandle  = FOPEN("\CALEND.POS", 2)
  19.    IF _chandle > 0    && the file exists
  20.       _ccct = SPACE(4)
  21.       _ctemp = FREAD(_chandle, @_ccct, 4)
  22.       _currow= VAL(SUBSTR(_ccct, 1, 2))
  23.       _curcol= VAL(SUBSTR(_ccct, 3))
  24.       FCLOSE(_chandle)
  25.    ELSE
  26.       _currow   = 1
  27.       _curcol   = IF(COL() <= 35, 45, 4)
  28.    ENDIF
  29.    IF TYPE("scrcursor") = "U"
  30.       scrcursor = .T.
  31.    ENDIF
  32.    SET CURSOR OFF
  33.    _oldcolor = SETCOLOR()
  34.    _retins   = READINSERT()
  35.    _ncolor   = IF((ISCOLOR() .AND. !(IF(TYPE("scrmono")="U", .T., scrmono))), "W/B", SETCOLOR())
  36.    DO WHILE .T.
  37.       BEGIN SEQUENCE
  38.       WINDOWPUSH(_currow,_curcol, _currow+16,_curcol+29,"","","","","","",.T.)
  39.       DO WHILE .T.
  40.          _file = "NT" + SUBSTR(DTOS(_date), 3) + "."
  41.          SAYCAL()
  42.          _begdate = CTOD(STR(_inmont,2) + "/01/" + ;
  43.                     SUBSTR(TRANSFORM(_inyear,"9999"),3,2))
  44.          IF _inday > EOM(_inmont, VAL(SUBSTR(TRANSFORM(_inyear,"9999"),3,2)))
  45.             _inday = EOM(_inmont, VAL(SUBSTR(TRANSFORM(_inyear,"9999"),3,2)))
  46.          ENDIF
  47.          _mkdate = CTOD(STR(_inmont,2) + "/" + STR(_inday,2) + "/" + ;
  48.                    SUBSTR(TRANSFORM(_inyear,"9999"),3,2))
  49.          _base = 31
  50.          DO WHILE .T.
  51.             _enddate = _begdate + _base
  52.             IF MONTH(_begdate) = MONTH(_enddate)
  53.                EXIT
  54.             ENDIF
  55.             _base = _base - 1
  56.          ENDDO
  57.          @ WROW(1),WCOL(5) SAY CMONTH(_mkdate) + " " + ;
  58.            TRANSFORM(DAY(_mkdate), "99") + ", " + ;
  59.            SUBSTR(DTOS(_mkdate), 1, 4)
  60.          _retto = COL()
  61.          IF DOW(_begdate) = 1
  62.             @ WROW(3),WCOL() + ((DOW(_begdate) * 4) - 4) SAY ""
  63.          ELSE
  64.             @ WROW(5),WCOL() + ((DOW(_begdate) * 4) - 4) SAY ""
  65.          ENDIF
  66.          FOR _qaz = _begdate TO _enddate
  67.             IF DOW(_qaz) = 1
  68.                @ ROW()+2,_curcol+1 SAY ""
  69.             ELSE
  70.                @ ROW(),COL()+1 SAY ""
  71.             ENDIF
  72.             _dispdate = TRANSFORM(DAY(_qaz), "999")
  73.             IF _date = _qaz
  74.                _justcolor = SET_COLOR(ATTRIBUTE(ROW(),COL()))
  75.                _justcolor = SUBSTR(_justcolor, 1, AT("/", _justcolor)-1) + "+*" + SUBSTR(_justcolor, AT("/", _justcolor))
  76.                SETCOLOR(REVERSE(SETCOLOR(_justcolor)))
  77.                @ ROW(),COL() SAY _dispdate
  78.                SETCOLOR(_ncolor)
  79.  
  80.             ELSE
  81.                @ ROW(),COL() SAY _dispdate
  82.             ENDIF
  83.          NEXT
  84.          @ WROW(2),WCOL(1) SAY ""
  85.          _whatkey = INKEY(0)
  86.          IF _whatkey = 22
  87.             READINSERT(!READINSERT())
  88.             IF READINSERT()
  89.                KEYBOARD CHR(32)    && Kick in the scrolling routine
  90.             ENDIF
  91.  
  92.          ELSEIF _whatkey = 27
  93.             EXIT
  94.          ELSEIF _whatkey = 28
  95.             WINDOWPUSH(WROW(1),WCOL(2),WROW(12),WCOL(27),"","","","","","",.T.)
  96.             WSAYGET(2,2,"This is a Help Screen")
  97.             WSAYGET(4,2,"ENTER for Note Pad")
  98.             WSAYGET(5,2,"INS key to drag frame")
  99.             WSAYGET(6,2,"Arrow Keys alter date")
  100.             WSAYGET(7,2,"ESC Key to Quit")
  101.             WSAYGET(9,2,"Any Key to Continue")
  102.             INKEY(0)
  103.             WINDOWPOP()
  104.             * help screen
  105.  
  106.          ELSEIF _whatkey = 13
  107.             SET FUNCTION 10 TO CHR(23)
  108.             WINDOWPUSH(WROW(3),WCOL(-3),WROW(3+11),WCOL(-3+22),"","","","","","",.T.)
  109.             SET CURSOR ON
  110.             WSAYGET(11,2,"F10-Saves/ESC Quit")
  111.             _temp = IF(FILE(_file + TRANSFORM(DAY(_date), "99")), MEMOREAD(_file + TRANSFORM(DAY(_date), "99")), "")
  112.             _temp = MEMOEDIT(_temp,WROW(1),WCOL(1),WROW(10),WCOL(20),.T.)
  113.             SET CURSOR OFF
  114.             WINDOWPOP()
  115.             SET FUNCTION 10 TO ""
  116.             IF LASTKEY() != 27
  117.                MEMOWRIT(_file + TRANSFORM(DAY(_date), "99"), HARDCR(_temp) )
  118.                _temp = ""
  119.             ENDIF
  120.             _whatkey = 13
  121.             WINDOWPOP()
  122.             EXIT
  123.             
  124.          ELSE
  125.             IF !READINSERT()
  126.                DO CASE
  127.                CASE CHR(_whatkey) = "-"   && Decrement day within month
  128.                   _date = _date - 1
  129.                   _inmont = MONTH(_date)
  130.                   _inyear = YEAR(_date)
  131.                   _inday = DAY(_date)
  132.                CASE CHR(_whatkey) = "+"   && Increment day within month
  133.                   _date = _date + 1
  134.                   _inmont = MONTH(_date)
  135.                   _inyear = YEAR(_date)
  136.                   _inday = DAY(_date)
  137.                CASE _whatkey = 5
  138.                   _inyear = _inyear + 1
  139.                CASE _whatkey = 24
  140.                   _inyear = _inyear - 1
  141.                CASE _whatkey = 4
  142.                   IF _inmont = 12
  143.                      _inmont = 1
  144.                      _inyear = _inyear + 1
  145.                   ELSE
  146.                      _inmont = _inmont + 1
  147.                   ENDIF
  148.                CASE _whatkey = 19
  149.                   IF _inmont = 1
  150.                      _inmont = 12
  151.                      _inyear = _inyear - 1
  152.                   ELSE
  153.                      _inmont = _inmont - 1
  154.                   ENDIF
  155.                ENDCASE
  156.             ELSE
  157.                t_row = _currow
  158.                t_col = _curcol
  159.                b_row = _currow + 16
  160.                b_col = _curcol + 29
  161.                _tttscr = PUSHSCREEN()
  162.                _tts1 = VAL(SUBSTR(allwindows[_tttscr], 1, 2))
  163.                _tts2 = VAL(SUBSTR(allwindows[_tttscr], 4, 2))
  164.                _tts3 = VAL(SUBSTR(allwindows[_tttscr], 7, 2))
  165.                _tts4 = VAL(SUBSTR(allwindows[_tttscr], 10,2))
  166.                DO WHILE .T.
  167.                   RESTSCREEN(_tts1, _tts2, _tts3, _tts4, allscreens[_tttscr])
  168.                   @ t_row,t_col,b_row,b_col BOX REPLICATE(CHR(177), 8)
  169.                   @ t_row,t_col SAY ""
  170.                   _whatkey = INKEY(0)
  171.                   DO CASE
  172.                   CASE _whatkey = 27
  173.                      EXIT
  174.                   CASE _whatkey = 5
  175.                      IF t_row - 1 > - 1
  176.                         t_row = t_row - 1
  177.                         b_row = b_row - 1
  178.                      ENDIF
  179.                   CASE _whatkey = 24
  180.                      IF b_row + 1 < 25
  181.                         t_row = t_row + 1
  182.                         b_row = b_row + 1
  183.                      ENDIF
  184.                   CASE _whatkey = 19
  185.                      IF t_col - 1 > 3
  186.                         t_col = t_col - 1
  187.                         b_col = b_col - 1 
  188.                      ENDIF
  189.                   CASE _whatkey = 4
  190.                      IF b_col + 1 < 79
  191.                         b_col = b_col + 1
  192.                         t_col = t_col + 1
  193.                      ENDIF
  194.                   CASE _whatkey = 13
  195.                      _currow      = t_row
  196.                      _curcol      = t_col
  197.                      _chandle  = FCREATE("\CALEND.POS")
  198.                      FWRITE(_chandle, TRANSFORM(_currow, "99")+TRANSFORM(_curcol, "99"), 4)
  199.                      FCLOSE(_chandle)
  200.                      EXIT
  201.                   ENDCASE
  202.                ENDDO
  203.                POPSCREEN()
  204.                WINDOWPOP()
  205.                KEYBOARD CHR(22)
  206.                BREAK
  207.             ENDIF
  208.          ENDIF      
  209.       ENDDO
  210.       END
  211.       IF _whatkey = 27
  212.          EXIT
  213.       ENDIF
  214.    ENDDO
  215.    SETKEYON()
  216.    READINSERT(_retins)
  217.    SETCOLOR(_oldcolor)
  218.    SET CURSOR(scrcursor)
  219.    WINDOWPOP()
  220.  
  221. *******************
  222.  
  223. PROCEDURE Saycal
  224.  
  225.    WSAYGET( 1,1,"                           ")
  226.    WSAYGET( 2,1,"───┬───┬───┬───┬───┬───┬───")
  227.    WSAYGET( 3,1,"Sun│Mon│Tue│Wed│Thu│Fri│Sat")
  228.    WSAYGET( 4,1,"───┼───┼───┼───┼───┼───┼───")
  229.    WSAYGET( 5,1,"   │   │   │   │   │   │   ")
  230.    WSAYGET( 6,1,"───┼───┼───┼───┼───┼───┼───")
  231.    WSAYGET( 7,1,"   │   │   │   │   │   │   ")
  232.    WSAYGET( 8,1,"───┼───┼───┼───┼───┼───┼───")
  233.    WSAYGET( 9,1,"   │   │   │   │   │   │   ")
  234.    WSAYGET(10,1,"───┼───┼───┼───┼───┼───┼───")
  235.    WSAYGET(11,1,"   │   │   │   │   │   │   ")
  236.    WSAYGET(12,1,"───┼───┼───┼───┼───┼───┼───")
  237.    WSAYGET(13,1,"   │   │   │   │   │   │   ")
  238.    WSAYGET(14,1,"───┼───┼───┼───┼───┼───┼───")
  239.    WSAYGET(15,1,"   │   │   │   │   │   │   ")
  240.    WSAYGET( 1,1,IF(READINSERT(), "√", " ") )
  241.    WSAYGET( 1,27,IF(FILE(_file+"*"), "*", ""))
  242.  
  243. * End of File
  244.