Manchmal reicht das Unix-Timeformat von PB nicht aus. Wird vielleicht mal ne LIB
Code: Alles auswählen
;-TOP
; Kommentar : Datumsfunktionen in Type Date (Double)
; Author : mk-soft
; Second Author :
; Datei : ExDate.pb
; Version : 1.01
; Erstellt : 04.09.2007
; Geändert :
;
; Compilermode :
; OS-Version : Windows
;
; ***************************************************************************************
#GeneralDate = 0
#LongDate = 1
#ShortDate = 2
#LongTime = 3
#ShortTime = 4
; ***************************************************************************************
Import "oleaut32.lib"
VarBstrFromDate(a.d,b.l,c.l,d.l)
VarFormatDateTime(a.l,b.l,c.l,d.l)
VariantTimeToSystemTime(a.d,b.l)
EndImport
; ***************************************************************************************
Procedure.d ExDate(date.s = "")
Protected lpSystemTime.systemtime, pvTime.d
Protected date_uni.s
If date = ""
GetLocalTime_(lpSystemtime)
SystemTimeToVariantTime_(lpSystemTime, @pvTime)
ProcedureReturn pvTime
Else
date_uni.s = Space(Len(date) * 2)
PokeS(@date_uni, date, -1, #PB_Unicode)
If VarDateFromStr_(date_uni, 0, #LOCALE_NOUSEROVERRIDE, @pvTime) = #S_OK
ProcedureReturn pvTime
Else
ProcedureReturn 0.0
EndIf
EndIf
EndProcedure
; ***************************************************************************************
Procedure ExDateToSystemTime(date.d, *lpSystemTime.systemtime)
ProcedureReturn VariantTimeToSystemTime(date, *lpSystemTime)
EndProcedure
; ***************************************************************************************
Procedure.s ExDateStr(date.d)
Protected *pbstrOut, result.s
If VarBstrFromDate(date, 0, #LOCALE_NOUSEROVERRIDE, @*pbstrOut) = #S_OK
result = PeekS(*pbstrOut, -1, #PB_Unicode)
SysFreeString_(*pbstrOut)
Else
result = ""
EndIf
ProcedureReturn result
EndProcedure
; ***************************************************************************************
Procedure.s ExFormatDateStr(date.d, format.l)
Protected pvarIn.variant
Protected *pbstrOut, result.s
pvarIn\vt = #VT_DATE
pvarIn\dblVal = date
If VarFormatDateTime(@pvarIn, format, 0, @*pbstrOut) = #S_OK
result = PeekS(*pbstrOut, -1, #PB_Unicode)
SysFreeString_(*pbstrOut)
Else
result = ""
EndIf
ProcedureReturn result
EndProcedure
; ***************************************************************************************
Procedure ExYear(date.d)
Protected lpSystemTime.systemtime
If ExDateToSystemTime(date, lpSystemTime)
ProcedureReturn lpSystemTime\wYear
Else
ProcedureReturn 0
EndIf
EndProcedure
; ***************************************************************************************
Procedure ExMonth(date.d)
Protected lpSystemTime.systemtime
If ExDateToSystemTime(date, lpSystemTime)
ProcedureReturn lpSystemTime\wMonth
Else
ProcedureReturn 0
EndIf
EndProcedure
; ***************************************************************************************
Procedure ExDayOfWeek(date.d)
Protected lpSystemTime.systemtime
If ExDateToSystemTime(date, lpSystemTime)
ProcedureReturn lpSystemTime\wDayOfWeek
Else
ProcedureReturn 0
EndIf
EndProcedure
; ***************************************************************************************
Procedure ExDay(date.d)
Protected lpSystemTime.systemtime
If ExDateToSystemTime(date, lpSystemTime)
ProcedureReturn lpSystemTime\wDay
Else
ProcedureReturn 0
EndIf
EndProcedure
; ***************************************************************************************
Procedure ExHour(date.d)
Protected lpSystemTime.systemtime
If ExDateToSystemTime(date, lpSystemTime)
ProcedureReturn lpSystemTime\wHour
Else
ProcedureReturn 0
EndIf
EndProcedure
; ***************************************************************************************
Procedure ExMinute(date.d)
Protected lpSystemTime.systemtime
If ExDateToSystemTime(date, lpSystemTime)
ProcedureReturn lpSystemTime\wMinute
Else
ProcedureReturn 0
EndIf
EndProcedure
; ***************************************************************************************
Procedure ExSecond(date.d)
Protected lpSystemTime.systemtime
If ExDateToSystemTime(date, lpSystemTime)
ProcedureReturn lpSystemTime\wSecond
Else
ProcedureReturn 0
EndIf
EndProcedure
; ***************************************************************************************
#DTM_SETSYSTEMTIME = $1002
#DTM_GETSYSTEMTIME = $1001
#GDT_VALID = $0000
; ***************************************************************************************
Procedure SetGadgetDate(gadget.l, date.d)
Protected lpSystemTime.systemtime
VariantTimeToSystemTime(date, lpSystemTime)
ProcedureReturn SendMessage_(GadgetID(gadget),#DTM_SETSYSTEMTIME,#GDT_VALID,lpSystemtime)
EndProcedure
; ***************************************************************************************
Procedure.d GetGadgetDate(gadget.l)
Protected lpSystemTime.systemtime, pvTime.d
SendMessage_(GadgetID(gadget),#DTM_GETSYSTEMTIME,0,@lpSystemTime)
If SystemTimeToVariantTime_(lpSystemTime, @pvTime)
ProcedureReturn pvTime
Else
ProcedureReturn 0.0
EndIf
EndProcedure
; ***************************************************************************************
P.S. GetGadgetDate(Gadget) und SetGadgetDate(Gadget, Date.d) hinzufgefügt.
