Simple date format function

[Gösta H. Lovgren-2]

Replaced with more complete code (next post)

[Gösta H. Lovgren-2]

Here's the same function with a valid day in the month check. (Note it doesn't check for Leap Year.)

'

'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 *********************************************
'

[Paul Squires]

Another reason to better learn the Windows API. Check out the GetDateFormat function and all of its awesome power.

#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

[Gösta H. Lovgren-2]

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.

' 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