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
On Sun, May 20, 2018 at 1:39 PM, Gene Wirchenko genew@telus.net wrote:
thedate=date(9999,12,31) && Handle this extreme case.
And that, kids, is why we call it "The Y10K crisis..."
If you want, for example, the last Friday of the month you could use LastDayOfMonth(Date(),"Friday") or LastDayOfMonth(5,2018,"Friday")
Function LastDayOfMonth(tuParm1, tuParm2, tuParm3)
Local ldLastDate,lcDayOfWeek,loDaysOfWeek ldLastDate = {} If (Pcount() = 3 And Vartype(tuParm3) = "C") Or (Pcount() = 2 And Vartype(tuParm2) = "C") lcDayOfWeek = Iif(Pcount()=2,tuParm2,tuParm3) If InList(lcDayOfWeek,"Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday") loDaysOfWeek = CreateObject("Collection") loDaysOfWeek.Add(1,"Sunday") loDaysOfWeek.Add(2,"Monday") loDaysOfWeek.Add(3,"Tuesday") loDaysOfWeek.Add(4,"Wednesday") loDaysOfWeek.Add(5,"Thursday") loDaysOfWeek.Add(6,"Friday") loDaysOfWeek.Add(7,"Saturday") EndIf EndIf Do Case Case InList(Vartype(tuParm1),"D","T") ldLastDate = Gomonth(tuParm1,1)-Day(tuParm1) Case Vartype(tuParm1) = "N" And Vartype(tuParm2) = "N" ldLastDate = Date(tuParm2,tuParm1+1,1)-1 EndCase If Not Empty(ldLastdate) And Not Empty(lcDayOfWeek) ldLastDate = ldLastDate - Mod((7-(loDaysOfWeek.Item(lcDayOfWeek) - loDaysOfWeek.Item(CDOW(ldLastDate)))),7) EndIf Return ldLastDate
-----Original Message----- From: ProFox [mailto:profox-bounces@leafe.com] On Behalf Of Ted Roche Sent: 20 May 2018 20:32 To: profox@leafe.com Subject: Re: Fun with date calculations in VFP
On Sun, May 20, 2018 at 1:39 PM, Gene Wirchenko genew@telus.net wrote:
thedate=date(9999,12,31) && Handle this extreme case.
And that, kids, is why we call it "The Y10K crisis..."
On 05/20/18 3:31 PM, Ted Roche wrote:
On Sun, May 20, 2018 at 1:39 PM, Gene Wirchenko genew@telus.net wrote:
thedate=date(9999,12,31) && Handle this extreme case.And that, kids, is why we call it "The Y10K crisis..."
I looking forward to all the $$$$ I'm going to make when people call me in from retirement to fix all their old VFP programs before midnight 9999! Can we say "Gouging rates?"
nb: Don't lose vfp install disk before then!
--- This email has been checked for viruses by Avast antivirus software. https://www.avast.com/antivirus
On Mon, May 21, 2018 at 3:37 PM, Vince Teachout teachv@taconic.net wrote:
nb: Don't lose vfp install disk before then!
Gotcha covered: https://imgur.com/a/NPMsnUL
Hmm... might need to find a disk drive too. And a controller. Edge-connector cable... hmm....
On 2018-05-21 15:37, Vince Teachout wrote:
On 05/20/18 3:31 PM, Ted Roche wrote:
On Sun, May 20, 2018 at 1:39 PM, Gene Wirchenko genew@telus.net wrote:
thedate=date(9999,12,31) && Handle this extreme case.And that, kids, is why we call it "The Y10K crisis..."
I looking forward to all the $$$$ I'm going to make when people call me in from retirement to fix all their old VFP programs before midnight 9999! Can we say "Gouging rates?"
nb: Don't lose vfp install disk before then!
You must be going to do cryogenic deep freeze!
Who has anything like a disk drive on a laptop today?
On Mon, May 21, 2018 at 2:37 PM, Vince Teachout teachv@taconic.net wrote:
On 05/20/18 3:31 PM, Ted Roche wrote:
On Sun, May 20, 2018 at 1:39 PM, Gene Wirchenko genew@telus.net wrote:
thedate=date(9999,12,31) && Handle this extreme case.And that, kids, is why we call it "The Y10K crisis..."
I looking forward to all the $$$$ I'm going to make when people call me in from retirement to fix all their old VFP programs before midnight 9999! Can we say "Gouging rates?"
nb: Don't lose vfp install disk before then!
This email has been checked for viruses by Avast antivirus software. https://www.avast.com/antivirus
[excessive quoting removed by server]
On 05/29/18 1:04 PM, Stephen Russell wrote:
Who has anything like a disk drive on a laptop today?
Good point. You think that problem might get worse by 9,999 A.D.?
--- This email has been checked for viruses by Avast antivirus software. https://www.avast.com/antivirus
On Tue, May 29, 2018 at 1:04 PM, Stephen Russell srussell705@gmail.com wrote:
Who has anything like a disk drive on a laptop today?
Pretty sure everyone has something "like" a disk drive -- isn't that what the D in SSD and HDD stand for?
Even my Chromebook and Android phone have something "like" a disk drive.
We're still toting around workstations with one and TWO rotating-magnetic-media (shades-of-shugart!) hard disk drives.
In my mind was implying a DVD & Floppy Disk and not internal system drive(s).
On Thu, May 31, 2018 at 8:34 AM, Ted Roche tedroche@gmail.com wrote:
On Tue, May 29, 2018 at 1:04 PM, Stephen Russell srussell705@gmail.com wrote:
Who has anything like a disk drive on a laptop today?
Pretty sure everyone has something "like" a disk drive -- isn't that what the D in SSD and HDD stand for?
Even my Chromebook and Android phone have something "like" a disk drive.
We're still toting around workstations with one and TWO rotating-magnetic-media (shades-of-shugart!) hard disk drives.
-- Ted Roche Ted Roche & Associates, LLC http://www.tedroche.com
[excessive quoting removed by server]