DateQ
Verfasst: 29.06.2010 17:41
Ich hab grad hier ein Thread gesehen, indem meine ganz alte UserLib 'DateQ' angesprochen wurde. Die funktioniert ja leider nicht mehr. Hier erstmal die Beschreibung aus dem Showcase:
So hier mal der Code. Manches is ein bissl schlecht programmiert. Is halt schon ne weile her.Die DateQ-Libary ermöglicht den Umgang mit Datums- und Zeitangaben.
Im Gegensatz zur Original-Libary benutzt diese Lib Quad-Zahlen,
weshalb es möglich ist, Datums- und Zeitangaben zwischen den Jahren
0001 und 9999 anzugeben. Gespeichert wird also die Anzahl der seit
dem 1. Januar 0001 vergangenen Sekunden. Alle Befehle aus der
Original-Libary sind auch in dieser Lib vertreten.
Code: Alles auswählen
; Name: DateQ
; Author: Kevin Jasik (CSHW89)
; Date: 29.06.2010
; Description: Die Date-Funktionen mit Quad-Zahlen (Jahre 0000-9999)
EnableExplicit
DeclareDLL.q DateQ2(Year, Month, Day, Hour, Minute, Second)
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 28+pLeapyear(year)
EndSelect
EndProcedure
ProcedureDLL.q DateQ() ;Returns the number of seconds ellapsed since the 1st January 0001
Protected time.SYSTEMTIME
GetLocalTime_(time)
ProcedureReturn DateQ2(time\wYear, time\wMonth, time\wDay, time\wHour, time\wMinute, time\wSecond)
EndProcedure
ProcedureDLL.q DateQ2(Year, Month, Day, Hour, Minute, Second)
Protected sec.q, i.w, days.b
If (Year < 1) Or (Year > 9999) Or (Month < 1) Or (Month > 12) Or (Day < 1) Or (Hour < 0) Or (Hour > 23) Or (Minute < 0) Or (Minute > 59) Or (Second < 0) Or (Second > 59)
ProcedureReturn -1
EndIf
If (Day > pDayInMonth(year, month))
ProcedureReturn -1
EndIf
sec = (Year-1)*365*24*60*60
For i = 4 To (Year-1) Step 4
If pLeapyear(i)
sec + 24*60*60
EndIf
Next
For i = 1 To Month-1
days = pDayInMonth(Year, i)
sec + days*24*60*60
Next
sec + (Day-1)*24*60*60
sec + Hour*60*60
sec + Minute*60
sec + Second
ProcedureReturn sec
EndProcedure
ProcedureDLL.b SecondQ(Date.q) ;Returns the second value of the specified date (between 0 and 59).
Protected second.b
If (Date < 0)
ProcedureReturn 0
EndIf
second = Date % 60
ProcedureReturn second
EndProcedure
ProcedureDLL.b MinuteQ(Date.q) ;Returns the minute value of the specified date (between 0 and 59).
Protected minute.b
If (Date < 0)
ProcedureReturn 0
EndIf
minute = (Date % (60*60)) / 60
ProcedureReturn minute
EndProcedure
ProcedureDLL.b HourQ(Date.q) ;Returns the hour value of the specified date (between 0 and 23).
Protected hour.b
If (Date < 0)
ProcedureReturn 0
EndIf
hour = (Date % (24*60*60)) / (60*60)
ProcedureReturn hour
EndProcedure
ProcedureDLL.b DayQ(Date.q) ;Returns the day value of the specified date (between 1 and 31).
Protected year.w, month.b, days.w, save.q
If (Date < 0)
ProcedureReturn 0
EndIf
Repeat
save = Date
days = 365+pLeapyear(year+1)
Date - days*24*60*60
year + 1
Until (Date < 0)
Date = save
month = 0
Repeat
save = Date
days = pDayInMonth(year, month+1)
Date - days*24*60*60
month + 1
Until (Date < 0)
days = Round(save/24/60/60, 0)+1
ProcedureReturn days
EndProcedure
ProcedureDLL.b MonthQ(Date.q) ;Returns the month value of the specified date (between 1 and 12).
Protected year.w, month.b, days.w, save.q
If (Date < 0)
ProcedureReturn 0
EndIf
Repeat
save = Date
days = 365+pLeapyear(year+1)
Date - days*24*60*60
year + 1
Until (Date < 0)
Date = save
month = 0
Repeat
days = pDayInMonth(year, month+1)
Date - days*24*60*60
month + 1
Until (Date < 0)
ProcedureReturn month
EndProcedure
ProcedureDLL.w YearQ(Date.q) ;Returns the year value of the specified date (between 0 and 9999).
Protected year.w, days.w
If (Date < 0)
ProcedureReturn 0
EndIf
Repeat
days = 365+pLeapyear(year+1)
Date - days*24*60*60
year + 1
Until (Date < 0)
ProcedureReturn year
EndProcedure
ProcedureDLL.w DayOfYearQ(Date.q) ;Returns the number of days ellapsed since beginning of the year of the specified date (between 1 and 366).
Protected year.w, month.b, days.w, save.q
If (Date < 0)
ProcedureReturn 0
EndIf
Repeat
save = Date
days = 365+pLeapyear(year+1)
Date - days*24*60*60
year + 1
Until (Date < 0)
days = Round(save/24/60/60, 0)+1
ProcedureReturn days
EndProcedure
ProcedureDLL.b DayOfWeekQ(Date.q) ;Returns the day value in the week of the specified date (0=Sunday, 6=Saturday).
Protected days.q, dayofweek.b
If (Date < 0)
ProcedureReturn 0
EndIf
days = Date/24/60/60
days + 1
dayofweek = days % 7
ProcedureReturn dayofweek
EndProcedure
ProcedureDLL.q AddDateQ(Date.q, Field.b, Offset.q) ;Returns a new date.
Protected month.b, year.w
If (Date < 0)
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*24*60*60
ElseIf (Field = #PB_Date_Week)
Date + Offset*7*24*60*60
ElseIf (Field = #PB_Date_Month)
month = MonthQ(Date)+Offset*1
year = YearQ(Date)
While (month < 1)
month + 12
year - 1
Wend
While (month > 12)
month - 12
year + 1
Wend
Date = DateQ2(year, month, DayQ(Date), HourQ(Date), MinuteQ(Date), Second(Date))
ElseIf (Field = #PB_Date_Year)
Date = DateQ2(YearQ(Date)+Offset*1, MonthQ(Date), DayQ(Date), HourQ(Date), MinuteQ(Date), Second(Date))
EndIf
ProcedureReturn Date
EndProcedure
ProcedureDLL.s FormatDateQ(Mask.s, Date.q) ;Returns a string representation of the Date, according to the specified Mask$
Protected year.s
year = Str(YearQ(Date))
Mask = ReplaceString(Mask, "%yyyy", RSet(year,4,"0"))
Mask = ReplaceString(Mask, "%yy", Right(RSet(year,4,"0"),2))
Mask = ReplaceString(Mask, "%mm", RSet(Str(MonthQ (Date)),2,"0"))
Mask = ReplaceString(Mask, "%dd", RSet(Str(DayQ (Date)),2,"0"))
Mask = ReplaceString(Mask, "%hh", RSet(Str(HourQ (Date)),2,"0"))
Mask = ReplaceString(Mask, "%ii", RSet(Str(MinuteQ(Date)),2,"0"))
Mask = ReplaceString(Mask, "%ss", RSet(Str(SecondQ(Date)),2,"0"))
ProcedureReturn Mask
EndProcedure
Macro MacroParseDate(var)
s = k
While ((PeekB(@Date+k) => $30) And (PeekB(@Date+k) <= $39))
k + 1
Wend
var = Val(PeekS(@Date+s, k-s))
EndMacro
ProcedureDLL.q ParseDateQ(Mask.s, Date.s) ;Returns a string representation of the Date, according to the specified Mask$
Protected i.w, k.w, s.w
Protected year, month, day, hour, minute, second
Mask = LCase(Mask)
For i = 0 To Len(Mask)-1
If (PeekB(@Mask+i) = $25); '%'
If (PeekL(@Mask+i+1) = $79797979); 'yyyy'
MacroParseDate(year)
i + 4
ElseIf (PeekW(@Mask+i+1) = $7979); 'yy'
MacroParseDate(year)
If (year <= 30)
year + 2000
Else
year + 1900
EndIf
i + 2
ElseIf (PeekW(@Mask+i+1) = $6D6D); 'mm'
MacroParseDate(month)
i + 2
ElseIf (PeekW(@Mask+i+1) = $6464); 'dd'
MacroParseDate(day)
i + 2
ElseIf (PeekW(@Mask+i+1) = $6868); 'hh'
MacroParseDate(hour)
i + 2
ElseIf (PeekW(@Mask+i+1) = $6969); 'ii'
MacroParseDate(minute)
i + 2
ElseIf (PeekW(@Mask+i+1) = $7373); 'ss'
MacroParseDate(second)
i + 2
Else
k + 1
EndIf
Else
k + 1
EndIf
Next
ProcedureReturn DateQ2(year, month, day, hour, minute, second)
EndProcedure
;
; DisableExplicit
;
; date.q = DateQ2(2008, 2, 29, 0, 0, 0)
; format.s = "%hh:%ii:%ss, %dd.%mm.%yyyy"
;
; Debug FormatDateQ(format, DateQ())
; Debug FormatDateQ(format, AddDateQ(date,#PB_Date_Year,4))
;
; date = Date(2000, 2, 29, 12, 4, 34)
; Debug date
; Debug AddDate(date,#PB_Date_Month,24)
; Debug FormatDate(format, date)
; Debug FormatDate(format, ParseDate(format, "1:40:34, 29.02.2000"))
; Debug FormatDate(format, AddDate(date,#PB_Date_Month,12))
; d4 = Date(2003, 1, 1, 0, 0, 0)
; Debug d4-d3
; Debug d3-d2
; Debug d2-d1
