/* * $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