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