81c9b0506c
* contrib/*
* Deleted 'www.' from harbour-project.org website name.
(www.harbour-project.org -> harbour-project.org)
1246 lines
28 KiB
Plaintext
1246 lines
28 KiB
Plaintext
/*
|
|
* $Id$
|
|
*/
|
|
|
|
/*
|
|
* Harbour Project source code:
|
|
* Program to test functions to mimic Clipper Tools III date & time functions.
|
|
* (C) Alan Secker 2002 <alansecker@globalnet.co.uk>
|
|
*
|
|
* small changes: Martin Vogel <vogel@inttec.de> 2003
|
|
*
|
|
* www - http://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 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 := .F.
|
|
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 := .F.
|
|
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 := .F.
|
|
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 := .F.
|
|
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 := .T.
|
|
|
|
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 := .F.
|
|
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 := .F.
|
|
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 := .F.
|
|
|
|
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 := .T.
|
|
endif
|
|
|
|
nKey := lastkey()
|
|
|
|
if nKey == K_ESC
|
|
c := .F.
|
|
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 .F. for a non-leap year but .T. 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 := .F.
|
|
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 .T., 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 := .F.
|
|
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 := .F.
|
|
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 := .F.
|
|
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 := .F.
|
|
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 := .F.
|
|
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 .T., otherwise .F..
|
|
*: 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 := .F.
|
|
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 := .F.
|
|
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 := .F.
|
|
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 := .F.
|
|
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 := .F.
|
|
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 := .F.
|
|
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 := .F.
|
|
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 nYear
|
|
local nMonth
|
|
local nDay
|
|
local lretval := .T.
|
|
|
|
nYear := val ( left ( cAnsidate, 4))
|
|
nMonth := val (substr ( cAnsidate, 5, 2))
|
|
nDay := val ( right ( cAnsidate, 2))
|
|
|
|
do case
|
|
|
|
case nYear < 1
|
|
lretval := .F.
|
|
case nMonth < 1 .or. nMonth > 12
|
|
lretval := .F.
|
|
case nday < 0 .or. nday > 31
|
|
lretval := .F.
|
|
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 <lSWN>"
|
|
@ 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 := .F.
|
|
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
|