Date formatting...

[pappawinni]

So boys and girls

I also created something to do a kind of emulation by
f_formatDate(date, formatstring), e.g.
? f_formatDate(dtDt,"dddd dd-MMM-yyyy hh:mm ap")

there are also functions:
f_DayOfWeek(date )
f_DayName(date)
f_MonthName(date)

Code: Select all

function f_DayOfWeek(dtDate as date, iFirstDayOfWeek as integer = 0 ) as integer
  /*
   Function calculating day of the week for dtDate
   Day Number 1 by default is Sunday but this can be modified
   by setting iFirstDayOfWeek.
   iFirstDayOfWeek = 1 moves day number 1 to Monday and so on.
   So without setting iFirstDayOfWeek the function returns
   1 for Sunday, 2 for Monday..
   with iFirstDayOfWeek set to 1 the function returns
   1 for Monday, 2 for Tuesday..
  */
  Dim iDayDiff as integer
  Dim iDay as integer
  Dim dBase as date
  Dim iOut as integer
 
  '31.12.1899 was sunday
  dBase = #1899-12-31#
  dBase = dateadd("d",iFirstDayOfWeek,dBase)
  iDayDiff = datediff("d",dtDate,dBase)
  iOut = (iDayDiff mod 7) + 1
  if iOut <= 0 then iout = 7 + iout
  return iOut
end function


function f_DayName(dtDate as date) as string
  /*
   Function calculating DayName for dtDate
  */
  Dim iDayDiff as integer
  Dim iDay as integer
  Dim dBase as date
  Dim strOut as string
 
  '31.12.1899 was sunday
  dBase = #1899-12-31#
  iDayDiff = datediff("d",dtDate,dBase)
  iDay = (iDayDiff mod 7) + 1
  if iDay <= 0 then iDay = 7 + iDay
  select case iDay
     case 1: strOut = "Sunday"
     case 2: strOut = "Monday"
     case 3: strOut = "Tuesday"
     case 4: strOut = "Wednesday"
     case 5: strOut = "Thursday"
     case 6: strOut = "Friday"
     case 7: strOut = "Saturday"
     case else: strOut = ""
  end select     
  return strOut
end function

function f_MonthName(dtDate as date) as string
  /*
   Function calculating MonthName for dtDate
  */
  Dim iMonth as integer = month(dtDate)
  Dim strOut as string
  select case iMonth
    case 1: strOut = "January"
    case 2: strOut = "February"
    case 3: strOut = "March"
    case 4: strOut = "April"
    case 5: strOut = "Mai"
    case 6: strOut = "June"
    case 7: strOut = "July"
    case 8: strOut = "August"
    case 9: strOut = "September"
    case 10: strOut = "October"
    case 11: strOut = "November"
    case 12: strOut = "December"
    case else: strOut = ""
  end select   
  return strOut
end function

