Difference between dates

[mjcmkrsr]

Hi,

Have you ever wondered in how may years aunt Tilly (well known person in Hacker's Guide) will celebrate her 90th birthday? Or how many days you'll still have to work till your retirement? Or how many WEs you already have gone through?

Comes in this little program (code below).

Enjoy

MarK

**********
* This app 
* - calculates the total and the sub-total of selected days between two dates
* - diplays the difference between the two dates in words
**********

goForm = CREATEOBJECT("frmForm")
goForm.Visible = .T.
goForm.Show()

READ EVENTS

CLOSE ALL
CLEAR ALL 

RETURN

**********

DEFINE CLASS frmForm as Form

Caption = "Selected days - names - numbers - text"
AutoCenter = .T.
BorderStyle = 2
Width = 570
Height = 330
MinButton = .F.
MaxButton = .F.
Themes = .F.
ShowTips = .T.

	DIMENSION laSelection[7], laTotalDays[1]

	laTotalDays[1] = 0
	
		ADD OBJECT lblSDate as Label WITH Left = 12, Top = 12, Caption = "Start date"
		ADD OBJECT lblEDate as Label WITH Left = 138, Top = 12, Caption = "End date"
		ADD OBJECT lblSDays as Label WITH Left = 12, Top = 72, Autosize = .T., Caption = "Click to select day", ToolTipText = " CTRL / SHIFT Click to multi-select "
		ADD OBJECT lblTSDays as Label WITH Left = 138, Top = 72, Autosize = .T., Caption = "Total of selected days: ", Visible = .F.
		ADD OBJECT lblInWords as Label WITH Left = 12, Top = 294, Autosize = .T., Caption = "Difference in words: ", Visible = .F.
		ADD OBJECT lblNDays as Label WITH Left = 420, Top = 294, Autosize = .T., Caption = "Total Days: ", Visible = .F.

		ADD OBJECT txtSDate as textbox WITH Top = 36, Left = 12, Width = 90, Value = {}
		ADD OBJECT txtEDate as textbox WITH Top = 36, Left = 138 , Width = 90, Value = {}
		ADD OBJECT txtWords as textbox WITH Top = 294, Left = 138, Width = 228, ReadOnly = .T., DisabledBackColor = RGB(0, 240, 240), Visible = .F.
		ADD OBJECT txtNDays as textbox WITH Top = 294, Left = ThisForm.Width - 24 - 60, Width = 60, ReadOnly = .T., DisabledBackColor = RGB(0, 240, 240), Visible = .F.

		ADD OBJECT lstList as ListBox WITH ;
			Top = 96, ;
			Left = 12, ;
			Width = 120, ;
			Height = ThisForm.Height - 24 - 126, ;
			ItemBackColor = RGB(0, 240, 240), ;
			Anchor = 7, ;
			RowSourceType = 1, ;
			RowSource = " Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday", ;
			ColumnCount = 1, ;
			ColumnWidths = "54, 0", ;
			Multiselect = .T., ;
			ToolTipText = " CTRL / SHIFT Click to multi-select ", ;
			IncrementalSearch = .T.
			
			PROCEDURE lstList.Click()
				FOR lnI = 1 TO This.ListCount
					IF This.Selected(lni)
						ThisForm.laSelection[lni] = ALLTRIM(This.List(lnI, This.BoundColumn))

					ENDIF 
				ENDFOR 
			ENDPROC 
		
		ADD OBJECT cmdDoit as CommandButton WITH Left = 252, Top = 12, Height = 48, Width = ThisForm.Width - 24 - 252, BackColor = RGB(0, 240, 240), ;
								FontBold = .T. , FontSize = 12, Caption = "Calculate", Anchor = 11


			PROCEDURE cmdDoit.Click()
				LOCAL liWeeks, liRDays, liTDays, lcSDay
				
				liWeeks = 0
				liRDays = 0
				liTDays = 0
				lcSDay = ""
				
				IF ThisForm.txtSDate.Value = {} OR ThisForm.txtEDate.Value =  {} OR ThisForm.txtEDate.Value <= ThisForm.txtSDate.Value
					= MESSAGEBOX("Please fill in the dates in correct order", 16, "Choose dates", 3000)

				ELSE 
				
					SET SAFETY OFF  
					ZAP IN csrSelectedDays
					SET SAFETY ON 
					
					FOR i = 1 TO ALEN(ThisForm.laSelection)
						IF VARTYPE(ThisForm.laSelection[i]) = "C"
							INSERT INTO csrSelectedDays VALUES (ThisForm.laSelection[i], 0)

						ENDIF 
					ENDFOR 
				
					IF RECCOUNT("csrSelectedDays") > 0
						liTDays = ThisForm.txtEDate.Value - ThisForm.txtSDate.Value
				
						liWeeks = INT(liTDays / 7)
					
						UPDATE csrSelectedDays SET iDays = liWeeks
					
						liRDays = liTDays - (liWeeks * 7)
					
						FOR i = 0 TO liRDays - 1
							lcSDay = CDOW(ThisForm.txtSDate.Value + (liWeeks * 7) + i)

							IF ASCAN(ThisForm.laSelection, lcSDay) != 0
								UPDATE csrSelectedDays SET iDays = iDays + 1 WHERE cName = lcSDay
						
							ENDIF 
						ENDFOR 
					
					
						ThisForm.txtWords.Value = ThisForm.AMDateDiffAsWords(ThisForm.txtSDate.Value, ThisForm.txtEDate.Value)
						ThisForm.txtNDays.Value = liTDays
											
						SELECT SUM(iDays) FROM csrSelectedDays INTO ARRAY ThisForm.laTotalDays
						
						WITH ThisForm
							.grdSelectedDays.Visible = .T.
							.lblTSDays.Visible = .T.
							.lblInWords.Visible = .T.
							.lblNDays.Visible = .T.
							.txtNDays.Visible = .T.
							.txtWords.Visible = .T.
							.txtNDays.Visible = .T.
						ENDWITH 

						LOCATE 

					ELSE
						WITH ThisForm
							.laTotalDays[1] = 0
							.grdSelectedDays.Visible = .F.
							.lblTSDays.Visible = .F.
							.lblInWords.Visible = .F.
							.lblNDays.Visible = .F.
							.txtNDays.Visible = .F.
							.txtWords.Visible = .F.
							.txtNDays.Visible = .F.
						ENDWITH 
						
						 = MESSAGEBOX("Please choose at least one day", 64, "Choose days", 3000)

					ENDIF 

					FOR i = 1 TO ALEN( ThisForm.laSelection)
						ThisForm.laSelection[i] = .F.
					Endfor

					WITH ThisForm
						.lstList.Clear()
						.lstList.Requery()
						.lblTSDays.Caption = "Total of selected days (" + TRANSFORM(ThisForm.txtEDate.Value) + " excluded) : " + TRANSFORM(ThisForm.laTotalDays[1])
						.Refresh()
					ENDWITH 
				ENDIF 
			ENDPROC 
		
		ADD OBJECT grdSelectedDays AS Grid WITH ;
			RecordSource = "csrSelectedDays", ;
			ColumnCount = -1 , ;
			Left = 138, ;
			Top = 96, ;
			Width = ThisForm.Width - 24 - 138, ;
			Height = ThisForm.Height - 24 - 126, ;
			BackColor = RGB(0, 240, 240), ;
			DeleteMark = .F. , ;
			Enabled = .F. , ;
			Anchor = 15, ;
			Visible = .F.
	 
			PROCEDURE grdSelectedDays.Init
				 WITH This.Column1
				  .Width = 78			
				  .Header1.Caption = "Day"
				 ENDWITH

				 WITH This.Column2
				  .Width = 60			
				  .Header1.Caption = "Number"
				 ENDWITH

			 ENDPROC 
			 
	PROCEDURE Load()
		CREATE CURSOR csrSelectedDays (cName C(18), iDays I)
		
	ENDPROC 
      
	PROCEDURE Destroy()
		CLEAR EVENTS
	
	ENDPROC 
	
	FUNCTION AMDateDiffAsWords
		*!*	written by MarK - credit to Andrew Mozley

		LPARAMETERS  tdSDate, tdEDate

		LOCAL ldEofMonth as Date, ;
				liTotalMonths as Integer, ;
				liYears as Integer, ;
				liMonths as Integer, ;
				liWeeks as Integer, ;
				liDays as Integer, ;
				lcAnswer as Character
				 
				ldEndOfMonth = {}
				liTotalMonths = 0
				liYears = 0
				liMonths = 0
				liWeeks = 0
				liDays = 0
				lcAnswer = ""  

		*!*	If Day(tdSDate) > Day(tdEDate), we calculate the number of days remaining in the 
		*!*	start month (may be zero) and add it to the number of days in the end date

		IF DAY(tdSDate) > DAY(tdEDate)
			ldEofMonth = GoMonth(tdSDate,1) - Day(GoMonth(tdSDate,1))
			liDays = DAY(tdEDate) + (ldEofMonth - tdSDate)

		ELSE
			liDays = DAY(tdEDate) - DAY(tdSDate)
	
		ENDIF
			
		*!*	Now the total number of months

		liTotalMonths = MONTH(tdEDate) - MONTH(tdSDate) + (12 * (YEAR(tdEDate) - YEAR(tdSDate))) - IIF(DAY(tdSDate) > DAY(tdEDate), 1, 0)
		liYears = INT(liTotalMonths / 12)
		liMonths = liTotalMonths - (liYears * 12)
		liWeeks = INT(liDays / 7)
		liDays = liDays - (7 * liWeeks)
		   
		*!*	And format the answer as text

		lcAnswer = ""

		IF liYears > 0
			lcAnswer = ALLTRIM(STR(liYears)+ " Year" + IIF(liYears > 1,"s",""))
		ENDIF

		IF liMonths > 0
			lcAnswer = lcAnswer +" "+ ALLTRIM(STR(liMonths))+" Month"+ IIF(liMonths > 1,"s","")
		ENDIF

		IF liWeeks > 0
			lcAnswer = lcAnswer +" "+ ALLTRIM(STR(liWeeks)) +" Week"+ IIF(liWeeks > 1,"s","")
		ENDIF
		
		IF liDays > 0
			lcAnswer = lcAnswer +" "+ ALLTRIM(STR(liDays))+" Day"+ IIF(liDays > 1,"s","")
		ENDIF
		
		RETURN lcAnswer
ENDDEFINE 
**********