Replaced with more complete code (next post)
X
-
Simple date format function
It's a pretty day. I hope you enjoy it.
Gösta
My Ego Site: http://www.SwedesDock.comPB Newby Tips: http://www.swedesdock.com/powerbasic/pb_shortcuts.htmlJWAM: (Quit Smoking): http://www.SwedesDock.com/smokingLDN - A Miracle Drug: http://www.SwedesDock.com/LDN/ -
Here's the same function with a valid day in the month check. (Note it doesn't check for Leap Year.)
'Code:'http://www.powerbasic.com/support/pbforums/newreply.php?do=newreply&noquote=1&p=314044 '******* Format Date ********************************************* ' Example Call: ' Dat$ = Format_Date(20090419) '(yyyymmdd&) 'Returns "Apr 19, 2009" in Dat$ ' Note - doesn't allow for leap year - just to keep it simple ' Function Format_Date(d1x As Long) As String Local l, Months() As String Local dy, mn, yr, ctr, Days_In_Month() As Long ' Dim Months$(1 To 12), Days_In_Month(1 To 12) Months$(1) = "Jan" : Days_In_Month(1) = 31 Months$(2) = "Feb" : Days_In_Month(2) = 28 Months$(3) = "Mar" : Days_In_Month(3) = 31 Months$(4) = "Apr" : Days_In_Month(4) = 30 Months$(5) = "May" : Days_In_Month(5) = 31 Months$(6) = "Jun" : Days_In_Month(6) = 30 Months$(7) = "Jul" : Days_In_Month(7) = 31 Months$(8) = "Aug" : Days_In_Month(8) = 31 Months$(9) = "Sep" : Days_In_Month(9) = 30 Months$(10) = "Oct": Days_In_Month(10) = 31 Months$(11) = "Nov": Days_In_Month(11) = 30 Months$(12) = "Dec": Days_In_Month(12) = 31 ' 'sending error check If d1x > 29990101 Or _ d1x < 19000101 Then 'minimum date allowed - can be changed to suit d1x = 19000101 'or if preferred: Function = "Date Error" Exit Function End If ' ' 'Check for day/month validity l$ = Trim$(Str$(D1x)) 'strip leading space yr = Val(Left$(l$, 4)) 'year mn = Val(Mid$(l$, 5, 2))'month dy = Val(Right$(l$, 2)) 'day ' If mn > 12 Then mn = 1 : Incr yr 'Past december so next year If mn < 1 Then mn = 12: Decr yr 'Before January so previous year ' If dy > Days_In_Month(mn) Then 'Must be the next month dy = 1 ' so set to 1st day of next month Incr mn 'set to next month If mn > 12 Then mn = 1: Incr yr ' Past December so set to Jan and next year End If ' If dy < 1 Then 'must be previous month Decr mn 'set it If Mn < 1 Then mn = 12: Decr yr 'Oops, must be Dec of previous year dy = Days_In_Month(mn) 'Last day pf previous month End If ' Function = Months$(mn) & Str$(dy) & "," & Str$(yr) End Function '******* End Format Date ********************************************* '
It's a pretty day. I hope you enjoy it.
Gösta
My Ego Site: http://www.SwedesDock.comPB Newby Tips: http://www.swedesdock.com/powerbasic/pb_shortcuts.htmlJWAM: (Quit Smoking): http://www.SwedesDock.com/smokingLDN - A Miracle Drug: http://www.SwedesDock.com/LDN/
-
Another reason to better learn the Windows API. Check out the GetDateFormat function and all of its awesome power.
Code:#Compile Exe #Include "win32api.inc" Function FF_GetDate( TheDate As SYSTEMTIME, _ TheMask As String _ ) As String Local zText As Asciiz * %MAX_PATH '= Return New Formated Date Depending On The Users Selection Date Mask. GetDateFormat %LOCALE_USER_DEFAULT, _ 0, _ ByVal VarPtr(TheDate), _ ByCopy TheMask, _ zText, _ SizeOf(zText) Function = zText End Function Function PBMain() As Long 'Picture Meaning 'd Day Of month As digits With no leading zero For Single-digit days. 'dd Day Of month As digits With leading zero For Single-digit days. 'ddd Day Of week As a three-letter abbreviation. The Function uses the LOCALE_SABBREVDAYNAME value associated With the specified locale. 'dddd Day Of week As its Full Name. The Function uses the LOCALE_SDAYNAME value associated With the specified locale. 'M Month As digits With no leading zero For Single-digit months. 'MM Month As digits With leading zero For Single-digit months. 'MMM Month As a three-letter abbreviation. The Function uses the LOCALE_SABBREVMONTHNAME value associated With the specified locale. 'MMMM Month As its Full Name. The Function uses the LOCALE_SMONTHNAME value associated With the specified locale. 'y Year As last two digits, but With no leading zero For years less than 10. 'yy Year As last two digits, but With leading zero For years less than 10. 'yyyy Year represented by Full four digits. 'gg Period/era String. The Function uses the CAL_SERASTRING value associated With the specified locale. This element Is ignored If the date To be formatted does Not have an associated era Or period String. ' Return date based on today's date ? FF_GetDate( ByVal %Null, "yyyy-MM-dd") ? FF_GetDate( ByVal %Null, "MMM d, yyyy") ' Format a specific date Local MyDate As SYSTEMTIME MyDate.wYear = 1968 MyDate.wMonth = 12 MyDate.wDay = 25 ? FF_GetDate( MyDate, "yyyy-MM-dd") ? FF_GetDate( MyDate, "MMM d, yyyy") End Function
Paul Squires
FireFly Visual Designer (for PowerBASIC Windows 10+)
Version 3 now available.
http://www.planetsquires.com
Comment
-
And here's (another) SDK version (courtesy MCM). Just for the record, mine was DDT only. However this exercise clearly demonstrates the power of these forums. From Dummy Level to Epert(s). Stuff for everybody.
Code:' Dat$ = Format_Date(20090419) '(yyyymmdd&) ' 'Returns "Apr 19, 2009" in Dat$ ' Note - this version DOES allow for leap year. FUNCTION Format_date (d AS LONG) As STRING LOCAL st as systemtime, szFmt AS ASCIIZ * 32, szOut AS ASCIIZ * 32 St.wyear = d& \ 10000& st.wMonth = (d& MOD 10000&) \ 100& st.wDay = d& MOD 100& szFmt = "MMM d', 'yyyy" GetDateFormat %LOCALE_USER_DEFAULT,BYVAL %NULL, st, szFmt, szOut, SIZEOF(szOut) IF szOut = "" THEN szOut = "Date Error" END IF FUNCTION = szOut END FUNCTION
Last edited by Gösta H. Lovgren-2; 19 Apr 2009, 08:55 PM.It's a pretty day. I hope you enjoy it.
Gösta
My Ego Site: http://www.SwedesDock.comPB Newby Tips: http://www.swedesdock.com/powerbasic/pb_shortcuts.htmlJWAM: (Quit Smoking): http://www.SwedesDock.com/smokingLDN - A Miracle Drug: http://www.SwedesDock.com/LDN/
Comment
Comment