Pretty Date & Time

Share your advanced PureBasic knowledge/code with the community.
User avatar
TI-994A
Addict
Addict
Posts: 2512
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:

Pretty Date & Time

Post by TI-994A »

Simple routines for date and time formatting:

Code: Select all

;==============================================================
;  PrettyDate() & PrettyTime() date/time formatting functions
;
;  by TI-994A - free to use, improve, share...
;
;  11th April 2018
;==============================================================

Procedure.s prettyDate(inDate = 0, short = 0)  
  If inDate = 0
    inDate = Date()
  EndIf
  
  day = Day(inDate)
  weekDay = DayOfWeek(inDate)
  month = Month(inDate)
  year = Year(inDate)
  
  If short
    ordinal$ = ""
  Else      
    Select Val(Right(Str(day), 1))
      Case 1
        ordinal$ = "st"
      Case 2
        ordinal$ = "nd"
      Case 3
        ordinal$ = "rd"
      Case 0, 4 To 9
        ordinal$ = "th"
    EndSelect   
    If day > 10 And day < 14
      ordinal$ = "th"
    EndIf
  EndIf 
  
  Restore days
  For dayName = 0 To weekDay
    Read.s day$
  Next dayName
  If short
    day$ = Left(day$, 3)
  EndIf
  
  Restore months
  For monthName = 1 To month
    Read.s month$
  Next monthName
  If short
    month$ = Left(month$, 3)
  EndIf
  
  ProcedureReturn day$ + ", " + Str(day) + ordinal$ + " " + month$ + " " + Str(year)
  
  DataSection
    days:
    Data.s  "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"
    months:
    Data.s "January", "February", "March", "April", "May", "June", "July", 
           "August", "September", "October", "November", "December"
  EndDataSection
  
EndProcedure

Procedure.s prettyTime(inDate = 0, twoDigitHour = 0)
  If inDate = 0
    inDate = Date()
  EndIf
  
  hour = Hour(inDate)
  minute = Minute(inDate)  
  
  meridiem$ = " am"
  If hour > 12
    meridiem$ = " pm"
    hour - 12
  EndIf  
  If hour = 0
    hour = 12
  EndIf
    
  hour$ = Str(hour)
  minute$ = RSet(Str(minute), 2, "0")
  If twoDigitHour
    hour$ = RSet(Str(hour), 2, "0")
  EndIf    
  
  ProcedureReturn hour$ + ":" + minute$ + meridiem$
EndProcedure

Debug "[PRETTY TIME]"
Debug "current time, single-digit hour, default:"
Debug "> " + prettyTime() + #CRLF$
Debug "current time, double-digit hour: "
Debug "> " + prettyTime(0, 1) + #CRLF$
Debug "custom value: " 
Debug "> " + prettyTime(Date(2018, 4, 18, 0, 1, 0)) + #CRLF$ + #CRLF$

Debug "[PRETTY DATE]"
Debug "1. current date, long format, default: "
Debug "> " + prettyDate() + #CRLF$ 
Debug "2. current date, short format: "
Debug "> " + prettyDate(0, 1) + #CRLF$ 
Debug "3. custom value, ordinal example: "
For i = 1 To 4
  Debug "> " + prettyDate(Date(1999, 1, i, 0, 0, 0))
  Debug "> " + prettyDate(Date(1999, 1, 20 + i, 0, 0, 0))
Next i
Debug "> " +  prettyDate(Date(1999, 1, 31, 0, 0, 0))
PRETTY TIME
current time, single-digit hour, default:
> 8:27 pm

current time, double-digit hour:
> 08:27 pm

custom value:
> 12:01 am


PRETTY DATE
1. current date, long format, default:
> Wednesday, 11th April 2018

2. current date, short format:
> Wed, 11 Apr 2018

3. custom value, ordinal example:
> Friday, 1st January 1999
> Thursday, 21st January 1999
> Saturday, 2nd January 1999
> Friday, 22nd January 1999
> Sunday, 3rd January 1999
> Saturday, 23rd January 1999
> Monday, 4th January 1999
> Sunday, 24th January 1999
> Sunday, 31st January 1999
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Pretty Date & Time

Post by RSBasic »

Thanks for sharing.
Image
Image
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Pretty Date & Time