function f_formatDate( dtDate as date, strFormat as string) as string
/*   emulates format(date,format)
     convention : Midnight is 12:00 AM while noon is 12:00 PM

     Uses:
         f_DayName( dtDate as Date )
         f_MonthName( dtDate as Date )
*/
  Dim iarrA[1] as integer
  Dim strF as string
  Dim strL as string
  Dim strC as string
  Dim iCnt as integer
  Dim j as integer
  Dim iNum as integer
  Dim iBound as integer
  Dim strOut as string
  Dim strFmt as string
  Dim intTime as integer
  Dim intH as integer
  Dim intM as integer
  Dim intS as integer
  Dim iMax as integer
  Dim strStamp as string 

  'set AM or PM in case of time related format
  intTime = hour(dtDate)*3600 + Minute(dtDate)*60 + Second(dtDate)
  strFmt = strFormat
  strStamp = "a"
  iCnt = instr(1,UCase(strFmt),"AP")
  if iCnt > 0 then
    strC = "a"
    intTime = intTime mod 86400
    if intTime >= 43200 then
      strStamp = "pm"
      if mid(strFmt,iCnt+1,1)="P" then strC = UCase(strC)
    else
      strStamp = "am"
      if mid(strFmt,iCnt,1)="A" then strC = UCase(strC)
    end if
    strFmt = remove(strFmt , iCnt , 2)
    strFmt = insert(strFmt , strC , iCnt)
    intTime = (intTime - 3600) Mod (43200)
    If intTime < 0 Then intTime = intTime + 43200
    intTime = intTime + 3600#
  end if
  intH = intTime \ 3600
  intM = (intTime - intH * 3600) \ 60
  intS = intTime - IntH * 3600 - intM * 60
 
  'Analize format string
  strF = ""
  strL = ""
  strOut = ""
  iBound = 0
  iarrA[iBound]=0
  for iCnt = 1 to len(strFmt)
     strC = Mid(strFmt,iCnt,1)
     select case strC
       case "y","M","d" : iMax = 4
       case "h","m","s" : iMax = 2
       case "z":          iMax = 1
       case "a","A":      iMax = 1
       case else :        iMax = 100
     end select
     if (strC <> strL) or iarrA[iBound]>=iMax then
       strF = strF & strC
       iBound = len(strF)
       redim preserve iarrA(iBound)
       iarrA[iBound]=1
     else
       iarrA[iBound]=iarrA[iBound]+1
     end if
     strL = strC
  next
 
  'create Output string
  for iCnt = 1 to len(strF)
    strC = Mid(strF,iCnt,1)
    Select case strC
      case "d":
        iNum = day(dtDate)
        j = iarrA[iCnt]
        select case j         
          case 1: strOut = strOut & inum
          case 2: strOut = strOut & right("0" & inum,2)
          case 3: strOut = strOut & left(f_DayName(dtDate),3)
          case else:
                  strOut = strOut & f_DayName(dtDate)
        end select
      case "M":
        iNum = Month(dtDate)
        j = iarrA[iCnt]
        select case j
          case 1: strOut = strOut & inum
          case 2: strOut = strOut & right("0" & inum,2)
          case 3: strOut = strOut & left(f_MonthName(dtDate) ,3)
          case else:
                  strOut = strOut & f_MonthName(dtDate)
        end select
      case "y":
        iNum = year(dtDate)
        j = iarrA[iCnt]
        select case j
          case 1: strOut = strOut & "y"
          case 2: strOut = strOut & right("0" & inum,2)
          case 3: strOut = strOut & right("0" & inum,2) & "y"
          case else:
                  strOut = strOut & right("000" & inum,4)
        end select
      case "h":
        iNum = intH
        j = iarrA[iCnt]
        select case j
          case 1: strOut = strOut & inum
          case else:
                  strOut = strOut & right("0" & inum,2)
        end select
      case "m":
        iNum = intM
        j = iarrA[iCnt]
        select case j
          case 1: strOut = strOut & inum
          case else:
                  strOut = strOut & right("0" & inum,2)
        end select
      case "s":
        iNum = intS
        j = iarrA[iCnt]
        select case j
          case 1: strOut = strOut & inum
          case else:
                  strOut = strOut & right("0" & inum,2)
        end select
      case "z":
        strOut = strOut & "0"
      case "A":
        strOut = strOut & UCase(strStamp)
      case "a":
        strOut = strOut & strStamp
      case else:
        for j = 1 to iarrA[iCnt]
          strOut = strOut & strC
        next
    end select
  next       
  return strOut
end function

