Category : Files from Magazines
Archive   : VOL10N19.ZIP
Filename : DATEPL.PRG

********************************************************************
* DATEPL.PRG
* Incrementing and Decrementing Dates, Clipper 5.01 version
********************************************************************
#include "inkey.ch"
#define K_PLUS 43 && Plus key
#define K_MINUS 45 && Minus key
SET ECHO OFF
SET TALK OFF
SET STATUS OFF
SET SCOREBOARD OFF
CLEAR
SETBLINK(.F.)
oldcolor = SETCOLOR("B/W")
y = MAXCOL()
pc = "PC Magazine "
i = LEN(pc)
pcmag = REPLICATE(pc, IIF(y % i > 0, 1+(y/i), y/i))
i = 0
x = MAXROW()
DO WHILE i < x
@ i, 0 SAY pcmag
i = i + 1
ENDDO
oldcolor = SETCOLOR("W+/B")
@ 2,3 CLEAR TO 12,64
@ 2,3 TO 12,64
@ 2,30 say "Employees"

mdate = CTOD(" / / ")
mlast = PADR("American",43)
mfirst = PADR("Joe",43)
mtitle = PADR("Software Engineer",43)

DO WHILE .T.
@ 4, 7 SAY "Last name: "
@ 4, 18 GET mlast WHEN WinMsg(11,6,58,"Enter last name")
@ 5, 6 SAY "First name: "
@ 5, 18 GET mfirst WHEN WinMsg(11,6,58,"Enter first name")
@ 7, 6 SAY "Start date: "
@ 7, 18 GET mdate COLOR "N/W,N/BG" ;
WHEN dstart() .AND. WinMsg(11,6,58,"Press + to increment, - to
decrement") ;
VALID !EMPTY(mdate) .AND. dstop()
@ 9,11 SAY "Title: "
@ 9,18 GET mtitle WHEN WinMsg(11,6,58,"Enter title")
READ
IF READKEY()==268 .OR. READKEY()==12 && Escape key pressed?
EXIT
ENDIF
ENDDO
SETCOLOR(oldcolor)
RETURN

***********************************************************************
* FUNCTION dstart
* Turn on special handling of the Plus and Minus keys
***********************************************************************
FUNCTION dstart
SET KEY K_PLUS TO dmove && Assign procedure to plus key
SET KEY K_MINUS TO dmove && Assign procedure to minus key
RETURN .T.

***********************************************************************
* FUNCTION dstop
* Turn off special handling of the Plus and Minus keys
***********************************************************************
FUNCTION dstop
SET KEY K_PLUS TO && Change plus key back to normal
SET KEY K_MINUS TO && Change minus key back to normal
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 today's date
*******************************************************************
PROCEDURE dmove
PARAMETER cProc, nLine, cVar
IF TYPE(cVar) == "D" && If it is a date field
IF EMPTY(&cVar) && If it is empty
&cVar = DATE() && Set to today's date
ELSE && Otherwise
IF LASTKEY() == K_PLUS && If the plus key was hit
&cVar = &cVar + 1 && Increment the date field
ELSE && Else
&cVar = &cVar - 1 && Decrement the date field
ENDIF
ENDIF
ENDIF
RETURN

*******************************************************************
* FUNCTION WinMsg
* Display a centered message.
*******************************************************************
FUNCTION WinMsg
PARAMETER nRow, nCol, nWidth, cText
@ nRow, nCol SAY PADC(cText, nWidth)
RETURN .T.