Oh... I saw you have a calendar and you work with Date. So... How do you solve the "before 1970" problem?
I use this:
Code: Select all
DeclareModule DateQ
Declare.q DateQ(Year = 0, Month = 1, Day = 1, Hour = 0, Minute = 0, Second = 0)
Declare.q TodayQ()
Declare.q OnlyDateQ(date.q)
Declare YearQ(DateQ.q)
Declare ThisYearQ()
Declare MonthQ(DateQ.q)
Declare DayQ(DateQ.q)
Declare HourQ(DateQ.q)
Declare MinuteQ(DateQ.q)
Declare SecondQ(DateQ.q)
Declare DayOfYearQ(DateQ.q)
Declare DayOfWeekQ(DateQ.q)
Declare.s FormatDateQ(Mask.s, DateQ.q)
Declare.s FormatDateQFromString(FromMask.s,ToMask.s, string.s)
Declare.q ParseDateQ(Mask.s, Date.s)
Declare ISOWeekQ(dats.q)
Declare.q AddDateQ(Date.q, Field.b, Offset.q)
Declare.s getNN(index)
Declare pDayInMonth(year, month)
Declare.b sameDate(date1.q,date2.q)
Declare.q getGadgetStateQ(gadget)
Declare setGadgetStateQ(gadget,date.q)
Declare.q getGadgetStateOnlyQ(gadget)
Declare setGadgetStateOnlyQ(gadget,date.q)
Declare mergeDateQ(date.q,time.q)
Declare mergeDate2Q(date.q,time.q)
Declare.d toDouble(date.q)
#DATEQ_FORMAT_TIMESTAMP="%yyyy-%mm-%dd %hh:%ii:%ss"
#DATEQ_FORMAT_DATETIME="%dd.%mm.%yyyy %hh:%ii:%ss"
#DATEQ_FORMAT_DATE="%dd.%mm.%yyyy"
#DATEQ_FORMAT_SQLDATE="%yyyy-%mm-%dd"
#DATEQ_FORMAT_TIME="%hh:%ii:%ss"
#DATEQ_FORMAT_SHORT_TIME="%hh:%ii"
#DATEQ_FORMAT_SHORT_DATETIME="%dd.%mm.%yyyy %hh:%ii"
Declare.s makeDateTime(date.q)
EndDeclareModule
Module DateQ
EnableExplicit
#CONST_MLT = 28
#CONST_TEN = 10
#CONST_ST = #CONST_MLT * 2 + ( #CONST_MLT / 2 )
#CONST_DAY = 24 * 60 * 60
#CONST_LJAHR= #CONST_DAY * #CONST_MLT * 365 + ( #CONST_DAY * #CONST_MLT / 4 )
#CONST_JAHR = #CONST_LJAHR * #CONST_TEN
Procedure.s makeDateTime(date.q)
ProcedureReturn FormatDateQ(#DATEQ_FORMAT_DATETIME,date)
EndProcedure
Procedure.d toDouble(date.q)
Protected result.d=0
If date
result=HourQ(date)
result+MinuteQ(date)/60
result+(DayOfYearQ(date)-1)*24
EndIf
ProcedureReturn result
EndProcedure
Procedure mergeDateQ(date.q,time.q)
ProcedureReturn DateQ(YearQ(date),MonthQ(date),DayQ(date),Hourq(time),Minuteq(time),SecondQ(time))
EndProcedure
Procedure mergeDate2Q(date.q,time.q)
ProcedureReturn DateQ(YearQ(date),MonthQ(date),DayQ(date),Hourq(time),Minuteq(time),0)
EndProcedure
Procedure.q OnlyDateQ(date.q)
If date
ProcedureReturn DateQ(YearQ(date),MonthQ(date),DayQ(date))
Else
ProcedureReturn date
EndIf
EndProcedure
Procedure.b sameDate(date1.q,date2.q)
ProcedureReturn Bool(YearQ(date1)=YearQ(date2) And MonthQ(date1)=MonthQ(date2) And DayQ(date1)=DayQ(date2))
EndProcedure
Procedure.q DateQ(Year = 0, Month = 1, Day = 1, Hour = 0, Minute = 0, Second = 0)
Protected result.q
Select Year
Case 0
result = Date()
Case 1970 To 2099
result=Date(year,month,day,hour,Minute,Second)
Case 1 To 1970,2099 To 3000
result = (Year - #CONST_TEN) / #CONST_MLT - #CONST_ST
result = Date(Year - result * #CONST_MLT, Month, Day, Hour, Minute, Second) + result * #CONST_LJAHR
Default
result = -1
EndSelect
ProcedureReturn result
EndProcedure
Procedure.q TodayQ()
ProcedureReturn OnlyDateQ(DateQ())
EndProcedure
Procedure YearQ(DateQ.q)
Protected Year.q = DateQ + #CONST_JAHR
DateQ = Year % #CONST_LJAHR
ProcedureReturn Year(DateQ) + (Year / #CONST_LJAHR) * #CONST_MLT - ( #CONST_MLT * #CONST_TEN )
EndProcedure
Procedure ThisYearQ()
ProcedureReturn YearQ(DateQ())
EndProcedure
Procedure MonthQ(DateQ.q)
ProcedureReturn Month((DateQ + #CONST_JAHR) % #CONST_LJAHR)
EndProcedure
Procedure DayQ(DateQ.q)
ProcedureReturn Day((DateQ + #CONST_JAHR) % #CONST_LJAHR)
EndProcedure
Procedure HourQ(DateQ.q)
ProcedureReturn Hour((DateQ + #CONST_JAHR) % #CONST_LJAHR)
EndProcedure
Procedure MinuteQ(DateQ.q)
ProcedureReturn Minute((DateQ + #CONST_JAHR) % #CONST_LJAHR)
EndProcedure
Procedure SecondQ(DateQ.q)
ProcedureReturn Second((DateQ + #CONST_JAHR) % #CONST_LJAHR)
EndProcedure
Procedure DayOfWeekQ(DateQ.q)
ProcedureReturn DayOfWeek((DateQ + #CONST_JAHR) % #CONST_LJAHR)
EndProcedure
Procedure DayOfYearQ(DateQ.q)
ProcedureReturn DayOfYear((DateQ + #CONST_JAHR) % #CONST_LJAHR)
EndProcedure
Procedure.q ParseDateQ(Mask.s,Date.s)
Protected d.q= 0
Protected t.s=Mask
Protected iyear=0
Protected imonth=0
Protected iday=0
Protected ihour=0
Protected iminute=0
Protected isecond=0
Protected idx=FindString(t,"%")
While idx
Select Mid(t,idx,3)
Case "%yy"
iyear=Val(Mid(date,idx,4))
t=ReplaceString(t,"%yyyy","yyyy")
Case "%mm"
imonth=Val(Mid(date,idx,2))
t=ReplaceString(t,"%mm","mm")
Case "%dd"
iday=Val(Mid(date,idx,2))
t=ReplaceString(t,"%dd","dd")
Case "%hh"
ihour=Val(Mid(date,idx,2))
t=ReplaceString(t,"%hh","hh")
Case "%ii"
iminute=Val(Mid(date,idx,2))
t=ReplaceString(t,"%ii","ii")
Case "%ss"
isecond=Val(Mid(date,idx,2))
t=ReplaceString(t,"%ss","ss")
Default
Break
EndSelect
idx=FindString(t,"%")
Wend
If iyear Or imonth Or iday Or ihour Or iminute Or isecond
d=DateQ(iyear,imonth,iday,ihour,iminute,isecond)
EndIf
ProcedureReturn d
EndProcedure
Procedure.s FormatDateQ(Mask.s, DateQ.q)
If DateQ And dateq<>-1
Protected Year.q = DateQ + #CONST_JAHR
DateQ = Year % #CONST_LJAHR
Year.q = Year(DateQ) + (Year / #CONST_LJAHR) * #CONST_MLT - ( #CONST_MLT * #CONST_TEN )
Mask = ReplaceString(Mask, "%yyyy", Str(Year), #PB_String_NoCase)
Mask = ReplaceString(Mask, "%yy", Right(Str(Year), 2), #PB_String_NoCase)
Protected i
Dim tt.s(6)
Dim wt.s(6)
Dim nn.s(12)
Dim wn.s(12)
Restore tt
For i=1 To 7
Read.s tt(i-1)
Next
Restore wt
For i=1 To 7
Read.s wt(i-1)
Next
Restore nn
For i=1 To 12
Read.s nn(i)
Next
Restore wn
For i=1 To 12
Read.s wn(i)
Next
Mask = ReplaceString(Mask, "%TT", tt(DayOfWeekQ(dateq)), #PB_String_NoCase)
Mask = ReplaceString(Mask, "%WT", wt(DayOfWeekQ(dateq)), #PB_String_NoCase)
Mask = ReplaceString(Mask, "%NN", nn(Monthq(dateq)), #PB_String_NoCase)
Mask = ReplaceString(Mask, "%WN", wn(Monthq(dateq)), #PB_String_NoCase)
ProcedureReturn FormatDate(Mask, DateQ)
Else
ProcedureReturn ""
EndIf
EndProcedure
Procedure.s FormatDateQFromString(FromMask.s,ToMask.s, string.s)
Protected date.q=ParseDateQ(FromMask,string)
ProcedureReturn FormatDateQ(ToMask,date)
EndProcedure
Procedure.s getNN(index)
Dim nn.s(12)
Protected i
Restore nn
For i=1 To 12
Read.s nn(i)
Next
ProcedureReturn nn(index)
EndProcedure
CompilerIf #PB_Compiler_Processor=#PB_Processor_JavaScript Or #PB_Compiler_OS <> #PB_OS_Windows
Procedure setGadgetStateQ(dategadget.i,datum.q)
SetGadgetState(dategadget,datum)
EndProcedure
Procedure.q getGadgetStateQ(dategadget.i)
ProcedureReturn GetGadgetState(dategadget)
EndProcedure
CompilerElse
Procedure setGadgetStateQ(dategadget.i,datum.q)
If datum And datum<>-1
Protected *NewDate.SYSTEMTIME=AllocateStructure(SYSTEMTIME)
With *NewDate
\wYear=YearQ(datum)
\wMonth=MonthQ(datum)
\wDay=DayQ(datum)
\wHour=HourQ(datum)
\wMinute=MinuteQ(datum)
\wSecond=SecondQ(datum)
EndWith
SendMessage_(GadgetID(dategadget), #DTM_SETSYSTEMTIME, #GDT_VALID, *NewDate)
FreeStructure(*NewDate)
Else
SetGadgetState(dategadget,0)
EndIf
EndProcedure
Procedure.q getGadgetStateQ(dategadget.i)
Protected t.s=GetGadgetText(dategadget)
If t<>""
Protected *NewDate.SYSTEMTIME=AllocateStructure(SYSTEMTIME)
SendMessage_(GadgetID(dategadget), #DTM_GETSYSTEMTIME, 0, *NewDate)
Protected result.q=DateQ(*NewDate\wYear,*NewDate\wMonth,*NewDate\wDay,*NewDate\wHour,*NewDate\wMinute,*NewDate\wSecond)
FreeStructure(*NewDate)
ProcedureReturn result
EndIf
EndProcedure
CompilerEndIf
Procedure setGadgetStateOnlyQ(dategadget.i,datum.q)
SetGadgetStateQ(dategadget,OnlyDateQ(datum))
EndProcedure
Procedure.q getGadgetStateOnlyQ(dategadget.i)
Protected dat.q=GetGadgetStateQ(dategadget)
ProcedureReturn OnlyDateQ(dat)
EndProcedure
Procedure ISOWeekQ(dats.q)
Protected date.q=dats/#CONST_DAY+3
ProcedureReturn (date-(DateQ(YearQ((date-date%7)*#CONST_DAY),1,date%7+5,0,0,0)/#CONST_DAY-11))/7
EndProcedure
Procedure pLeapyear(year.w)
If ((year % 4) = 0)
If (year % 100) Or ((year % 400) = 0)
ProcedureReturn 1
EndIf
EndIf
EndProcedure
Procedure pDayInMonth(year, month)
Select month
Case 1,3,5,7,8,10,12
ProcedureReturn 31
Case 4,6,9,11
ProcedureReturn 30
Default
ProcedureReturn #CONST_MLT + pLeapyear(year)
EndSelect
EndProcedure
Procedure.q AddDateQ(Date.q, Field.b, Offset.q)
Protected month.b, year.w,day.b
If (Date = 0 Or Date=-1)
ProcedureReturn Date
EndIf
If (Field = #PB_Date_Second)
Date + Offset
ElseIf (Field = #PB_Date_Minute)
Date + Offset * 60
ElseIf (Field = #PB_Date_Hour)
Date + Offset * 60 * 60
ElseIf (Field = #PB_Date_Day)
Date + Offset * #CONST_DAY
ElseIf (Field = #PB_Date_Week)
Date + Offset * 7 * #CONST_DAY
ElseIf (Field = #PB_Date_Month)
month = MonthQ(Date)+Offset*1
year = YearQ(Date)
day = DayQ(Date)
While (month < 1)
month + 12
year - 1
Wend
While (month > 12)
month - 12
year + 1
Wend
If pDayInMonth(year,month)<day
Date = DateQ(year, month, pDayInMonth(year,month), HourQ(Date), MinuteQ(Date), Secondq(Date))
Else
Date = DateQ(year, month, day, HourQ(Date), MinuteQ(Date), Secondq(Date))
EndIf
ElseIf (Field = #PB_Date_Year)
year = YearQ(Date) + Offset * 1
Date = DateQ(year, MonthQ(Date), DayQ(Date), HourQ(Date), MinuteQ(Date), Secondq(Date))
EndIf
ProcedureReturn Date
EndProcedure
DataSection
tt:
Data.s "So","Mo","Di","Mi","Do","Fr","Sa","So"
wt:
Data.s "Sonntag","Montag","Dienstag","Mittwoche","Donnerstag","Freitag","Samstag","Sonntag"
nn:
Data.s "Jan","Feb","Mrz","Apr","Mai","Jun","Jul","Aug","Sep","Okt","Nov","Dez"
wn:
Data.s "Januar","Februar","März","April","Mai","Juni","Juli","August","September","Oktober","November","Dezember"
EndDataSection
EndModule