Post by davido »

@TI-994A ,

Nice example. Thank you for sharing. :D
DE AA EB
User avatar
TI-994A
Addict
Addict
Posts: 2512
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:

Re: Pretty Date & Time

Post by TI-994A »

They're indispensable routines from my toolbox; so just thought they might prove useful. :D
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
User avatar
Michael Vogel
Addict
Addict
Posts: 2677
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Pretty Date & Time

Post by Michael Vogel »

I wrote this function which I use for some of my programs (but it does not include weekdays for now):

Code: Select all

#DateFormatLong="%d. %mmmm %yyyy %hh:%ii"
#DateFormatShort="%d. %mmm. '%yy"
#DateFormatDemo="%DD. %MM. %yyyy, %d.%m.'%yy %yy, (%MMMM / %MMM. /%MMM), %HH:%II:%SS, %h:%i:%s"

Procedure.s LocalDateFormat(format.s,date.i)

	Protected result.s=Space(64)
	Protected time.SYSTEMTIME

	With time
		\wYear=Year(date)
		\wMonth=Month(date)
		\wDay=Day(date)
		\wHour=Hour(date)
		\wMinute=Minute(date)
		\wSecond=Second(date)
	EndWith

	If GetDateFormat_(#LOCALE_USER_DEFAULT,#Null,@time,@format,@result,64)
		ProcedureReturn PeekS(@result)
	Else
		ProcedureReturn format
	EndIf

EndProcedure
Procedure.s MyFormatDate(mask.s,date.i)

	Protected month.s
	Protected point.i

	month=LocalDateFormat("MMMM",Date)
	If Len(month)>3
		point=#True
	EndIf

	mask=ReplaceString(mask,"%MMMM",month,#PB_String_NoCase)
	mask=ReplaceString(mask,"%MMM.",LocalDateFormat("MMM",Date)+Left(".",point),#PB_String_NoCase)
	mask=ReplaceString(mask,"%MMM",LocalDateFormat("MMM",Date),#PB_String_NoCase)
	mask=ReplaceString(mask,"%MM",LocalDateFormat("MM",Date),#PB_String_NoCase)
	mask=ReplaceString(mask,"%M",LocalDateFormat("M",Date),#PB_String_NoCase)
	mask=ReplaceString(mask,"%DD",RSet(Str(Day(date)),2,"0"),#PB_String_NoCase)
	mask=ReplaceString(mask,"%D",Str(Day(date)),#PB_String_NoCase)

	mask=FormatDate(mask,date)

	mask=ReplaceString(mask,"%H",Str(Hour(date)),#PB_String_NoCase)
	mask=ReplaceString(mask,"%I",Str(Minute(date)),#PB_String_NoCase)
	mask=ReplaceString(mask,"%S",Str(Second(date)),#PB_String_NoCase)

	ProcedureReturn mask

EndProcedure


Debug MyFormatDate(#DateFormatDemo,Date())
Debug MyFormatDate(#DateFormatLong,Date())
User avatar
TI-994A
Addict
Addict
Posts: 2512
Joined: Sat Feb 19, 2011 3:47 am
Location: Singapore
Contact:

Re: Pretty Date & Time

Post by TI-994A »

Michael Vogel wrote:I wrote this function which I use for some of my programs...
Nice! Locale-based month names from the OS. Thanks Michael. :D
Texas Instruments TI-99/4A Home Computer: the first home computer with a 16bit processor, crammed into an 8bit architecture. Great hardware - Poor design - Wonderful BASIC engine. And it could talk too! Please visit my YouTube Channel :D
User avatar
Sicro
Enthusiast
Enthusiast
Posts: 538
Joined: Wed Jun 25, 2014 5:25 pm
Location: Germany
Contact:

Re: Pretty Date & Time

Post by Sicro »

Little John also wrote such a code (supports Windows, Linux, Mac):
https://github.com/SicroAtGit/PureBasic ... DateEx.pbi
Image
Why OpenSource should have a license :: PB-CodeArchiv-Rebirth :: Pleasant-Dark (syntax color scheme) :: RegEx-Engine (compiles RegExes to NFA/DFA)
Manjaro Xfce x64 (Main system) :: Windows 10 Home (VirtualBox) :: Newest PureBasic version
Post Reply