Code archives/Miscellaneous/TDateTime
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
Date Time Type with Add to date (Years, Months, Days, Hours, Minutes, Seconds) Diff between date in (Years, Months, Days, Hours, Minutes, Seconds) Get Weekday Get_String function that returns the date in the format you desire, currently supports only English and French | |||||
' -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- '############################################################################################################### ' This Code (C) Francois Albert ' ' Edit: 2006/06/01 ' ' Quick: Date and Time Type ' '############################################################################################################### ' -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- '############################################################################################################### ' THIS CODE HOLDS ' ' Objects: ' TDateTime ' ' Test Code: Yes '############################################################################################################### ' -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- '############################################################################################################### ' NOTEPAD ' ' Add a format function '############################################################################################################### ' -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- '############################################################################################################### Strict '############################################################################################################### 'Test Code ' Uncomment code to run tests of datetime routines '############################################################################################################### rem Local dtTest:TDateTime Local dtTest2:TDateTime TDateTime.Language = TDateTime.lngEnglish dtTest = New TDateTime dtTest2 = New TDateTime dtTest.Set_DateTimeCurrent dtTest2.Set_DateTimeSerial(2012,7,19,15,43,12) Print TDateTime.Get_String(dtTest,"Now : DD/MM/YYYY HH:NN:SS") Print TDateTime.Get_String(dtTest,"Test2 : DD/MM/YYYY HH:NN:SS") Print "Diff Year : " + TDateTime.Diff("Y",dttest,dttest2) Print "Diff Month : " + TDateTime.Diff("M",dttest,dttest2) Print "Diff Day : " + TDateTime.Diff("D",dttest,dttest2) Print "Diff Hour : " + TDateTime.Diff("H",dttest,dttest2) Print "Diff Minute : " + TDateTime.Diff("N",dttest,dttest2) Print "Diff Second : " + TDateTime.Diff("S",dttest,dttest2) Print TDateTime.Get_String(TDateTime.Add("Y",25,dtTest),"now + 25 years : DD/MM/YYYY HH:NN:SS") Print TDateTime.Get_String(TDateTime.Add("M",25,dtTest),"now + 25 months : DD/MM/YYYY HH:NN:SS") Print TDateTime.Get_String(TDateTime.Add("D",25,dtTest),"now + 25 days : DD/MM/YYYY HH:NN:SS") Print TDateTime.Get_String(TDateTime.Add("H",25,dtTest),"now + 25 hours : DD/MM/YYYY HH:NN:SS") Print TDateTime.Get_String(TDateTime.Add("N",25,dtTest),"now + 25 minutes : DD/MM/YYYY HH:NN:SS") Print TDateTime.Get_String(TDateTime.Add("S",25,dtTest),"now + 25 seconds : DD/MM/YYYY HH:NN:SS") Print TDateTime.Get_String(dtTest,"Today is DDDD, D of MMMM of the year YYYY") end rem '############################################################################################################### 'End of Test Code '############################################################################################################### '############################################################################################################### 'Object ' TDateTime '############################################################################################################### 'Description ' Handles Date and Time functionalities and variables '############################################################################################################### Type TDateTime '****************************************************************************************************** '** Constants ********************************************************************************** '****************************************************************************************************** Const MonthList$="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC" Const lngEnglish = 0 Const lngFrench = 1 'I list this in constants because even tho its a global, i'd rather have it a constant but blitzmax cant Global txtMonth_Abbrv:String[][]= .. [.. ["Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"],.. ["Janv","Févr","Mars","Avr","Mai","Juin","Juil","Août","Sept","Oct","Nov","Déc"].. ] Global txtMonth_Full:String[][]= .. [.. ["January","February","March","April","May","June","July","August","September","October","November","December"],.. ["Janvier","Février","Mars","Avril","Mai","Juin","Juillet","Août","Septembre","Octobre","Novembre","Décembre"].. ] Global txtDay_Abbrv:String[][]= .. [.. ["Sun","Mon","Tue","Wed","Thu","Fri","Sat"],.. ["Dim","Lun","Mar","Mer","Jeu","Ven","Sam"].. ] Global txtDay_Full:String[][]= .. [.. ["Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"],.. ["Dimanche","Lundi","Mardi","Mercredi","Jeudi","Vendredi","Samedi"].. ] '****************************************************************************************************** '** Globals ********************************************************************************** '****************************************************************************************************** Global Language = 0 '****************************************************************************************************** '** Variables ********************************************************************************** '****************************************************************************************************** Field Year:Int Field Month:Int Field Day:Int Field Hour:Int Field Minute:Int Field Second:Int '****************************************************************************************************** '** Functions ********************************************************************************** '****************************************************************************************************** '== Create =============================================================================== ' Instanciates and returns a new TDateTime object Function Create:TDateTime() Return New TDateTime End Function '== Add =============================================================================== ' Adds a value to a date depending on the selected interval ' Interval: ' Y = Year, M = Month, D = Day, H = Hour, N = Minute, S = Seconds ' Returns the new TDateTime Function Add:TDateTime(pInterval$, pVal:Int, pDate1:TDateTime) Local i:Int Local pDate:TDateTime pDate1.Copy(pDate) Select pInterval$ Case "Y" 'Year pDate.Year :+ pVal Case "M" 'Month 'Checks if passed value is more or equal to a Year i = pVal / 12 If i <> 0 Then ' If more or equal to a Year then use the Year add pDate = TDateTime.Add("Y", i, pDate) pDate.Month :+ pVal mod 12 Else pDate.Month :+ pVal End If 'Checks if adding remaining Months would rollover the Year i = pDate.Month / 12 If i > 0 Then pDate.Month = pDate.Month - (i * 12) pDate = TDateTime.Add("Y", i, pDate) End If Case "D" 'Day 'Converts in julian to add by day and then back to dates i = TDateTime.Conv_Date2Julian(pDate) i :+ pVal TDateTime.Conv_Julian2Date i, pDate Case "H" 'Hour 'Checks if passed value is more or equal to a Day i = pVal / 24 If i <> 0 Then ' If more or equal to a Day then use the Day add pDate = TDateTime.Add("D", i, pDate) pDate.Hour :+ pVal mod 24 Else pDate.Hour :+ pVal End If 'Checks if adding remaining Hours would rollover the Day i = pDate.Hour/ 24 If i > 0 Then pDate.Hour = pDate.Hour - (i * 24) pDate = TDateTime.Add("D", i, pDate) End If Case "N" 'Minute 'Checks if passed value is more or equal to an Hour i = pVal / 60 If i <> 0 Then ' If more or equal to a Hour then use the Hour add pDate = TDateTime.Add("H", i, pDate) pDate.Minute :+ pVal mod 60 Else pDate.Minute :+ pVal End If 'Checks if adding remaining Minutes would rollover the Hour i = pDate.Minute/ 60 If i > 0 Then pDate.Minute = pDate.Minute - (i * 60) pDate = TDateTime.Add("H", i, pDate) End If Case "S" 'Seconds 'Checks if passed value is more or equal to a Minute i = pVal / 60 If i <> 0 Then ' If more or equal to a Minute then use the Minute add pDate = TDateTime.Add("N", i, pDate) pDate.Second :+ pVal mod 60 Else pDate.Second :+ pVal End If 'Checks if adding remaining Seconds would rollover the Minute i = pDate.Second / 60 If i > 0 Then pDate.Second = pDate.Second - (i * 60) pDate = TDateTime.Add("N", i, pDate) End If End Select Return pDate End Function '== Diff =============================================================================== ' Returns the difference between two dates depending on specified interval ' Interval: ' Y = Year, M = Month, D = Day, H = Hour, N = Minute, S = Seconds ' If pDate2 < pDate1 the result will be negative Function Diff(pInterval$, pDate1:TDateTime, pDate2:TDateTime) Local i:Int Local j:Int Select pInterval$ Case "Y" 'Year i = pDate2.Year - pDate1.Year Case "M" 'Month i = (pDate2.Year - pDate1.Year) * 12 + (pDate2.Month - pDate1.Month) Case "D" 'Day 'Converts in julian to substract days i = TDateTime.Conv_Date2Julian(pDate2) - TDateTime.Conv_Date2Julian(pDate1) Case "H" 'Hour i = (TDateTime.Conv_Date2Julian(pDate2) - TDateTime.Conv_Date2Julian(pDate1)) * 24 i :+ pDate2.Hour - pDate1.Hour Case "N" 'Minute i = (TDateTime.Conv_Date2Julian(pDate2) - TDateTime.Conv_Date2Julian(pDate1)) * 1440 i :+ (pDate2.Hour * 60 + pDate2.Minute) - (pDate1.Hour * 60 + pDate1.Minute) Case "S" 'Seconds i = (TDateTime.Conv_Date2Julian(pDate2) - TDateTime.Conv_Date2Julian(pDate1)) * 86400 i :+ (pDate2.Hour * 3600 + pDate2.Minute * 60 + pDate2.Second) - (pDate1.Hour * 3600 + pDate1.Minute * 60 + pDate1.Second) End Select Return i End Function '== Get_String =============================================================================== ' Returns the Date / Time formated to the user's needs ' pFormat: ' YYYY = Year as 4-digit number ' YY = Year as 2-digit number ' MMMM = Month in full description (January, February...) -- Not Implemented ' MMM = Month as an abbreviation (JAN, FEB...) ' MM = Month as 2-digit number (leading zero) ' M = Month without leading zeros ' DDDD = Day in full description (Monday, Tuesday...) -- Not Implemented ' DDD = Day as an abbreviation (MON, TUE...) -- Not Implemented ' DD = Day as a 2-digit number (leading zero) ' D = Day without leading zeros ' HH = Hour as a 2-digit number (leading zero) ' H = Hour without leading zeros ' NN = Minute as a 2-digit number (leading zero) ' N = Minute without leading zeros ' SS = Second as a 2-digit number (leading zero) ' S = Second without leading zeros ' ' Note : Any other string found will be kept the same. ex: "The D of MMMM" would give ' The 2 of January Function Get_String:String(pDate:TDateTime, pFormat:String) Local tStr:String Local i, j, l Local tLast:String Local tTest:String l = pFormat.length tLast = "" tStr = "" For i = 1 To l tTest = Mid$(pFormat, i, 1) If tLast <> tTest Then If tLast <> "" Then tStr = tStr + Get_String_Parser(pFormat, tLast, i, j, pDate) End If tLast = tTest J = 1 Else J :+ 1 End If Next tStr = tStr + Get_String_Parser(pFormat, tLast, i, j, pDate) Return tStr End Function '== Get_String_Parser =============================================================================== ' Parses a single element of the string Function Get_String_Parser:String(pStr:String, pLast:String, S:Int, L:Int, pDate:TDateTime) Local tStr:String Select pLast Case "Y" Select L Case 2 tStr = Get_String_Parser_Formater(pDate.Year,2) Case 4 tstr = Get_String_Parser_Formater(pDate.Year,4) End Select Case "M" Select L Case 1 tStr = String.FromInt(pDate.Month) Case 2 tStr = Get_String_Parser_Formater(pDate.Month,2) Case 3 tStr = txtMonth_Abbrv[Language][pDate.Month-1] Case 4 tStr = txtMonth_Full[Language][pDate.Month-1] End Select Case "D" Select L Case 1 tStr = String.FromInt(pDate.Day) Case 2 tStr = Get_String_Parser_Formater(pDate.Day,2) Case 3 tStr = txtDay_Abbrv[Language][TDateTime.WeekDay(pDate)] Case 4 tStr = txtDay_Full[Language][TDateTime.WeekDay(pDate)] End Select Case "H" Select L Case 1 tStr = String.FromInt(pDate.Hour) Case 2 tStr = Get_String_Parser_Formater(pDate.Hour,2) End Select Case "N" Select L Case 1 tStr = String.FromInt(pDate.Minute) Case 2 tStr = Get_String_Parser_Formater(pDate.Minute,2) End Select Case "S" Select L Case 1 tStr = String.FromInt(pDate.Second) Case 2 tStr = Get_String_Parser_Formater(pDate.Second,2) End Select Default tStr = Mid$(pStr, S-L, L) End Select Return tStr End Function '== Get_String_Parser_Formater =============================================================================== ' Formats with leading zeros if necessary Function Get_String_Parser_Formater:String(Val, Nb) Local tStr:String Local tStr2:String Local i tStr2 = "" tStr = String.FromInt(Val) If tStr.length < Nb Then For i = 1 To Nb - tStr.length tStr2 = tStr2 + "0" Next tStr2 = tStr2 + tStr Else tStr2 = Right$(tStr,Nb) End If Return tStr2 End Function '== Conv_Date2Julian =============================================================================== ' Converts a TDateTime into a Julian Number. ' Returns the Julian Number as an Int Function Conv_Date2Julian(pDate:TDateTime) Local JulianDate:Int ' conversion taken from a website (lost link) JulianDate = 367 * pDate.Year - ((7 * (pDate.Year + 5001 + ((pDate.Month - 9) / 7))) / 4) + ((275 * pDate.Month) / 9) + pDate.Day + 1729777 Return JulianDate End Function '== Conv_Julian2Date =============================================================================== ' Converts a Julian Numbert into a TDateTime Function Conv_Julian2Date(pJulian:Int, pDate:TDateTime var) Local l:Int Local k:Int Local n:Int Local i:Int Local j:Int ' conversion taken from a website (lost link) j = pJulian + 1402 k = ((j - 1) / 1461) l = j - 1461 * k n = ((l - 1) / 365) - (l / 1461) i = l - 365 * n + 30 j = ((80 * i) / 2447) pDate.Day = i - ((2447 * j) / 80) i = (j / 11) pDate.Month = j + 2 - 12 * i pDate.Year = 4 * k + n + i - 4716 End Function '== WeekDay =============================================================================== ' Returns the day of the week (0 = sunday, 6 = saturday) Function WeekDay(pDate:TDateTime) Local y Local M Local W If (pDate.Month < 3) Then M = pDate.Month+12 y = pDate.Year-1 Else M = pDate.Month y = pDate.Year End If W = (pDate.Day + Int((13 * M - 27) / 5) + y + Int(y / 4) - Int(y / 100) + Int(y / 400)) mod 7 Return W End Function '****************************************************************************************************** '** Methods ********************************************************************************** '****************************************************************************************************** '== New =============================================================================== ' Initialises the new object to zero Method New() Year = 0 Month = 0 Day = 0 Hour = 0 Minute = 0 Second = 0 End Method '== Copy =============================================================================== ' Copies the date/time of the current object over the parameter object Method Copy(pDate:TDateTime var) If pDate = Null Then pDate = TDateTime.Create() End If pDate.Set_DateTimeSerial Year, Month, Day, Hour, Minute, Second End Method '== compare =============================================================================== ' Override of compare method Method compare:Int(pDate:Object) Local i:Int Local j:Int Local r:Int 'Compares the two dates in julian (Days) r = TDateTime.Conv_Date2Julian(Self) - TDateTime.Conv_Date2Julian(TDateTime(pDate)) If r = 0 Then 'If the dates are equal, compares the time in seconds i = Self.Hour * 3600 + Self.Minute * 60 + Self.Second j = TDateTime(pDate).Hour * 3600 + TDateTime(pDate).Minute * 60 + TDateTime(pDate).Second r= i - j End If Return r End Method '== Set_DateSerial =============================================================================== ' Sets the Date by specifying each parameter Method Set_DateSerial(pYear:Int, pMonth:Int, pDay:Int) Year = pYear Month = pMonth Day = pDay End Method '== Set_TimeSerial =============================================================================== ' Sets the Time by specifying each parameter Method Set_TimeSerial(pHour:Int, pMinute:Int, pSecond:Int) Hour = pHour Minute = pMinute Second = pSecond End Method '== Set_DateTimeSerial =============================================================================== ' Sets the Date and Time by specifying each parameter Method Set_DateTimeSerial(pYear:Int, pMonth:Int, pDay:Int, pHour:Int, pMinute:Int, pSecond:Int) Set_TimeSerial(pHour, pMinute, pSecond) Set_DateSerial(pYear, pMonth, pDay) End Method '== Set_DateCurrent =============================================================================== ' Sets the Date to the current system date Method Set_DateCurrent() Local tDate$ tDate$ = CurrentDate$() Day = Int(tDate$[..2]) Month = (Instr(MonthList$, tDate$[3..6].ToUpper(), 1) / 3) + 1 Year = Int(tDate$[tDate$.length - 4..]) End Method '== Set_TimeCurrent =============================================================================== ' Sets the Time to the current system date Method Set_TimeCurrent() Local tTime$ tTime$ = CurrentTime$() Hour = Int(tTime$[..2]) Minute = Int(tTime$[3..6]) Second = Int(tTime$[7..]) End Method '== Set_DateTimeCurrent =============================================================================== ' Sets the Date and Time to the current system date Method Set_DateTimeCurrent() Set_DateCurrent Set_TimeCurrent End Method '== Debug_PrintDate =============================================================================== ' Prints the Date and Time in the debug console Method Debug_PrintDate() Print Year + "/" + Month + "/" + Day + " " + Hour + ":" + Minute + ":" + Second End Method End Type |
Comments
| ||
Much interesting, is very surprising BlitzMax doesn't have a data type like this one... |
| ||
Good work, this should be put amongs the modules to be synchronized. |
| ||
Just a note, the line which reads: Second = Int(tTime$[7..]) should read: Second = Int(tTime$[6..]) Smurftra gave me this fix for my framework. |
Code Archives Forum