I've just begun using Office 97 and noticed that the dates work differently than what I have been used to in FoxPro. Dates in Office 97 have a combo box button that brings up a calendar, much like the calendar built into FoxPro. Unlike the calendar in FoxPro, however, the calendar in Office 97 closes upon date selection. (In FoxPro's Calendar/Diary screen, you can exit the screen with a CTRL-W or CTRL-F4 and the last selection is put into the variable _DIARYDATE.) I created a calendar program in FoxPro that has the features of the Office 97 calendar, and more.
I still do a lot of FoxPro 2.6 development, so this screen has been constructed in FoxPro 2.6. I don't see any problems creating the same screen in VFP; in fact, many features can be added, making the screen even better than in FoxPro 2.6. Also, I have used GENSCRNX with a 3-D driver to give the screen a more pleasing appearance.
This screen (figure 1) has six rows and seven columns of @SAYs with invisible buttons mapped on top. The @SAYs and invisible buttons are mapped to arrays using row and column positions, making it easy to reference any particular object. There are functions in the cleanup code that update and display the dates, generate days in the correct positions for the month and year, and set the cursor to the correct day in the month.
Three public domain, third-party programs are used in this screen to achieve the desired look: Ken Levy's GENDSCRNX and 3-D driver and Bill Anderson's 3DBOX.prg. (See Ken Levy's article "Screen Builder" in the September 1993 issue and Cal Evans' article "The X Files" in the October 1995 issue for more information on GENSCRNX.). GENSCRENX.PRG needs to be on the FoxPro path, as does the 3-D driver and 3D.prg. (I keep my copy in the FPW26 directory.) To make it all work, add the following line to your CONFIG.FPW file:
_GENSCRN =GENSCRNX.PRG
The file 3DBOX.PRG must be added to any project that calls this screen. It must be available at runtime. The file can be built into the application or be in the path. The calendar screen is named SCDATE in the layout dialog, and is referenced in the cleanup code.
The dates are displayed using an output (@SAY) field with a field format of "Z 99". An array (taDate) dimensioned as six rows and seven columns for the days of any month in the year. The @SAYs are set to refresh, so the month can be changed.
Date selection is done using invisible buttons. Another six by seven array (paButton) maps each invisible button on top of the output (@SAY) objects. In each of the invisible buttons, the When clause calls UpdateDate() and the valid calls ValPress().
This is where the 3-D effects are set up. Any parameters and private variables used in the screen are also set up here. All parameters must be in #SECTION 1 in the setup code. The calls to the 3-D driver are first.
*:SCXDRV5 3D
*:ALL3D
*:SET MODAL ON
#SECTION 1
PARAMETERS taDate
EXTERNAL ARRAY tadate
* In this implementation of the code, a date parameter
* MUST be passed to work. The date may be empty.
IF PARAMETERS() <> 1
WAIT WINDOW "Wrong number of parameters sent" TIMEOUT 5
RETURN .F.
ENDIF
IF TYPE("taDate") # 'D'
WAIT WINDOW "Parameter is the wrong type" TIMEOUT 5
RETURN .F.
ENDIF
#SECTION 2
PRIVATE ALL LIKE p*
plRetVal = .F. && This is the Return value of the screen
plExit = .F. && If a valid exit routine
&& fires, this is set to
&& TRUE
IF EMPTY(taDate)
* Set the default value here if it is not
* passed as a parameter.
pdDate = DATE()
ELSE
pdDate = taDate
ENDIF
* Update the date displayed at the top of the screen
pcDate = ALLTRIM(CMONTH(pdDate)) + ' ' + ;
STR(DAY(pdDate),2,0) + ', ' + ;
STR(YEAR(pdDate),4,0)
* Initialize Button Values for use in Valid
* Routines
pcMonth = '' && Button for changing the month
pcYear = '' && Button for changing the year
pcToday = '' && Button to set the date to TODAY()
pdReturn = {} && Empty Date field. This will hold the
&& Selected Date.
* Invisible Button
DIMENSION paButton[6,7]
FOR pnCntr = 1 TO 42
paButton[pnCntr] = pnCntr
ENDFOR
* Output fields
DIMENSION paday[6,7]
* Fill in the paDay array with valid days for the current month
=FillDay() && Located in the Clean-up Code Snippet
* Set Settings before Read
pcSetCentury=SET("century")
SET CENTURY ON
* Sound a Bell to alert user that the Calendar PopUp has started.
SET BELL TO 2000,2
?? CHR(7)
SET BELL TO 1500,2
Cleanup Code
The cleanup code contains all of my support functions.
* Reset Set Settings to default values
SET CENTURY &pcSetCentury
* taDate is updated with selected date. If the screen
* is exited by the ESCAPE key, the date will become
* a blank date. Modify this behavior here.
taDate = pdReturn
RETURN plExit
*** Supporting functions begin here.
***************************************
* function ValMonth
***************************************
* This function is called when the
* 'Prev Month' or 'Next Month'
* button is pressed. The appropriate
* dates are filled in and the screen
* is refreshed in the fillday() function.
*
FUNCTION ValMonth
DO CASE
CASE UPPER(EVAL(VARREAD())) = "PREV"
pdDate = GOMONTH(pddate, -1)
CASE UPPER(EVAL(VARREAD())) = "NEXT"
pdDate = GOMONTH(pddate, 1)
ENDCASE
pcDate = ALLTRIM(CMONTH(pdDate)) + ' ' + ;
STR(DAY(pdDate),2,0) + ', ' + ;
STR(YEAR(pdDate),4,0)
=fillday()
RETURN .T.
***************************************
* function ValYear
***************************************
* This function is called when the
* 'Prev Year' or 'Next Year'
* button is pressed. The appropriate
* dates are filled in and the screen
* is refreshed in the fillday() function.
*
FUNCTION ValYear
DO CASE
CASE UPPER(EVAL(VARREAD())) = "PREV"
pdDate = GOMONTH(pddate, -12)
CASE UPPER(EVAL(VARREAD())) = "NEXT"
pdDate = GOMONTH(pddate, 12)
ENDCASE
pcDate = ALLTRIM(CMONTH(pdDate)) + ' ' + ;
STR(DAY(pdDate),2,0) + ', ' + ;
STR(YEAR(pdDate),4,0)
=fillday()
RETURN .T.
***************************************
* function ValToday
***************************************
* This function is called when the
* 'Today' button is pressed. The
* appropriate dates are filled in and
* the screen is refreshed in the
* fillday() function.
*
FUNCTION ValToday
pdDate = DATE()
pcDate = ALLTRIM(CMONTH(pdDate)) + ' ' + STR(DAY(pdDate),2,0) + ', ' + STR(YEAR(pdDate),4,0)
=fillday()
RETURN .T.
***************************************
* procedure FillDay
***************************************
* This function is the heart of the
* entire program. Fill in the paDay
* array with current monthly information
* from the date pdDate. The array
* paDay has six rows with seven columns.
* This is 42 array elements.
* The first element is dow(pdStart)
* The routine listed here to get the first
* and last day of the current month uses
* actual month names for readability.
*
PROCEDURE FillDay
PRIVATE pcCurMonth, pnCurYear, pdStart
PRIVATE pdEnd, pnAdjust, pnCntr, pnRow, pnCol
pcCurMonth = CMONTH(pdDate)
pnCurYear = YEAR(pdDate)
pdStart = {}
pdEnd = {}
DO CASE
CASE pcCurMonth = "January"
pdStart = CTOD("01/01/"+STR(pnCurYear,4,0))
pdEnd = CTOD("01/31/"+STR(pnCurYear,4,0))
CASE pcCurMonth = "February"
pdStart = CTOD("02/01/"+STR(pnCurYear,4,0))
pdEnd = CTOD("03/01/"+STR(pnCurYear,4,0)) - 1
CASE pcCurMonth = "March"
pdStart = CTOD("03/01/"+STR(pnCurYear,4,0))
pdEnd = CTOD("03/31/"+STR(pnCurYear,4,0))
CASE pcCurMonth = "April"
pdStart = CTOD("04/01/"+STR(pnCurYear,4,0))
pdEnd = CTOD("04/30/"+STR(pnCurYear,4,0))
CASE pcCurMonth = "May"
pdStart = CTOD("05/01/"+STR(pnCurYear,4,0))
pdEnd = CTOD("05/31/"+STR(pnCurYear,4,0))
CASE pcCurMonth = "June"
pdStart = CTOD("06/01/"+STR(pnCurYear,4,0))
pdEnd = CTOD("01/30/"+STR(pnCurYear,4,0))
CASE pcCurMonth = "July"
pdStart = CTOD("07/01/"+STR(pnCurYear,4,0))
pdEnd = CTOD("07/31/"+STR(pnCurYear,4,0))
CASE pcCurMonth = "August"
pdStart = CTOD("08/01/"+STR(pnCurYear,4,0))
pdEnd = CTOD("08/31/"+STR(pnCurYear,4,0))
CASE pcCurMonth = "September"
pdStart = CTOD("09/01/"+STR(pnCurYear,4,0))
pdEnd = CTOD("09/30/"+STR(pnCurYear,4,0))
CASE pcCurMonth = "October"
pdStart = CTOD("10/01/"+STR(pnCurYear,4,0))
pdEnd = CTOD("10/31/"+STR(pnCurYear,4,0))
CASE pcCurMonth = "November"
pdStart = CTOD("11/01/"+STR(pnCurYear,4,0))
pdEnd = CTOD("11/30/"+STR(pnCurYear,4,0))
CASE pcCurMonth = "December"
pdStart = CTOD("12/01/"+STR(pnCurYear,4,0))
pdEnd = CTOD("12/31/"+STR(pnCurYear,4,0))
ENDCASE
* Fill in the array with blanks.
* I do not want a previous month
* value to carry into this month.
FOR pnCntr = 1 TO 42
paDay[pnCntr] = 0
ENDFOR
* This simple routine is what fills
* in the dates in the correct place!
pnAdjust = DOW(pdStart) && day of week for first of the month
FOR pnCntr = pnAdjust TO DAY(pdEnd) + pnAdjust -1
paDay[pnCntr] = pnCntr - pnAdjust + 1
ENDFOR
* update/redisplay items on the screen.
* Do this ONLY if the window is activated and current.
IF WOUTPUT() = "SCDATE"
SHOW GETS LEVEL RDLEVEL()
ENDIF
* Set the Cursor position
=SetCursor()
RETURN
***************************************
* function ValPress
***************************************
* When a button is pressed, the varread is the only value piece of information
* that is of any use. For example, if we are on the 3rd row and the 2nd column,
* the varread() will be PABUTTON[3,2]
*
FUNCTION ValPress
PRIVATE pcVarRead, pnDay, pcString
pcVarRead = VARREAD()
pcVariable = "paDay"+ALLTRIM(SUBSTR(pcVarRead,AT('(',pcVarRead)))
pnDay = EVAL(pcVariable)
IF pnDay > 0
* Fill in the date to array tdDate[1]
pcString = ALLTRIM(STR(MONTH(pdDate),2,0)) + '/' + ;
ALLTRIM(STR(pnDay,2,0)) + '/' + ;
ALLTRIM(STR(YEAR(pdDate),4,0))
pdReturn = CTOD(pcString)
plExit = .T.
CLEAR READ
ENDIF
RETURN .T.
***************************************
* procedure SetCursor
***************************************
* pdDate is the current Date in the
* current month/year that is displayed.
* Need to make the current object the
* value of pdDate.
*
PROCEDURE SetCursor
PRIVATE pnDay, plExit
pnDay = DAY(pdDate)
plExit = .F.
FOR pnRow = 1 TO 6
FOR pnCol = 1 TO 7
IF paDay[pnRow,pnCol] = pnDay
plExit = .T.
EXIT
ENDIF
ENDFOR
IF plExit = .T.
EXIT
ENDIF
ENDFOR
* pnRow and pnCol hold the value of the number we want to display
_CUROBJ = OBJNUM(paButton(pnRow,pnCol))
RETURN
***************************************
* function UpdateDate
***************************************
* pdDate is the current Date in the current month/year that is displayed
*
FUNCTION UpdateDate
PRIVATE pcVarRead, pcVariable, pnDay, plRetVal
pcVarRead = VARREAD()
pcVariable = "paDay"+ALLTRIM(SUBSTR(pcVarRead,AT('(',pcVarRead)))
pnDay = EVAL(pcVariable)
plRetVal = .F.
IF pnDay > 0
plRetVal = .T.
pcString = ALLTRIM(STR(MONTH(pdDate),2,0)) + '/' + ;
ALLTRIM(STR(pnDay,2,0)) + '/' + ;
ALLTRIM(STR(YEAR(pdDate),4,0))
pdDate = CTOD(pcString)
pcDate = ALLTRIM(CMONTH(pdDate)) + ' ' + STR(DAY(pdDate),2,0) + ', ' + STR(YEAR(pdDate),4,0)
SHOW GET pcDate LEVEL RDLEVEL()
ENDIF
RETURN plRetVal
The function SetCursor() needs to be called by the READ-level Activate in order to set focus to the default date when the screen is first displayed.
When building the screen, name the output file with an extension of .PRG. This lets the screen be called as a function. Here's is a sample call to the program.
PdTempDate = DATE() IF Cal(@pdTempDate) * User Selected a Date … ELSE * ENDIF
This calendar screen gives my users the functionality they're used to seeing. In today's point-and-click computing environment, the monotonous typing of a date string is much too reminiscent of DOS-style programming. This calendar date selection screen has filled this gap in FoxPro 2.6 for both my clients and myself.
This article is published in FoxPro Advisor in the August 1997 issue.