Author: Gene Wirchenko
Posted: 2018-05-20 at 12:39:20
At 08:30 2018-05-18, mbsoftwaresolutions@mbsoftwaresolutions.com wrote:
>On 2018-05-16 18:02, Ted Roche wrote:
>>LastDayOfMonth() or LDOM back in my 8.3 days, was always a popular request:
>>http://fox.wikis.com/wc.dll?Wiki~FindingTheLastDayOfTheMonth~VB
>
>
>Ed Leafe had shared a ton of date functions for VFP years
>ago. Here's what I have in my framework from Ed:
[snipped code]
I want to play, too! Here are my date functions. Some are
duplicates. Some are specific to my app. The routine that will be
most likely appreciated is megomonth().
***** Start of Included Code *****
*
* Subsection: Date Functions
*
* Many of these functions return date values, but many do not.
* maybelom
* Adjust Date to Last of Month?
* Last Modification: 2000-06-22
*
* Some dates near the end of the month should be adjusted to the last
* day of the month. Adjustment is at operator discretion. "near" means in
* the last five days.
*
* Do nothing to null or blank dates.
procedure maybelom
lparameters thedate, datename
if isnull(thedate) or thedate={}
return thedate
endif
local eom
eom=lastdom(thedate)
if day(eom)-day(thedate)<5 and thedate#eom && Yes, "<" not "<=".
clear typeahead
yesno=messagebox(;
datename+" is close to but not the last day of its month."+CHRCR+;
"Adjust it to be the last day of its month?",;
MB_YESNO+MB_DEFBUTTON1,"Please confirm")=IDYES
if yesno
return eom
else
return thedate
endif
else
return thedate
endif
endproc
* ymendtod
* Make an End of Month Date from Year, Month
* Last Modification: 2005-10-25
procedure ymendtod
lparameters theyear, themonth
local thedate
if theyear#9999 or themonth#12
thedate=date(theyear,themonth,1)
thedate=gomonth(thedate,1)-1
else
thedate=date(9999,12,31) && Handle this extreme case.
endif
return thedate
endproc
* lastdom
* Return Last Day of Month
* Last Modification: 2001-01-21
procedure lastdom
lparameters thedate
*
* The checking for an empty date is not needed in VFP 6, but better safe than
* sorry.
if empty(thedate)
return thedate
endif
return ymendtod(year(thedate),month(thedate))
endproc
* firstdom
* Return First Day of Month
* Last Modification: 2001-01-21
*
* The checking for an empty date is not needed in VFP 6, but better safe than
* sorry.
procedure firstdom
lparameters thedate
if empty(thedate)
return thedate
endif
local daysoff
daysoff=day(thedate)-1
return thedate-daysoff
endproc
* megomonth
* Month End Handling Version of gomonth()
* Last Modification: 99-05-04
*
* If thedate is the last day of the month, make sure that the return value is
* also the last day of its respective month. This adjustment is required
* where thedate is the last day of a month that is shorter than that of the
* return value's month. Example:
* Call Return Value
* ---- ------------
* gomonth({^1999.02.28},-2) {^1998.12.28}
* megomonth({^1999.02.28},-2) {^1998.12.31}
procedure megomonth
lparameters thedate, moveby
if thedate=lastdom(thedate)
return lastdom(gomonth(thedate,moveby))
else
return gomonth(thedate,moveby)
endif
endproc
* goyear
* Adjust Date by Years
* Last Modification: 2013-01-21
*
* If February 28 is adjusted to a leap year, the return date will be February
* 28 if thedate is in a leap year and Febrauary 29 if it is not. IOW, if
* thedate is at the end of the month, the return date will also be so.
procedure goyear
lparameters;
thedate,; && D: base date
theoffset && N: offset in years; can be negative
if empty(thedate)
return thedate
endif
local newdate
newdate=gomonth(thedate,12*theoffset)
if thedate=lastdom(thedate)
newdate=lastdom(newdate)
endif
return newdate
endproc
* dtocyymm
* Convert Date to Month Character Display
* Last Modification: 2000-01-10
*
* This routine is meant to generate two year digits.
procedure dtocyymm
lparameters thedate
local dtosdate, char
dtosdate=dtos(thedate)
char=substr(dtosdate,3,2)+"."+substr(dtosdate,5,2)
return char
endproc
* dtocw
* dtoc() Wrapper
* Last Modification: 99-12-28
*
* This routine shows that the particular call has been dealt with w.r.t. Y2K
* and the intent is that the call should results in year digits according to
* the setting of set century.
procedure dtocw
lparameters thedate
return dtoc(thedate)
endproc
* dtocy2
* dtoc() Generating *Two* Year Digits For Sure
* Last Modification: 99-12-28
*
* This routine shows that the particular call has been dealt with w.r.t. Y2K
* and the intent is that the call should results in two year digits
* regardless of the setting of set century.
*
* This routine is intended for use in reports where the full four-digit year
* would take up needed space.
procedure dtocy2
lparameters thedate
local fcentury, chardate
fcentury=set("century")
set century off
chardate=dtoc(thedate)
set century &fcentury
return chardate
endproc
* dtocy4
* dtoc() Generating *Four* Year Digits For Sure
* Last Modification: 99-12-28
*
* This routine shows that the particular call has been dealt with w.r.t. Y2K
* and the intent is that the call should results in four year digits
* regardless of the setting of set century.
*
* This routine is intended for use where the full four-digit year is
* required.
procedure dtocy4
lparameters thedate
local fcentury, chardate
fcentury=set("century")
set century on
chardate=dtoc(thedate)
set century &fcentury
return chardate
endproc
* dispyymm
* Create a String of YY-MM Format from a Date
* Last Modification: 2002-09-25
*
* This routine is intended to generate a two-digit year.
procedure dispyymm
lparameters thedate
return;
right(str(year(thedate)+100),2)+"-"+right(str(month(thedate)+100),2)
endproc
* datespelled
* Create Spelled-Out Date
* Last Modification: 2007-04-03
*
* Precondition: A date to spell out.
* Postcondition: Returns the date spelled out
* <full month name> <day>, yyyy
* This is almost the same as mdy() with set century on, but mdy() creates
* two-digit day strings as in "April 03, 2007". It also returns "*bad date*"
* for an empty date. This routine does neither.
procedure datespelled
lparameters;
thedate && D: the date to spell out
if empty(thedate)
return ""
else
return cmonth(thedate)+" "+transform(day(thedate))+", "+;
transform(year(thedate))
endif
endproc
* uctdatestr
* Convert Date to UCT Date String
* Last Modification: 2015-08-17
*
* UCT date string format is YYMMDD.
procedure uctdatestr
lparameters;
thedate && D: date to convert
if empty(thedate)
return space(6)
else
return right(dtos(thedate),6)
endif
endproc
* forthedatesstr
* Generate "For the dates" String
* Last Modification: 2015-06-17
*
* Generates strings depending on datelow and datehigh being empty or not:
* "For all dates" if datelow and datehigh are both empty
* "For the dates from 99.99.99 on" if only datehigh is empty
* "For the dates up to 99.99.99" if only datelow is empty
* "For the dates from 99.99.99 to 99.99.99" if neither is empty
procedure forthedatesstr
lparameters;
datelow,; && D: date range low or empty
datehigh && D: date range high or empty
do case
case empty(datelow) and empty(datehigh)
return "For all dates"
case !empty(datelow) and empty(datehigh)
return "For the dates from "+dtocy2(datelow)+" on"
case empty(datelow) and !empty(datehigh)
return "For the dates up to "+dtocy2(datehigh)
otherwise && case !empty(datelow) and !empty(datehigh)
return "For the dates from "+dtocy2(datelow)+" to "+dtocy2(datehigh)
endcase
endproc
* forthedatesshortstr
* Generate "For the dates" Short String
* Last Modification: 2015-06-17
*
* Generates strings depending on datelow and datehigh being empty or not:
* "For all dates" if datelow and datehigh are both empty
* "For 99.99.99 on" if only datehigh is empty
* "For up to 99.99.99" if only datelow is empty
* "For 99.99.99 to 99.99.99" if neither is empty
*
* The reason for the routine is that sometimes, reports are too narrow for
* the longer forms generated by forthedatesstr().
procedure forthedatesshortstr
lparameters;
datelow,; && D: date range low or empty
datehigh && D: date range high or empty
do case
case empty(datelow) and empty(datehigh)
return "For all dates"
case !empty(datelow) and empty(datehigh)
return "For "+dtocy2(datelow)+" on"
case empty(datelow) and !empty(datehigh)
return "For up to "+dtocy2(datehigh)
otherwise && case !empty(datelow) and !empty(datehigh)
return "For "+dtocy2(datelow)+" to "+dtocy2(datehigh)
endcase
endproc
* fortheperiodstr
* Generate "For the period" String
* Last Modification: 2015-06-17
*
* Generates strings depending on datelow and datehigh being empty or not:
* "For all time" if datelow and datehigh are both empty
* "For the period 99.99 on" if only datehigh is empty
* "For the period up to 99.99" if only datelow is empty
* "For the period 99.99 to 99.99"
* if neither is empty and they are not in the same month
* "For the period 99.99" if neither is empty and they are in the same month
procedure fortheperiodstr
lparameters;
datelow,; && D: date range low or empty
datehigh && D: date range high or empty
do case
case empty(datelow) and empty(datehigh)
return "For all time"
case !empty(datelow) and empty(datehigh)
return "For the period from "+dtocyymm(datelow)+" on"
case empty(datelow) and !empty(datehigh)
return "For the period up to "+dtocyymm(datehigh)
case !empty(datelow) and !empty(datehigh) and;
left(dtos(datelow),6)#left(dtos(datehigh),6)
return;
"For the period from "+dtocyymm(datelow)+" to "+dtocyymm(datehigh)
otherwise && case !empty(datelow) and !empty(datehigh) and
&& left(dtos(datelow),6)=left(dtos(datehigh),6)
return "For the period "+dtocyymm(datelow)
endcase
endproc
* wodaterange
* Generate Work Order Date Range
* Last Modification: 2015-08-17
*
* Magic Number (sort of): this code generates the dates in YYMMDD format
* regardless of the set century and set date settings. It is isolated here
* so it can be more easily adjusted if that is later needed.
procedure wodaterange
lparameters datelow, datehigh
return uctdatestr(datelow)+"-"+uctdatestr(datehigh)
endproc
* datercond
* Create Date Range Conditional Expression
* Last Modification: 2012-12-28
procedure datercond
lparameters;
fromfield,; && C: fieldname for from
datefrom,; && D: date value for from
tofield,; && C: fieldname for to
dateto && D: date value for to
local valuefrom, valueto, expr
valuefrom=!isnull(datefrom) and !empty(datefrom)
valueto=!isnull(dateto) and !empty(dateto)
expr=""
do case
case !valuefrom and !valueto
expr=".t."
case valuefrom and !valueto
expr=fromfield+">={^"+dtocy4(datefrom)+"}"
case !valuefrom and valueto
expr=tofield+"<={^"+dtocy4(dateto)+"}"
otherwise && valuefrom and valueto
expr=;
fromfield+">={^"+dtocy4(datefrom)+"}"+;
" and "+;
tofield+"<={^"+dtocy4(dateto)+"}"
endcase
return expr
endproc
* dtroverlap
* Date Range Overlap?
* Last Modification: 2005-08-17
*
* Check if the date range of datelow1 to datehigh1 overlaps any part of the
* date range datelow2 to datehigh2. .t.=overlap, .f.=no overlap
*
* This is one of those picky little routines that can be miscoded all
* too easily.
procedure dtroverlap
lparameters datelow1, datehigh1, datelow2, datehigh2
return !(datehigh2<datelow1 or datelow2>datehigh1)
endproc
***** End of Included Code *****
Sincerely,
Gene Wirchenko
_______________________________________________
Post Messages to: ProFox@leafe.com
Subscription Maintenance: http://mail.leafe.com/mailman/listinfo/profox
OT-free version of this list: http://mail.leafe.com/mailman/listinfo/profoxtech
Searchable Archive: http://leafe.com/archives/search/profox
This message: http://leafe.com/archives/byMID/profox/beb4e61d47a502283da812bfb11662cd@mtlp000085
** All postings, unless explicitly stated otherwise, are the opinions of the author, and do not constitute legal or medical advice. This statement is added to the messages for those lawyers who are too stupid to see the obvious.