Category : Files from Magazines
Archive   : VOL10N19.ZIP
Filename : FPDATE.PRG
* Incrementing and Decrementing Dates, FoxPro version
********************************************************************
SET ECHO OFF
SET TALK OFF
SET STATUS OFF
CLEAR
y = SCOLS()
pc = "PC Magazine "
pcmag = REPLICATE(pc, CEILING(y/LEN(pc)))
i = 0
x = SROWS()
DO WHILE i < x
@ i, 0 SAY pcmag
i = i + 1
ENDDO
DEFINE WINDOW test FROM 2,5 TO 13,64 TITLE "Employees"
ACTIVATE WINDOW test
msdate = {}
mlast = PADR("American",43)
mfirst = PADR("Joe",43)
mtitle = PADR("Software Engineer",43)
DO WHILE .T.
@ 1,2 SAY "Last name:"
@ 2,1 SAY "First name:"
@ 4,1 SAY "Start date:"
@ 6,6 SAY "Title:"
@ 1,13 GET mlast MESSAGE WinMsg("Enter last name")
@ 2,13 GET mfirst
@ 4,13 GET msdate WHEN dstart() ;
VALID !EMPTY(msdate) .AND. dstop() ;
MESSAGE WinMsg("Press + to increment, - to decrement")
@ 6,13 GET mtitle MESSAGE WinMsg("Enter title")
READ
IF READKEY()==268 .OR. READKEY()==12
EXIT
ENDIF
ENDDO
RELEASE WINDOW test
RETURN
***********************************************************************
* FUNCTION dstart
* Turn on special handling of the plus and minus keys
***********************************************************************
FUNCTION dstart
ON KEY LABEL + DO dmove
ON KEY LABEL - DO dmove
RETURN .T.
***********************************************************************
* FUNCTION dstop
* Turn off special handling of the plus and minus keys
***********************************************************************
FUNCTION dstop
ON KEY LABEL +
ON KEY LABEL -
RETURN .T.
***********************************************************************
* PROCEDURE dmove
* Increment or decrement the passed variable if it is of date type
* If it's an empty date, set it to todays date
***********************************************************************
PROCEDURE dmove
PRIVATE dv
dv = VARREAD() && Get the variable
IF TYPE(dv) == "D" && If it is of date type
IF EMPTY(&dv)
&dv = DATE()
ELSE
IF CHR(LASTKEY()) == '+'
&dv = &dv + 1 && Increment it
ELSE
&dv = &dv - 1 && Decrement it
ENDIF
ENDIF
ENDIF
RETURN
*******************************************************************
* FUNCTION WinMsg
* Display a centered message on the last line of the active
* window. For use with the MESSAGE option on @...GET.
*******************************************************************
FUNCTION WinMsg
PARAMETER TEXT
@ WROWS()-1, 0 SAY PADC(TEXT,WCOLS())
RETURN ""
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/