desktopX.info

Helping DX Coders Create, Enhance & Excel!

Date Format Function

Use this function to format a date text object. I've included an example of how to use/create a dynamic date submenu.

' Create a Text Object called objText and create a script for it.
' Paste this code in it.

Dim oText,iDateFormat
Set oText=DesktopX.Object("objText")

'Called when L-click is released
Function Object_OnLButtonUp(x, y, dragged)
	If not dragged then
		Call MyMenu
	End If
End Function

Dim arrDateFormats()
' Put's Date Formats into an array for a submenu
Function Array_DateFormats
For i=0 to 11
ReDim Preserve arrDateFormats(12)
	arrDateFormats(i)=FormatDate(Date,i)
Next
End Function

' This is the actual Date Formating Function
Function FormatDate(dtmNumericDate,intFormat)
' Use Current Date
dtmDay=DatePart("d",dtmNumericDate)
If dtmDay < 10 Then dtmDay="0"&dtmDay
dtmMth=DatePart("m",dtmNumericDate)
If dtmMth < 10 Then dtmMth="0"&dtmMth
dtmYr=DatePart("yyyy",dtmNumericDate)

' Select Date Format
Select Case intFormat
	' Little endian form (day, month, year)
	Case 0	' dd/mm/yyyy
		FormatDate=dtmDay&"/"&dtmMth&"/"&dtmYr
	Case 1 'dd/mm/yy
		FormatDate=dtmDay&"/"&dtmMth&"/"&Right(dtmYr,2)
	Case 2 ' 16 November 2003
		FormatDate=dtmDay&" "&MonthName(dtmMth,False)&" "&dtmYr
	Case 3 ' dd/mmm/yyyy 16 Nov 2003		
		FormatDate=dtmDay&"/"&MonthName(dtmMth,True)&"/"&dtmYr
	' Middle endian form(month, day, year)
	Case 4	' mm/dd/yyyy 11/16/2003 or 11-16-2003 or 11.16.2003
		FormatDate=dtmMth&"/"&dtmDay&"/"&dtmYr
	Case 5	' mm/dd/yy' 11.16.03
		FormatDate=dtmMth&"/"&dtmDay&"/"&Right(dtmYr,2)	
	Case 6	' November 16, 2003
		FormatDate=MonthName(dtmMth,False)&" "&dtmDay&", "&dtmYr
	Case 7	'mmm d, yyyy Nov. 16, 2003
		FormatDate=MonthName(dtmMth,True)&" "&dtmDay&" , "&dtmYr
	' ISO 8601 (year, month, day)
	Case 8	'yyyy.mm.dd
		FormatDate=dtmYr&"."&dtmMth&"."&dtmDay
	Case 9	'yyyy-mm-dd
		FormatDate=dtmYr&"-"&dtmMth&"-"&dtmDay
	Case 10	'yyyy/mm/dd
		FormatDate=dtmYr&"/"&dtmMth&"/"&dtmDay		
	Case 11	'yyyymmdd
		FormatDate=dtmYr&dtmMth&dtmDay
End SelectiDateFormat
End Function

Sub Object_OnScriptEnter
oText.Text=Date ' Set's text object to today's date
Call  Array_DateFormats
End Sub

' Example of Date Format Submenu
Sub MyMenu
Dim mainmenu, datemenu, result
Set mainmenu = nothing
Set datemenu = nothing
     Set datemenu= DesktopX.CreatePopupMenu
		For x = 0 To UBound(arrDateFormats)-1
			datemenu.AppendMenu 0, 100+x, arrDateFormats(x)
		Next
Set mainmenu = DesktopX.CreatePopupMenu  
mainmenu.AppendMenu 0, 1, "Menu Item A"  
mainmenu.AppendMenu 0, 2, "Menu Item B"
mainmenu.AppendMenu &H00000010, datemenu.MenuID, "Format Date" 
result = mainmenu.TrackPopupMenu(0, System.CursorX, System.CursorY)
Select Case result
Case 1
msgbox "You Chose Menu Item A"
Case 2
msgbox "You Chose Menu Item B"
Case Else
If result>=100 And result<125 Then ' Defines a range
iDateFormat=(result-100)
' Using today's date but, simple to pass a source date
Call FormatDate(Date,iDateFormat)
End If
End Sub