PureBoard

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

; ***************************************************************************************