diff --git a/harbour/contrib/libct/dattime2.prg b/harbour/contrib/libct/dattime2.prg new file mode 100644 index 0000000000..6692ce6c15 --- /dev/null +++ b/harbour/contrib/libct/dattime2.prg @@ -0,0 +1,953 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 Date & Time functions, part II: - ADDMONTH() + * - CTODOW() + * - CTOMONTH() + * - DAYSINMONTH() + * - DAYSTOMONTH() + * - DMY() + * - DOY() + * - ISLEAP() + * - LASTDAYOM() + * - MDY() + * - NTOCDOW() + * - NTOCMONTH() + * - QUARTER() + * - WEEK() + * + * Copyright 2002 Alan Secker + * Copyright 2003 Martin Vogel : Enhancements, internationalization, documentation headers + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +#include "set.ch" +#include "hblang.ch" + + +/* $DOC$ + * $FUNCNAME$ + * ADDMONTH() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * add months to a date + * $SYNTAX$ + * ADDMONTH ([,] ) -> dShiftedDate + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * ADDMONTH() is compatible with CT3's ADDMOTH(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * $END$ + */ + +FUNCTION addmonth ( ddate, nmth ) +local nDay +// local ndays +// local sev +// local dnew +// local dEnd +// local nOldday +local nMonth +local nYear + +// if nmth > 70 +// return ctod (" / / ") +// endif +// +// nOldday := day (ddate) +// ndays := nmth * 30 +// +// dnew := ddate + ndays +// +// nMonth := month ( dnew ) +// nNyear := year ( dnew ) +// +// dEnd := ctod (str (nOldday) + "/" + str(nMonth) + "/" + str (nNyear)) +// +// return dEnd + + if !(valtype (ddate) $ "DN") + return ctod("") + endif + + if valtype (ddate) == "N" + nmth := ddate + ddate := date() + endif + + nmth = int (nmth) + + nDay = day (ddate) + nMonth = month (ddate) + nYear = year (ddate) + + nMonth += nmth + + if nMonth <= 0 + do while nMonth <= 0 + nMonth += 12 + nYear-- + enddo + endif + + if nMonth > 12 + do while nMonth > 12 + nMonth -= 12 + nYear++ + enddo + endif + + ddate := stod (strzero (nYear, 4) + strzero (nMonth, 2) + strzero (nDay, 2)) + return (ddate) + + +/* $DOC$ + * $FUNCNAME$ + * CTODOW() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * convert name of day of the week to its ordinal number + * $SYNTAX$ + * CTODOW () -> nOrdinal + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * CTODOW() is compatible with CT3's CTODOW(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * NTOCDOW() + * $END$ + */ + +FUNCTION ctodow ( cDow ) +//local cWeek := "SUNMONTUEWEDTHUFRISAT " +//local nWk := len (cWeek) +//local cMatch := left (upper ( Alltrim (cDow)), 3) +//local n +//local nDay := 0 +// +// for n = 1 to nWk step 3 +// if RTRIM (substr (cWeek, n, 3)) == cMatch +// nDay := INT (((n-1) / 3) + 1) +// exit +// endif +// next +// +// return nDay + +local nOrdinal := 0 +local bExact + + if valtype (cDow) != "C" + return (0) + endif + + bExact = set (_SET_EXACT, .F.) + cDow = upper (alltrim (cDow)) + + do while nOrdinal < 7 + if upper (alltrim (hb_langmessage (HB_LANG_ITEM_BASE_DAY + nOrdinal))) = cDow + set (_SET_EXACT, bExact) + return (nOrdinal+1) + endif + nOrdinal++ + enddo + + set (_SET_EXACT, bExact) + return (0) + + +/* $DOC$ + * $FUNCNAME$ + * CTOMONTH() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * convert name of month to its ordinal number + * $SYNTAX$ + * CTOMONTH () -> nOrdinal + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * CTOMONTH() is compatible with CT3's CTOMONTH(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * NTOCMONTH() + * $END$ + */ + +FUNCTION ctomonth ( cDom ) +//local cMonth := "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC " +//local nMnth := len (cMonth) +//local cMatch := left (upper ( Alltrim (cDom)), 3) +//local n +//local nDay := 0 + +local nOrdinal := 0 +local bExact + +// for n = 1 to nMnth step 3 +// if RTRIM (substr (cMonth, n, 3)) == cMatch +// nDay := INT (((n-1) / 3) + 1) +// exit +// endif +// next +// +// return nDay + + if valtype (cDom) != "C" + return (0) + endif + + bExact = set (_SET_EXACT, .F.) + cDom = upper (alltrim (cDom)) + + do while nOrdinal < 12 + if upper (alltrim (hb_langmessage (HB_LANG_ITEM_BASE_MONTH + nOrdinal))) = cDom + set (_SET_EXACT, bExact) + return (nOrdinal+1) + endif + nOrdinal++ + enddo + + set (_SET_EXACT, bExact) + return (0) + + +/* $DOC$ + * $FUNCNAME$ + * DAYSINMONTH() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * Returns the number of days in month + * $SYNTAX$ + * DAYSINMONTH (, ) -> nDaysInMonth + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * DAYSINMONTH() is a new function in Harbour's CT3 library. + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * DAYSTOMONTH() + * $END$ + */ + +FUNCTION daysInmonth ( nMonth, lLeap ) + +local nday := 0 + + do case + case nMonth == 2 + if lLeap == .T. + nday := 29 + else + nday := 28 + endif + + case nMonth == 4 .or. nMonth == 6 .or. ; + nMonth == 9 .or. nMonth == 11 + nday := 30 + otherwise + nday := 31 + endcase + + return nday + +/* $DOC$ + * $FUNCNAME$ + * DAYSTOMONTH() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * Total number of days from first of Jan to beginning of nMonth. + * $SYNTAX$ + * DAYSTOMONTH (, ) -> nDaysToMonth + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * lLeap is FALSE for a non-leap year but TRUE if it is. If so and nMonth + * is greater than 2, ndays is incremented + * TODO: add further documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * DAYSTOMONTH() is a new function in Harbour's CT3 library. + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * DAYSINMONTH() + * $END$ + */ + +FUNCTION daystomonth ( nMonth, lLeap ) + +local ndays := 0 + + if valtype(lLeap) != "L" + lLeap := .F. + endif + + do case + case nMonth == 2 + ndays := 31 // + Jan 31 + case nMonth == 3 + ndays := 59 // + Feb 28 + case nMonth == 4 + ndays := 90 // + Mar 31 + case nMonth == 5 + ndays := 120 // + Apr 30 + case nMonth == 6 + ndays := 151 // + May 31 + case nMonth == 7 + ndays := 181 // + Jun 30 + case nMonth == 8 + ndays := 212 // + Jul 31 + case nMonth == 9 + ndays := 243 // + Aug 31 + case nMonth == 10 + ndays := 273 // + Sep 30 + case nMonth == 11 + ndays := 304 // + Oct 31 + case nMonth == 12 + ndays := 334 // + Nov 30 + endcase + + if (lLeap, ndays ++, ) + + return ndays + + +/* $DOC$ + * $FUNCNAME$ + * DMY() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * Returns the date as a string in DD Month YY format + * $SYNTAX$ + * DMY ([][, ]) -> cDateString + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * Returns the date as a string in DD Month YY format. If lmode + * is TRUE, a "." is inserted after the DD + * TODO: add further documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * DMY() is compatible with CT3's DMY(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * MDY() + * $END$ + */ + +FUNCTION dmy ( ddate, lmode ) + +//local nMonth := month (dDate) +//local nDay := day (dDate) +//local nYear := year (dDate) +local nMonth, nDay, nYear + +local cPeriod := "" +local cDate +local cMonth + +local cYear +local lSetCentury := __SETCENTURY() + + if valtype (ddate) != "D" + ddate := date () + endif + + nMonth := month (ddate) + nDay := day (ddate) + nYear := year (ddate) + + cMonth := ntocmonth ( nMonth ) + cYear := str (nYear, iif (lSetCentury, 4, 2)) + + cPeriod := if (lmode == .T., ".", "") + + + cDate := ltrim ( str ( nDay )) + cPeriod + " " + cMonth + " " + ; + ltrim ( cYear ) +// ltrim ( str ( nYear )) + return cDate + + +/* $DOC$ + * $FUNCNAME$ + * DOY() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * Determines the day of the year for a specific date + * $SYNTAX$ + * DMY ([]) -> nDayOfYear + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * Determines the day of the year for a specific date + * if dDate is invalid, returns 0 + * TODO: add further documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * DOY() is compatible with CT3's DOY(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * $END$ + */ + +FUNCTION doy ( dDate ) + +local lleap := .F. +local nMonth := month (dDate) +local nDay := day (dDate) +local numdays := 0 + + if valtype ( dDate ) != "D" + dDate := date() + endif + + if empty (dDate) + return 0 + endif + + lLeap := isleap (dDate) + numdays := daystomonth ( nMonth, lleap ) + nDay + + return numdays + + +/* $DOC$ + * $FUNCNAME$ + * ISLEAP() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * determines of year of date is a leap year + * $SYNTAX$ + * ISLEAP ([]) -> lIsLeap + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add further documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * ISLEAP() is compatible with CT3's ISLEAP(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * $END$ + */ + +FUNCTION isleap ( ddate ) + +local nYear +local nMmyr +local nCyYr +local nQdYr +local lRetval + + if empty ( ddate ) + ddate := date () + endif + + nYear := year (ddate) + nCyYr := nYear / 400 +// nMmyr := nyear /1000 + nMmyr := nYear /100 + nQdYr := nYear / 4 + + do case + case int (nCyYr) == nCyYr + lRetVal := .T. + + case int (nMmyr) == nMmyr + lRetVal := .F. + + case int (nQdYr) == nQdYr + lRetVal := .T. + + otherwise + lRetVal := .F. + endcase + + return lRetVal + +/* $DOC$ + * $FUNCNAME$ + * LASTDAYOM() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * Returns the the number of days in the month. + * $SYNTAX$ + * LASTDAYOM ([]) -> nDaysInMonth + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * can be a date or a month number. If empty uses the + * system date. If nMonth is a 2, lastdayom() will not know if it + * is a leap year or not. If dDate is invalid, returns 0 + * TODO: add further documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * LASTDAYOM() is compatible with CT3's LASTDAYOM(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * EOM() + * $END$ + */ + +FUNCTION lastdayom ( xDate ) + +local nMonth := 0 +local nDays := 0 +local lleap := .F. + + do case + case empty ( xDate) + nMonth := month ( date() ) + + case valtype ( xDate ) == "D" + nMonth := month (xdate) + lleap := isleap ( xdate) + + case valtype (xDate ) == "N" + if xdate > 12 + nmonth := 0 + else + nMonth := xDate + endif + endcase + + if nmonth != 0 + ndays := daysInmonth ( nMonth, lleap ) + endif + + return ndays + + +/* $DOC$ + * $FUNCNAME$ + * MDY() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * Returns the date as a string in Month DD, YY or Month DD, YYYY + * $SYNTAX$ + * MDY ([]) -> cDateString + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * Returns the date as a string in Month DD, YY or Month DD, YYYY + * If dDate is NULL, the system date is used + * TODO: add further documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * MDY() is compatible with CT3's MDY(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * DMY() + * $END$ + */ + +FUNCTION mdy ( dDate ) + +local nMonth +local nDay +local nYear +local cDate +local cMonth + +local lSetCentury := __SETCENTURY() +local cYear + +// default dDate to date() + if valtype (ddate) != "D" + ddate := date () + endif + + nMonth := month (dDate) + nDay := day (dDate) + nYear := year (dDate) + cMonth := ntocmonth ( nMonth ) + + cYear := str (nYear, iif (lSetCentury, 4, 2)) + + cDate := cMonth + " " + ; + ltrim ( str ( nDay )) + " " + ; + ltrim ( cYear ) + // ltrim ( str ( nYear )) + + return cDate + + +/* $DOC$ + * $FUNCNAME$ + * NTOCDOW() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * (num of day) -> day name + * $SYNTAX$ + * NTOCDOW () -> cDay + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * NTOCDOW() is compatible with CT3's NTOCDOW(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * CTODOW() + * $END$ + */ + +FUNCTION ntocdow ( nDay ) + +local cDay := "" + + if nDay >= 1 .AND. nDay <= 7 + cDay := hb_langmessage (HB_LANG_ITEM_BASE_DAY + (nDay-1)) + endif + + return cDay + + +/* $DOC$ + * $FUNCNAME$ + * NTOCMONTH() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * (num of month ) -> Month Name + * $SYNTAX$ + * NTOCMONTH () -> cMonth + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * NTOCMONTH() is compatible with CT3's NTOCMONTH(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * CTOMONTH() + * $END$ + */ + +FUNCTION ntocmonth ( nMonthNum ) + +local cMonth := "" + + if nMonthNum >= 1 .AND. nMonthNum <= 12 + cMonth := hb_langmessage (HB_LANG_ITEM_BASE_MONTH + (nMonthNum-1)) + endif + +// do case +// case nMonthNum == 1 +// cMonth := "January" +// case nMonthNum == 2 +// cMonth := "February" +// case nMonthNum == 3 +// cMonth := "March" +// case nMonthNum == 4 +// cMonth := "April" +// case nMonthNum == 5 +// cMonth := "May" +// case nMonthNum == 6 +// cMonth := "June" +// case nMonthNum == 7 +// cMonth := "July" +// case nMonthNum == 8 +// cMonth := "August" +// case nMonthNum == 9 +// cMonth := "September" +// case nMonthNum == 10 +// cMonth := "October" +// case nMonthNum == 11 +// cMonth := "November" +// case nMonthNum == 12 +// cMonth := "December" +// endcase + + return cMonth + + +/* $DOC$ + * $FUNCNAME$ + * QUARTER() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * Returns a number equal to the quarter in which a date falls + * $SYNTAX$ + * QUARTER ([]) -> nQuarter + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * Returns a number equal to the quarter in which ddate + * falls. If ddate is empty, the system date is employed. + * TODO: add further documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * QUARTER() is compatible with CT3's QUARTER(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * $END$ + */ + +FUNCTION quarter ( ddate ) + +local nmonth +local nretmonth + + if empty (ddate) + ddate := date() + endif + + nmonth := month (ddate) +// nretmonth := int (( nmonth / 3 ) + 0.67 ) + nretmonth := int ((nmonth + 2) / 3 ) + + return nretmonth + + + +/* $DOC$ + * $FUNCNAME$ + * WEEK() + * $CATEGORY$ + * CT3 date and time functions + * $ONELINER$ + * Returns the calendar week a number + * $SYNTAX$ + * WEEK ([][, ]) -> nWeek + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * Returns the calendar week a number. If no date is specified, + * the system date is used. An empty date viz ctod(" / / ") + * returns 0. + * If is .T., week() will calculate the "simple week number", defined by + * - week #1 starts on January, 1st + * - week #(n+1) starts seven days after start of week #n + * If is .F. (default), the ISO8601 week number, defined by + * - weeks start on mondays + * - week #1 is the one that includes January, 4 + * will be calculated + * TODO: add further documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * WEEK() is compatible with CT3's WEEK(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is dattime2.prg, library is libct. + * $SEEALSO$ + * $END$ + */ + +FUNCTION week ( dDate, lSWN ) + +local nMonth +local nDays +local nDay +local nYear +local nWeek +local nPart +local dDate2 +// local nleap + +// do case +// case valtype (dDate) == "D" .and. empty ( dDate) +// return nDays +// +// case empty (dDate) +// dDate := date() +// endcase + + if valtype (dDate) == "D" .and. empty (dDate) + return 0 + endif + + if empty (dDate) + dDate := date() + endif + + nMonth := month (dDate) + nDay := day (dDate) + nYear := year (dDate) + + if valtype (lSWN) != "L" + lSWN := .F. + endif + + if lSWN + // simple week number + + // nleap := if (isleap (dDate), 1, nleap) + // ndays := daystomonth ( nMonth, nleap ) + nday + nDays := daystomonth ( nMonth, isleap (dDate)) + nDay + + nPart := nDays % 7 + nWeek := INT (nDays / 7) + + nWeek := INT (if ( nPart > 0, ++ nWeek, nWeek)) + + else + // ISO8601 week number + dDate2 := dDate + 3 - ((dow(dDate)+5) % 7) + nWeek := 1 + int ((dDate2 - boy (dDate2)) / 7) + + endif + + return nWeek + + + + + + diff --git a/harbour/contrib/libct/tests/datetime.prg b/harbour/contrib/libct/tests/datetime.prg new file mode 100644 index 0000000000..3e1c1f0c10 --- /dev/null +++ b/harbour/contrib/libct/tests/datetime.prg @@ -0,0 +1,1251 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Program to test functions to mimic Clipper Tools III date & time functions. + * (C) Alan Secker 2002 + * + * small changes: Martin Vogel 2003 + * + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +#include "inkey.ch" +#include "common.ch" +#include "setcurs.ch" + + +// TODO: add language module request(s) and an achoice to select different lang modules + + +*:-------------------------------------------------------------------- +FUNCTION main () +*:-------------------------------------------------------------------- +local cScr +local cScr2 +local nchoice +local c := .T. +local farr := { "addmonth ( ddate ) Add a month to ddate ", ; + "bom () Beginning of month ", ; + "boq () Returns first date of qtr", ; + "boy () Beginning of year ", ; + "ctodow () Day name to day number ", ; + "ctomonth () Month name to number ", ; + "daysInMonth () number of days in xMonth ", ; + "daystomonth (ddate) Returns num days TO month", ; + "dmy ( ddate, lmode) date as DD month YY ", ; + "doy ( ddate ) Returns day of the year ", ; + "eom ( ddate ) Returns last day of month", ; + "eoq ( ddate ) Returns last date of qtr ", ; + "eoy ( ddate ) Returns last day of year ", ; + "isleap ( ddate ) Returns .T. if leap year ", ; + "lastdayom ( ddate ) Returns num days in month", ; + "mdy ( dDate ) Returns stg Month DD, YY ", ; + "ntocdow ( nDay ) Returns name of day ", ; + "ntocmonth ( nMth ) Returns name of month ", ; + "quarter (date) Returns qtr number of date", ; + "stod( ansi date) Returns Clipper date ", ; + "week( ddate, lSWN ) Returns numbef of week ", } + + set date british + set century on + + cls + + do while c + cScr := savescreen ( 4, 5, 21,66 ) + + @ 4, 5 to 21, 66 + nchoice := achoice ( 5, 7, 20, 65, farr ) //, ,1) + + if empty ( nchoice ) + return NIL + endif + + @ 0, 0 clear to maxrow(), maxcol() + + do case + case nchoice == 1 + addmtest() + case nchoice == 2 + bomtest () + case nchoice == 3 + boqtest () + case nchoice == 4 + boytest () + case nchoice == 5 + ctodowtest () + case nchoice == 6 + ctomonthtest () + case nchoice == 7 + dInMonthtest () + case nchoice == 8 + d2month () + case nchoice == 9 + dmytest () + case nchoice == 10 + doytest () + case nchoice == 11 + eomtest () + case nchoice == 12 + eoqtest () + case nchoice == 13 + eoytest () + case nchoice == 14 + isleaptest () + case nchoice == 15 + lastdayomtest () + case nchoice == 16 + mdytest () + case nchoice == 17 + ntocdowtest () + case nchoice == 18 + ntocmthtest () + case nchoice == 19 + qtrtest () + case nchoice == 20 + stodtest() + case nchoice == 21 + weektest () + endcase + + restscreen ( 4, 5, 21, 66, cScr) + enddo + + return NIL + +*:-------------------------------------------------------------------- +FUNCTION addmtest() +*:-------------------------------------------------------------------- +*: addmonth (ddate, nMonths) +*: ========================= +*: This version will only accept an nMonths value of from 0 to 70 + +local getlist := {} +local ddate := ctod (" / / ") +local c := .T. +local mnth := 0 +local nKey + +do while c + @ 5, 10 say "addmonth (ddate) returns the date incremented by" + @ 6, 10 say "the number of days in months." + @ 7, 10 say "Insert a date" + @ 8, 10 say "How many months" + @ 7, 60 get ddate + @ 8, 60 get mnth picture "99" + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + + @ 11, 39 say "The returned date is " + dtoc ( addmonth (ddate, mnth) ) + + set cursor off + inkey(0) + set cursor on + + endif + + enddo + + @ 0, 0 clear + + return NIL + +*:-------------------------------------------------------------------- +FUNCTION bomtest() +*:-------------------------------------------------------------------- +*: bom ( ddate ) +*: ============= + +local getlist := {} +local ddate := ctod (" / / ") +local c := .T. +local nKey + +do while c + @ 5, 10 say "bom (ddate) returns the date of the first day of ddate" + @ 6, 10 say "If ddate is 15/10/2002 (that's in dd/mm/yyy), bom ()" + @ 7, 10 say "should return 01/10/2002. Test it, Insert a date" + @ 9, 10 get ddate + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + @ 11, 10 say "The returned date is " + dtoc ( bom (ddate) ) + + set cursor off + inkey(0) + set cursor on + + endif + + enddo + + @ 0, 0 clear + + return NIL + + +*:-------------------------------------------------------------------- +FUNCTION boqtest () +*:-------------------------------------------------------------------- +*: bom ( ddate ) +*: ============= + +local getlist := {} +local ddate := ctod (" / / ") +local c := .T. +local nKey + + do while c + @ 5, 10 say "boq (ddate) returns the date of the first day of the" + @ 6, 10 say "quarter in which ddate is situated. If ddate is" + @ 7, 10 say "15/10/2002 (that's in dd/mm/yyy), BOQ () should return" + @ 8, 10 say "01/09/2002. Test it, Insert a date" + + @ 9, 10 get ddate + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + @ 11, 10 say "The returned date is " + dtoc ( boq (ddate) ) + + set cursor off + inkey(0) + set cursor on + + endif + + enddo + + @ 0, 0 clear + + return NIL + + +*:-------------------------------------------------------------------- +FUNCTION boytest () +*:-------------------------------------------------------------------- +*: boy ( ddate ) +*: ============= + +local getlist := {} +local ddate := ctod (" / / ") +local c := .T. +local nkey + +do while c + @ 5, 10 say "boy (ddate) returns the date of the first day of ddate" + @ 6, 10 say "If ddate is 15/10/2002 (that's in dd/mm/yyy), boy ()" + @ 7, 10 say "should return 01/01/2002. Test it, Insert a date" + @ 9, 10 get ddate + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + @ 11, 10 say "The returned date is " + dtoc ( boy (ddate) ) + + set cursor off + inkey(0) + set cursor on + + ddate := ctod (" / / ") + + endif + + enddo + + @ 0, 0 clear + + return NIL + + +*:---------------------------------------------------------------- +FUNCTION ctodowtest () +*:---------------------------------------------------------------- +*: ctodow ( cDow) +*: ============== +*: Convert name of day of the week to its ordinal number +*: if cDow is invalid, returns 0 +*: English day names only. + +local getlist := {} +local cDow := space (9) +local nkey +local c := TRUE + +do while c + @ 5, 10 say "ctodow (ddate) receives the name of a day of the week and " + @ 6, 10 say "returns a number representing its position in the week" + @ 7, 10 say "Sunday returns 1. Test it, Insert a day" + @ 9, 10 get cDow + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + @ 11, 10 say "The day number is " + str ( ctodow ( upper (alltrim (cDow))) ) + + set cursor off + inkey(0) + set cursor on + + cDow := space (9) + + endif + + enddo + + @ 0, 0 clear + + return NIL + + +*:---------------------------------------------------------------- +FUNCTION ctomonthtest () +*:---------------------------------------------------------------- +*: ctomonth (cDom ) +*: =============== +*: Convert the name of a month to its ordinal number. If cMonth is +*: invalid, ctomonth() Returns 0. English month names only + +local getlist := {} +local cDom := space (9) +local c := .T. +local nKey + +do while c + @ 5, 10 say "ctomonth (ddate) receives the name of a month and returns" + @ 6, 10 say "a number representing its position in the month. April" + @ 7, 10 say "returns 4. Test it, Insert a month" + @ 9, 10 get cDom picture "!!!!!!!!!" + + set confirm on + set escape on + read + set escape off + set confirm on + + cDom := alltrim ( cDom ) + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + @ 11, 10 say "The day number is " + str ( ctomonth ( cDom) ) + set cursor off + inkey(0) + set cursor on + + cDom := space (9) + endif + + enddo + + @ 0, 0 clear + + return NIL + + +*:---------------------------------------------------------------- +FUNCTION dInMonthtest () +*:---------------------------------------------------------------- +*: daysInMonth ( xDate, lleap ) +*: ============================ +*: Returns the number of days in nMonth, either whose name as a +*: string or month number is passed. English Month names only. + +local getlist := {} +local cMonth := space (9) +local c := .T. +local nMonth +local nKey +local cLeap := "N" +local lleap := FALSE + + do while c + @ 5, 10 say "daysInmonth () receives either the number of a month or" + @ 6, 10 say "its name and returns the number of days in the month. " + @ 7, 10 say "April returns 30. Test it. Insert a month number" + @ 8, 10 say "Is it a leap year?" + @ 7, 60 get cMonth picture "XXXXXXXXX" + @ 8, 60 get cleap picture "Y" + + set confirm on + set escape on + read + set escape off + set confirm on + + cMonth := upper (rtrim (cMonth)) + nMonth := val (cMonth) + + do case + case valtype ( cMonth ) == "C" .and. nmonth == 0 + nMonth := ctomonth ( cMonth) + + case nMonth == 0 .or. ; + nMonth > 12 + + loop + endcase + + if cLeap == "Y" + lleap := TRUE + endif + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + + @ 10, 40 say "The day number is " + ; + ltrim (str ( daysInMonth ( nMonth, lLeap ))) + + set cursor off + inkey(0) + set cursor on + + cMonth := space (9) + cLeap := "N" + + endif + + enddo + + @ 0, 0 clear + + return NIL + + +*:---------------------------------------------------------------- +FUNCTION d2month () +*:---------------------------------------------------------------- +*: daystomonth() +*: ============= +*: Total number days from first of Jan to beginning of nMonth. +*: lLeap is FALSE for a non-leap year but TRUE if it is. If so and +*: nMonth is greater than 2, ndays is incremented. + +local getlist := {} +local cMonth := space (2) +local cLeap := "N" +local c := .T. +local nMonth +local lLeap +local nKey + +do while c + @ 5, 10 say "daystomonth () receives the number a month and returns" + @ 6, 10 say "the number of days in the year up to that month. March" + @ 7, 10 say "returns 59 or 60 in a leap year. Test it." + @ 8, 10 say "Insert a month number" + @ 9, 10 say "Leap year Y/N?" + @ 8, 33 get cMonth picture "99" + @ 9, 33 get cLeap picture "Y" + + set confirm on + set escape on + read + set escape off + set confirm on + + nMonth := val ( cMonth ) + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + if cLeap == "Y" + lLeap := .T. + endif + + @ 11, 10 say "The day number is " + ; + ltrim (str ( daystomonth ( nMonth, lLeap ))) + + set cursor off + inkey(0) + set cursor on + + cMonth := space (2) + cLeap := "N" + + endif + + enddo + + @ 0, 0 clear + + return NIL + +*:---------------------------------------------------------------- +FUNCTION dmytest () +*:---------------------------------------------------------------- +*: dmy ( ddate, lmode) +*: =================== +*: Returns the date as a string in DD Month YY format. If lmode +*: is TRUE, a "." is inserted after the DD +*: This version does not observe the Nations module. English +*: only. + +local getlist := {} +local ddate := ctod (" / / ") +local cMode := space (1) +local lmode +local c := .T. +local nKey + + do while c + @ 5, 10 say "dmy() receives a date and logical lmode. If lmode is" + @ 6, 10 say "is either missing or FALSE, dmy returns the date as" + @ 7, 10 say "a string in DD Month YY format. If lmode is TRUE, a" + @ 8, 10 say "full stop or perod '.' is inserted after DD. Test it" + @ 9, 10 say "Insert a date" + @ 10, 10 say "inssert a full stop Y/N?" + @ 9, 36 get ddate picture "@D / / " + @ 10, 45 get cMode picture "Y" + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + if (cMode == "Y", lMode := .T., lMode := .F.) + + @ 12, 10 say "The date string returned is " + ; + ltrim (dmy ( ddate, lmode )) + + set cursor off + inkey(0) + set cursor on + + ddate := ctod (" / / ") + cMode := space (1) + + endif + + enddo + + @ 0, 0 clear + + return NIL + +*:---------------------------------------------------------------- +FUNCTION doytest () +*:---------------------------------------------------------------- +*: doy ( ddate ) +*: ============= +*: Determines the day of the year for a specific date +*: if dDate is invalid, returns 0 + +local getlist := {} +local ddate := ctod (" / / ") +local c := .T. +local nKey + +do while c + @ 5, 10 say "doy (ddate) returns the day of the year for the" + @ 6, 10 say "date passed. Test it, Insert a date" + @ 9, 10 get ddate + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + @ 11, 10 say "The day of the date entered is " + ; + ltrim ( str (doy ( ddate ))) + + set cursor off + inkey(0) + set cursor on + + ddate := ctod (" / / ") + + endif + + enddo + + @ 0, 0 clear + + return NIL + + +*:---------------------------------------------------------------- +FUNCTION eomtest () +*:---------------------------------------------------------------- +*: dBom := eom ( ddate ) +*: ===================== +*: Returns the last date in the month of the month appearing in +*: date. + +local getlist := {} +local ddate := ctod (" / / ") +local c := .T. +local nKey + +do while c + @ 5, 10 say "eom (ddate) returns the last date in the month of the" + @ 6, 10 say "month appearing in ddate. Test it, Insert a date" + @ 9, 10 get ddate + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + + @ 11, 10 say "The last date in the month is " + ; + ltrim ( dtoc (eom ( ddate ))) + + set cursor off + inkey(0) + set cursor on + + ddate := ctod (" / / ") + + endif + + enddo + + @ 0, 0 clear + + return NIL + + +*:---------------------------------------------------------------- +FUNCTION eoqtest () +*:---------------------------------------------------------------- +*: dret := eoq ( ddate ) +*: ===================== +*: Returns the last date in the quarter in which ddate falls. + +local getlist := {} +local ddate := ctod (" / / ") +local c := .T. +local nKey + + do while c + @ 5, 10 say "EOQ (ddate) returns the last date in the quarter in" + @ 6, 10 say "which ddate falls. Test it, Insert a date" + @ 9, 10 get ddate + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + + @ 11, 10 say "The last date in the month is " + ; + ltrim ( dtoc (eoq ( ddate ))) + + set cursor off + inkey(0) + set cursor on + + ddate := ctod (" / / ") + + endif + + enddo + + @ 0, 0 clear + + return NIL + + +*:---------------------------------------------------------------- +FUNCTION eoytest () +*:---------------------------------------------------------------- +*: dEoy := eoy ( ddate ) +*: ===================== +*: Returns the last date in the year of the year appearing in +*: date. + +local getlist := {} +local ddate := ctod (" / / ") +local c := .T. +local nKey + + do while c + @ 5, 10 say "eoy (ddate) returns the last date in the year of the" + @ 6, 10 say "year appearing in ddate. Test it, Insert a date" + @ 9, 10 get ddate + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + + @ 11, 10 say "The last date in the year is " + ; + ltrim ( dtoc (eoy ( ddate ))) + + set cursor off + inkey(0) + set cursor on + + ddate := ctod (" / / ") + + endif + + enddo + + @ 0, 0 clear + + return NIL + + +*:---------------------------------------------------------------- +FUNCTION isleaptest () +*:---------------------------------------------------------------- +*: lRet := isleap ( ddate ) +*: ======================== +*: if ddate is a leap year, lRet is TRUE, otherwise FALSE. +*: Leap years are exactly divisible by 4 and 1,000 but not 100. + +local getlist := {} +local ddate := ctod (" / / ") +local c := .T. +local cResult +local nKey + + do while c + @ 5, 10 say "isleap (ddate) returns TRUE if ddate is a leap year" + @ 6, 10 say "Test it, Insert a date" + @ 9, 10 get ddate + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + + if isleap ( ddate ) + cResult := "TRUE " + else + cResult := "FALSE" + endif + + @ 11, 10 say "The result is " + cResult + + set cursor off + inkey(0) + set cursor on + + ddate := ctod (" / / ") + + endif + + enddo + + @ 0, 0 clear + + return NIL + +*:---------------------------------------------------------------- +FUNCTION lastdayomtest () +*:---------------------------------------------------------------- +*: ndays := lastdayom ( xDate ) +*:-------------------------------------------------------------- +*: Returns the the number of days in the month. +*: xDate can be a date or a month number. If empty uses the +*: system date. +*: If xDate is invalid, returns 0 + +local getlist := {} +local ddate := ctod (" / / ") +local c := .T. +local nKey +local cMth := " " + + do while c + @ 5, 10 say "lastdayom (xDate) returns the number of days in the" + @ 6, 10 say "month appearing in date. Or, if only a month number" + @ 7, 10 say "is passed, in that month. Test it. " + @ 9, 10 say "Insert a date (or)" + @ 10, 10 say "a month" + + @ 9, 30 get ddate + @ 10, 38 get cMth picture "99" //valid val (cmth) < 12 + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + + if (empty (ddate), ddate := val (cMth), ddate) + + @ 12, 10 say "The number of days in the month is " + ; + ltrim (str (lastdayom ( ddate ))) + set cursor off + inkey(0) + set cursor on + + ddate := ctod (" / / ") + cMth := " " + + endif + + enddo + + @ 0, 0 clear + + return NIL + +*:---------------------------------------------------------------- +FUNCTION mdytest () +*:---------------------------------------------------------------- +*: cDate := mdy ( dDate ) +*: ====================== +*: Returns the date as a string in "Month DD, YY" or "Month DD, YYYY" +*: If dDate is NULL, the system date is used +*: This version does not observe the Nations module. English only. + +local getlist := {} +local ddate := ctod (" / / ") +local c := .T. +local nKey + + do while c + @ 5, 10 say "mdy() receives a date. mdy returns the date as" + @ 6, 10 say "a string in month DD YY format. Test it" + @ 8, 10 say "Insert a date" + @ 8, 30 get ddate picture "@D / / " + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + + @ 11, 10 say "The date string returned is " + ; + ltrim (mdy ( ddate )) + + set cursor off + inkey(0) + set cursor on + + ddate := ctod (" / / ") + + endif + + enddo + + @ 0, 0 clear + + return NIL + + +*:---------------------------------------------------------------- +FUNCTION ntocdowtest () +*:---------------------------------------------------------------- +*: cDay := ntocdow ( nDayNum ) +*: ================================== +*: ntocdow() receives the number of a day and returns its +*: name as a string. This version does not observe the Nations +*: module. English only. + +local getlist := {} +local cDay := " " +local c := .T. +local nKey + +do while c + @ 5, 10 say "ntocdow(n) returns the name of the day number n" + @ 6, 10 say "Test it, Insert a day number" + @ 6, 60 get cDay + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + + @ 11, 10 say "The day selected is " + ; + padr (ntocdow ( val (cDay) ), 10) + + set cursor off + inkey(0) + set cursor on + + cDay := " " + + endif + + enddo + + @ 0, 0 clear + + return NIL + + +*:---------------------------------------------------------------- +FUNCTION ntocmthtest () +*:---------------------------------------------------------------- +*: cMonth := ntocmonth ( nMonthNum ) +*: ================================== +*: ntocmonth() receives the number of a month and returns its +*: name as a string. This version does not observe the Nations +*: module. English only. + +local getlist := {} +local cMonth := " " +local c := .T. +local nKey + +do while c + @ 5, 10 say "ntocmonth(n) returns the name of the month number n" + @ 6, 10 say "Test it, Insert a month number" + @ 6, 60 get cMonth + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + + @ 11, 10 say "The month selected is " + ; + padr (ntocmonth ( val (cMonth) ), 10) + + set cursor off + inkey(0) + set cursor on + + cMonth := " " + + endif + + enddo + + @ 0, 0 clear + + return NIL + +*:---------------------------------------------------------------- +FUNCTION qtrtest () +*:---------------------------------------------------------------- +*: nqtr := quarter ( ddate ) +*: =========================== +*: Returns the quarter as a number. If no date is specified, +*: the system date is used. + +local getlist := {} +local ddate := ctod (" / / ") +local c := .T. +local nKey + + do while c + @ 5, 10 say "quarter (ddate) returns the number of the quarter" + @ 6, 10 say "Test it, Insert a date" + @ 6, 52 get ddate + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + + @ 8, 10 say "The quarter number is " + ; + padr (ltrim ( str ( quarter ( ddate ))), 10) + + set cursor off + inkey(0) + set cursor on + + ddate := ctod (" / / ") + + endif + + enddo + + @ 0, 0 clear + + return NIL + + +*:---------------------------------------------------------------- +FUNCTION stodtest() +*:---------------------------------------------------------------- +*: stod ( ansi-date) +*: ================ +*: Returns a Clipper format date. If Ansi date is invalid, a +*: null date is returned. + +local getlist := {} +local ddate +local cAnsidate := space(8) +local c := .T. +local nKey + + do while c + @ 5, 10 say "stod ( ansi-date ) receives an ANSI date string and" + @ 6, 10 say "returns a Clipper format date" + @ 8, 10 say "Enter an ANSI date string in the form YYYYMMDD" + @ 8, 57 get cAnsidate picture "999999999" valid chkansi (cAnsidate) + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + + ddate := stod ( cAnsidate ) + + @ 10, 10 say "The Clipper format date is " + ; + padr (ltrim ( dtoc ( ddate )), 10) + + set cursor off + inkey(0) + set cursor on + + cAnsidate := space(8) + + endif + + enddo + return NIL + + +*:---------------------------------------------------------------- +FUNCTION chkansi (cAnsidate) +*:---------------------------------------------------------------- +local ddate +local nYear +local nMonth +local nDay +local lretval := TRUE + + nYear := val ( left ( cAnsidate, 4)) + nMonth := val (substr ( cAnsidate, 5, 2)) + nDay := val ( right ( cAnsidate, 2)) + + do case + + case nYear < 1 + lretval := FALSE + case nMonth < 1 .or. nMonth > 12 + lretval := FALSE + case nday < 0 .or. nday > 31 + lretval := FALSE + endcase + + return lretval + + +*:---------------------------------------------------------------- +FUNCTION weektest () +*:---------------------------------------------------------------- +*: nWeek := week ( ddate, lSWN ) +*: ============================= +*: Returns the calendar week as a number. If no date is specified, +*: the system date is used. An empty date viz ctod(" / / ") +*: returns 0. + +local getlist := {} +local ddate := ctod (" / / ") +local c := .T. +local nKey +local cMode := space(1) + + do while c + @ 5, 10 say "week (ddate, lSWN) returns the calendar number of the week" + @ 6, 10 say "if lSWN == .T., the simple week number is returned" + @ 7, 10 say "if lSWN == .F.(default), the ISO8601 week number is returned" + + @ 8, 10 say "Test it, Insert a date and " + @ 9, 52 get ddate + @ 10, 61 get cMode picture "Y" + + set confirm on + set escape on + read + set escape off + set confirm on + + nKey := lastkey() + + if nKey == K_ESC + c := FALSE + else + + @ 8, 10 say "The week number is " + ; + padr (ltrim ( str (week ( ddate, cMode=="Y"))), 10) + + set cursor off + inkey(0) + set cursor on + + ddate := ctod (" / / ") + + endif + + enddo + + @ 0, 0 clear + + return NIL + + + +