Date/Time --> Single

[Gregery D Engle]

Anyone have some nice source code to do this:

convert this: 7:00:12 AM to this 7.00333333333333

I'm really wanting to do Date/Time Arithmatic like this:

#11/29/00 7:00:12 AM# - #11/29/00 4:22:15 PM# = 9.37~

In VB it is very simple because of the Data Datatype, I'm
lost on how to do it in PB

This is the VB commands I'm trying to convert:
-----

Finish$ = "11/29/00 4:22:15 PM"
Start$ = "11/29/00 7:00:12 AM"

Format(Str(timetodec(CDate(Format(CDate(CDate(Finish$) - CDate(Start$)), "hh:mm:ss")))), "##0.00")

Function timetodec(mytime)
    timetodec = CDbl(mytime) * 24
End Function

Thanks,

------------------
-Greg



[This message has been edited by Gregery D Engle (edited November 30, 2000).]

[Fred Oxenby]

This is some code to get you started.
But please use a double, not single...
You will need Win32Api.inc

Function Now() As Double
Local d As Double
Local ST As SYSTEMTIME
  Call GetLocalTime(ST)
  Call SystemTimeToVariantTime(ST,ByVal VarPtr(d))
  Function = d
End Function
  
Function VbDateSerial(ByVal yy%,ByVal mm%,ByVal dd%) As Double
  Local vbDatum As Double
  Local st As SystemTime
  st.wYear   = yy%
  st.wMonth  = mm%
  st.wDay    = dd%
  st.wHour   = 0
  st.wMinute = 0
  st.wSecond = 0
  Call SystemTimeToVariantTime(st,ByVal VarPtr(vbDatum))
  Function = vbDatum
End Function

Function VbTimeSerial(ByVal hh%,ByVal mm%,ByVal ss%) As Double
  Local vbTid As Double
  Local st As SystemTime
  st.wYear   = 1998
  st.wMonth  = 1
  st.wDay    = 1
  st.wHour   = hh%
  st.wMinute = mm%
  st.wSecond = ss%
  Call SystemTimeToVariantTime(st,ByVal VarPtr(vbTid))
  Function = Frac(vbTid)
End Function

Function FormatDateTime(ByVal vbDatum As Double,ByVal FormatStr$) As String
  Local d  As Asciiz * 64
  Local dt As String
  Local st As SYSTEMTIME
  Local Tmp$,FDatum$,FTid$,yy$,mm$,dd$,hh$,mi$,ss$
'..cnvert vbdate
  VariantTimeToSystemTime vbDatum, st
'..Format output....................
  If Len(Trim$(FormatStr$)) Then
   Tmp$ = UCase$(Trim$(Parse$(FormatStr$," ",1)))
   If Instr(Tmp$,"YY") And Instr(Tmp$,"MM") Then FDatum$=Tmp$
   If Instr(Tmp$,"HH") And Instr(Tmp$,"MM") Then FTid$=Tmp$
   Tmp$ = UCase$(Trim$(Parse$(FormatStr$," ",2)))
   If Instr(Tmp$,"YY") And Instr(Tmp$,"MM") Then FDatum$=Tmp$
   If Instr(Tmp$,"HH") And Instr(Tmp$,"MM") Then FTid$=Tmp$
   yy$=Format$(st.wYear,"0000")
   mm$=Format$(st.wMonth,"00")
   dd$=Format$(st.wDay,"00")
   hh$=Format$(st.wHour,"00")
   mi$=Format$(st.wMinute,"00")
   ss$=Format$(st.wSecond,"00")
   If Instr(FDatum$,"YYYY") Then Replace "YYYY" With yy$ In FDatum$
   If Instr(FDatum$,"YY"  ) Then Replace "YY" With Right$(yy$,2) In FDatum$
   If Instr(FDatum$,"MM"  ) Then Replace "MM" With mm$ In FDatum$
   If Instr(FDatum$,"DD"  ) Then Replace "DD" With dd$ In FDatum$
   If Instr(FTid$,"HH"    ) Then Replace "HH" With hh$ In FTid$
   If Instr(FTid$,"MM"    ) Then Replace "MM" With mi$ In FTid$
   If Instr(FTid$,"SS"    ) Then Replace "SS" With ss$ In FTid$
   Function = FDatum$ + " " + FTid$
  Else
   GetDateFormat 0, %DATE_SHORTDATE, st, ByVal %Null, d, 64
   dt = d
   GetTimeFormat 0, 12, st, ByVal %Null, d, 64
   dt = dt & " " & d
   Function = dt
  End If
End Function
 
Function VbDateValue(ByVal StrDatum$) As Double
  Local vbDatum As Double
  Local Datum$
  Local Typ&,i%
  Typ& = %VAR_DATEVALUEONLY
'..normalise datestring
  Datum$ = Trim$(StrDatum$)
  If Len(Datum$) < 6 Then Function = 0:Exit Function
  Replace Any ":./" With "---" In Datum$
'..
  If Instr(Datum$,"-") = 0 Then Datum$ = Mid$(Datum$,1,4) & "-" & _
                                         Mid$(Datum$,5,2) & "-" & _
                                         Mid$(Datum$,7,2)
'..Make it Unicode
  Datum$ = MakeUnicode(Datum$)
  If IsFalse(VarDateFromStr(ByVal StrPtr(Datum$), 0&, Typ&, ByVal VarPtr(vbDatum)))Then
    Function = vbDatum
  End If
End Function
 
Function MakeUnicode(ByVal x$) As String
Local Buffer As String
  Buffer = Space$(Len(x$) * 2)
  MultiByteToWideChar %CP_ACP, _               ' code page
                      %NULL, _                 ' performance and mapping flags
                      ByVal StrPtr(x$), _      ' ANSI string to convert
                      Len(x$), _               ' len of ANSI string
                      ByVal StrPtr(Buffer), _  ' buffer for Unicode string
                      Len(Buffer)              ' len of Unicode buffer
  Function = Buffer + Chr$(0,0)
End Function

------------------
Fred
mailto:[email protected][email protected]</A>
http://www.oxenby.se