sub Main()
  Dim strDt as String
  Dim dtDt As datetime
 
 
  strDt = "1977-09-05"
  dtDt = Date(strDt)
 
  ? "1: " & f_formatDate(CDate(strDt),"yyyy-MM-dd")
  ? "2: " & f_formatDate(datevalue(strDt),"yyyy-MMMM-dd")
  ? "3: " & f_formatDate(dtDt,"dddd dd-MMM-yy")
  ? "4: " & f_formatDate(dateserial(year(dtDt), month(dtDt), day(dtDT) ),"yyyy-MM-dd") 
  ? "5: " & f_formatDate(now(),"yyyy-MM-dd hh:mm:ss ap")
  ? "6: " & f_formatDate(#2001-01-31#,"yyyy-MMM-dd")

end sub 

Main()

[Slowdown]

@pappawinni,
Great, i'l steel this code from you and will place it in my Snippets editor

[pappawinni]

Hi Slowdown,
be careful, it is made with hot needle.
Don't forget to through-harden the steel.
/Winni

[Slowdown]

Deleted post

[Slowdown]

@Apapawinni
Wil test and change it before i place it in my Snippits file

[Slowdown]

@cpcarranza

P.S. I have a similar problem with FORMAT using " , " for numbers.... I want "1,000" but always get "1000"

Just for you

Code: Select all

Private Sub Form_OnOpen()
  log "-" & FormatNum(-1000.6677, "###########,####", True, True) & "-"
End Sub

Private function FormatNum(fNum as Double, fStr as String, lfttr as Boolean, rttr as boolean) as String
  Dim DummyStr As String
  Dim DummyInt As Integer
  Dim Remainder as String
  Dim thdSep as String = ","
  Dim DecSep as String = "."
  Dim LeftFormat as Integer
  Dim RightFormat as Integer
  Dim Lus as Integer
  Dim CharCount as Integer = 0
  Dim LusStr As String
  Dim NegVal as Boolean = False
 
  If fNum<0 then
    fNum = fNum * -1
    NegVal = True
  End if
 
  ' aussshhhhh !!  i know :-)
  DummyInt = fNum

  if fNum - DummyInt > 0 Then
    Remainder = right(fNum - DummyInt, len(fNum - DummyInt) - 2)
  End If

  LeftFormat = (instr(1, fStr, ".")) -1
  RightFormat = len(fStr) - instr(1, fStr, ".")
  If Instr(1, fStr, ",") >= 1 then 
    DecSep = ","
    thdSep = "."
    LeftFormat = (instr(1, fStr, ",")) -1
    RightFormat = len(fStr) - instr(1, fStr, ",")
  End If
 
  DummyStr = trim(str(DummyInt))
  For Lus = Len(DummyStr) to 1 step -1
    CharCount = CharCount + 1
    LusStr = Mid(DummyStr, Lus, 1) & LusStr
    If CharCount = 3 Then
      LusStr = thdSep & LusStr
      CharCount = 0
    End If
  Next
  DummyStr = LusStr
  If NegVal = True Then
    DummyStr = "-" & DummyStr
  End If
  if lfttr = True and LeftFormat > len(DummyStr) Then
    DummyStr = Space(LeftFormat - Len(DummyStr)) & DummyStr
  End If   
  If rttr = True Then
    Remainder = Left(Remainder + Fill("0", "0", RightFormat), RightFormat)
  End If
  Return DummyStr & DecSep & Remainder
End Function


[pappawinni]

@cpcarranza

P.S. I have a similar problem with FORMAT using " , " for numbers.... I want "1,000" but always get "1000"

Just for you ...

Sorry couldn't this be done with FORMAT and after replacing "." by "," using:
Function Replace (Str As String, SearchFor As String, ReplaceWith As String, CaseSensitive As Boolean = True) As String

/Winni

BTW: Have updated my f_formatDate (edited) , modified AM/PM conversion

P.S.:
Test your function with negative values
? "-" & formatNum(-10001.6677, " #,####",true,true) & "-"
you get wrong value as well as wrong separator

[pappawinni]

Hi Slowdown,

here another solution for thounsands-separator based on the Format function:

Code: Select all

function f_formatNum( dblNum as double , strFormat as string , strThousandSep as String = "")
  dim strOut as string
  dim iPos as integer
  dim iSep as integer
  dim dblN as double
  dim iCnt as integer
  dim strTSep as string
 
  strTSep = left(strThousandSep,1)
  strOut = format( dblNum , strFormat, ,true)
  if (strTSep <> "") and (instr(1,UCase(strFormat),"E")<=0) then
    iPos = instr(1,strOut,".")
    if strTSep = "." then strOut = replace(strOut,".",",")
    if iPos <= 0 then ipos = len(strOut) + 2 - instr( 1, StrReverse(strOut), right(trim(strOut),1) )
    dblN = abs(dblNum)
    iSep = int(log(dblN) / log(10.0)) \ 3
    if iPos > ( len(int(dblNum)) + iSep ) then
       iPos = iPos - iSep
       strOut = Right(strOut, len(strOut)-iSep )
       do until iSep <= 0
         iPos = iPos - 3
         strOut = insert( StrOut, strTSep , iPos )
         iSep = iSep - 1
       loop
    end if
  end if
  return strOut
end function

Private Sub Main()
  ? ">" & f_formatNum( 10001.6677    , "###########.##" , "," ) & "<"
  ? ">" & f_formatNum( -1110001.6677 , "###########.##" , " " ) & "<"

End Sub

Main()


[Slowdown]

@pappawinni

Sorry couldn't this be done with FORMAT and after replacing "." by "," using:
Function Replace (Str As String, SearchFor As String, ReplaceWith As String, CaseSensitive As Boolean = True) As String

Nope that won't work.

BTW: Have updated my f_formatDate (edited) , modified AM/PM conversion

Will take a look at it.

P.S.:
Test your function with negative values
? "-" & formatNum(-10001.6677, " #,####",true,true) & "-"
you get wrong value as well as wrong separator

Hmmm you are right, didn't tested it with negative values
Have corrected it now

[pappawinni]

Hi Slowdown,

tested again
your function
log ">" & formatNum( 0.12345678 , "###########.########" , true, true ) & "<"
log ">" & formatNum( 100. , "#############.", true, true) & "<"
results in
> 0.12345700<
> ,100.<

my function
log ">" & f_formatNum( 0.12345678 , "###########.########" , "," ) & "<"
log ">" & f_formatNum( 100. , "#############." , ",") & "<"
results in
> 0.12345678<
> 100<