Code archives/Miscellaneous/Some date functions
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
These are a small collection of date functions I created for my console project. Use at your leasure. I'll probably post an example or two some day. Cheers. | |||||
Function Convert_FileDate_To_Expanded$(fd$,mode%=2) m% = Int(Mid$(fd$,1,2)) d% = Int(Mid$(fd$,4,2)) y% = Int(Mid$(fd$,7,4)) If m%>0 And d%>0 And y%>0 Then Return (GetDayOfWeek$(d%,m%,y%,mode%)+ " " + GetMonthAlpha$(m%,mode%) + " " + Str$(d%) + " " + Str$(y%)) Else Return (Str$(d%) + " " + Str$(y%)) EndIf End Function Const Months$ = "January Febuary March April May June July August SeptemberOctober November December " Function GetMonthNumeric(month$) For i% = 1 To 12 If Mid$(Months$,(i% * 9 - 8),3) = month$ Then Return i% Next Return 0 End Function Function GetMonthAlpha$(month%,mode% = 2) If mode% = 1 Then Return Mid$(Months$,(month% * 9 - 8),3) ElseIf mode% = 2 Then Return Trim$(Mid$(Months$,(month% * 9 - 8),9)) ElseIf mode% = 3 Then Return Mid$(Months$,(month% * 9 - 8),1) Else Return Mid$(Months$,(month% * 9 - 8),9) EndIf End Function Const Weekdays$ = "Sunday Monday Tuesday WednesdayThursday Friday Saturday " Function GetDayOfWeek$(day,month,year, mode% = 2) d%=GetDayOfWeekVal%(day,month,year) If mode% = 1 Then Return Mid$(Weekdays$,(d% * 9 - 8),3) ElseIf mode% = 2 Then Return Trim$(Mid$(Weekdays$,(d% * 9 - 8),9)) ElseIf mode% = 3 Then Return Mid$(Weekdays$,(d% * 9 - 8),1) Else Return Mid$(Weekdays$,(d% * 9 - 8),9) EndIf End Function Function GetDayOfWeekName$(d%, mode% = 1) If mode% = 1 Then Return Mid$(Weekdays$,(d% * 9 - 8),3) ElseIf mode% = 2 Then Return Trim$(Mid$(Weekdays$,(d% * 9 - 8),9)) Else Return Mid$(Weekdays$,(d% * 9 - 8),1) EndIf End Function Const DaysInMonth$ = "312831303130313130313031" Function GetDaysInMonth%(month%, year%) If month% = 2 And LeapYear(year%) Then Return 29 Else Return Int(Mid$(DaysInMonth$,(month% * 2 - 1),2)) EndIf End Function Function LeapYear(year%) If (year Mod 400) = 0 Then Return True If (year Mod 4) = 0 And (year Mod 100) <> 0 Then Return True Return False End Function Function GetDayOfWeekVal%(day,month,year) a = (14 - month)/12 y = year - a m = month + 12*a - 2 d = (day + y + y/4 - y/100 + y/400 + (31*m)/12) Return ((d Mod 7) + 1) End Function |
Comments
| ||
Calendar example:Type calendar Field day% Field t% Field d% End Type Function calendar(year$, width% = 3) height% = Int(12 / width%) - 1 today$ = CurrentDate$() currentday% = Int(Left$(today$,2)) currentmonth% = GetMonthNumeric(Mid$(today$,4,3)) currentyear% = Int(Right$(today$,4)) If year$ = "" Then y% = Int(Right$(today$,4)) Else y% = Int(year$) EndIf For w = 1 To 7 dow$ = dow$ + GetDayOfWeekName$(w) Next For month_y = 0 To height c$ = "" For month_x = 1 To width ; number of months displayed in width cal.calendar = New calendar cal\day = 0 cal\t = GetDaysInMonth(month_y*width%+month_x,y%) cal\d = GetDayOfWeekVal(1,month_y*width%+month_x,y%) c$ = c$ + GetMonthAlpha$(month_y*width%+month_x,4) + String$(" ",12) Next Print c$ Print String$(dow$,width) For i = 1 To 6 ; number of lines for each month c$ = "" month_x = 0 For cal.calendar = Each calendar month_x = month_x + 1 month% = (month_x + month_y * width) For w = 1 To 7 If cal\day = 0 Then If cal\d = w Then cal\day = 1 EndIf Else cal\day = cal\day + 1 EndIf If cal\day <= cal\t And cal\day > 0 Then If cal\day = currentday And month = currentmonth And y% = currentyear Then c$ = c$ LSet$(cal\day,2) Else c$ = c$ + RSet$(LSet$(cal\day,2),3) EndIf Else c$ = c$ + " " EndIf Next Next If Trim(c$) > "" Then Print c$ Next Delete Each calendar Next End Function Graphics 1024,768,32,2 calendar(1998, 3) WaitKey() End Make sure to include the above functions to make this work! The parms for Calendar is year and number of months in width. |
Code Archives Forum