DateQ

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
CSHW89
Beiträge: 489
Registriert: 14.12.2008 12:22

DateQ

Beitrag von CSHW89 »

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:
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.
So hier mal der Code. Manches is ein bissl schlecht programmiert. Is halt schon ne weile her.

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
Zuletzt geändert von CSHW89 am 05.12.2010 18:40, insgesamt 2-mal geändert.
Bild Bild Bild
http://www.jasik.de - Windows Hilfe Seite
padawan hat geschrieben:Ich liebe diese von hinten über die Brust ins Auge Lösungen
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7028
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: DateQ

Beitrag von STARGÅTE »

die Schaltjahre sind leider nicht ganz richtig !

Code: Alles auswählen

Debug pDayInMonth(2000, 2)
er gibt mir 28 aus, 2000 hatte aber 29 Tage im Feb.

Da ich ein DateQ schon 2008 geschreiben habe: Hier der Link, weiß ich das es nicht (year % 4000) heißt, sonden (year % 400)

dann sollte es gehen.

btw: mein Code ist eh veraltet, in bezeug auf Read ^^
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
Benutzeravatar
CSHW89
Beiträge: 489
Registriert: 14.12.2008 12:22

Re: DateQ

Beitrag von CSHW89 »

oh ja, sorry, war ein tippfehler, hatte da komischer weise vorher 1000 stehen gehabt.
STARGÅTE hat geschrieben:btw: mein Code ist eh veraltet, in bezeug auf Read ^^
meiner ja auch ^^

lg kevin
Bild Bild Bild
http://www.jasik.de - Windows Hilfe Seite
padawan hat geschrieben:Ich liebe diese von hinten über die Brust ins Auge Lösungen
Benutzeravatar
X360 Andy
Beiträge: 1206
Registriert: 11.05.2008 00:22
Wohnort: Bodensee
Kontaktdaten:

Re: DateQ

Beitrag von X360 Andy »

Super danke fürs anpassen :allright:
Benutzeravatar
kernadec
Beiträge: 25
Registriert: 05.07.2009 17:51

Re: DateQ

Beitrag von kernadec »

hello
Thanks for the sharing.
I do not understand why in the proceduredll(DayOfWeekQ
"Days + 4 "
Thursday is so = 0?
Why not "Days + 1"
bye

Code: Alles auswählen

;####### kernadec 12/2010 #######
Enumeration
  #WinAlert
  #image
  #image_gadget
  #button01
  #button02
  #button03
  #button04
  #button05
  #button06
EndEnumeration
Global iconselect.l


Procedure Alerte()
  
 LoadFont(5, "Curlz MT", 28,#PB_Font_Bold)
; LoadFont(5, "Forte", 27,#PB_Font_Bold)

OpenWindow(#WinAlert,0,0,270+70,140,"Message Requester von Weihnachtsmann", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)

CreateImage(#image,WindowWidth(#WinAlert),WindowHeight(#WinAlert),32) ;|#PB_Image_Transparent
StartDrawing(ImageOutput(#image)) 

 cb=RGB(Random(255),Random(255),Random(255))
 Box(0,0,WindowWidth(#WinAlert),WindowHeight(#WinAlert),cb) 
 If iconselect=0
 SendMessage_(WindowID(#WinAlert),#WM_SETICON,#False,LoadIcon_(0,#IDI_ASTERISK))     ;IDI_ASTERISK = 32516
 DrawImage(LoadIcon_(0, #IDI_ASTERISK), 5, 5)
 PlaySound_("SystemAsterisk" ,0, #SND_ALIAS|#SND_NODEFAULT|#SND_NOWAIT|#SND_ASYNC ):EndIf
 If iconselect=1
 SendMessage_(WindowID(#WinAlert),#WM_SETICON,#False,LoadIcon_(0,#IDI_EXCLAMATION))  ;IDI_EXCLAMATION = 32515
 DrawImage(LoadIcon_(0, #IDI_EXCLAMATION), 10, 10)
 PlaySound_("SystemExclamation",0, #SND_ALIAS|#SND_NODEFAULT|#SND_NOWAIT |#SND_ASYNC ):EndIf
 If iconselect=2
 SendMessage_(WindowID(#WinAlert),#WM_SETICON,#False,LoadIcon_(0,#IDI_HAND))         ;IDI_HAND = 32513
 DrawImage(LoadIcon_(0, #IDI_HAND), 10, 10)
 PlaySound_("SystemHand" ,0, #SND_ALIAS|#SND_NODEFAULT|#SND_NOWAIT |#SND_ASYNC ):EndIf
 If iconselect=3
 SendMessage_(WindowID(#WinAlert),#WM_SETICON,#False,LoadIcon_(0,#IDI_QUESTION))     ;IDI_QUESTION = 32514    
 DrawImage(LoadIcon_(0, #IDI_QUESTION), 10, 10)
 PlaySound_("SystemQuestion",0, #SND_ALIAS|#SND_NODEFAULT|#SND_NOWAIT|#SND_ASYNC):EndIf
 If iconselect=4
 SendMessage_(WindowID(#WinAlert),#WM_SETICON,#False,LoadIcon_(0,#IDI_APPLICATION))  ;IDI_APPLICATION = 32512  
 DrawImage(LoadIcon_(0, #IDI_APPLICATION), 10, 10)
 PlaySound_("SystemStart" ,0, #SND_ALIAS|#SND_NODEFAULT|#SND_NOWAIT|#SND_ASYNC ):EndIf
 If iconselect=5
 SendMessage_(WindowID(#WinAlert),#WM_SETICON,#False,LoadIcon_(0,#IDI_WINLOGO))      ;#IDI_WINLOGO = 32517
 DrawImage(LoadIcon_(0, #IDI_WINLOGO), 10, 10)
 PlaySound_("SystemExit" ,0, #SND_ALIAS|#SND_NODEFAULT|#SND_NOWAIT |#SND_ASYNC ):EndIf                              
 
 ; Zone texte
 DrawingFont(FontID(5))
 DrawText(43,0,"Frohe Weihnachten",RGB(255,255,255),cb)
 DrawingMode(1)
 DrawText(42,1,"Frohe Weihnachten",RGB(255,0,0),cb)
 DrawText(43,32,"      an alle... ",RGB(255,255,255),cb)
 DrawingMode(1)
 DrawText(42,33,"      an alle...  ",RGB(255,0,0),cb)
StopDrawing() 
ImageGadget(#image_gadget,0,0,WindowWidth(#WinAlert),WindowHeight(#WinAlert),ImageID(#image))
DisableGadget(#image_gadget,1) 

Debug "Fond=RGB("+Str(Red(cb))+","+Str(Green(cb))+","+Str(Blue(cb))+")"

ButtonGadget(#button01, 25+35, 80, 60, 20, "Icon 1")
ButtonGadget(#button02, 105+35, 80, 60, 20, "Icon 2")
ButtonGadget(#button03, 185+35, 80, 60, 20, "Icon 3")
ButtonGadget(#button04, 25+35, 110, 60, 20, "Icon 4")
ButtonGadget(#button05, 105+35, 110, 60, 20, "Icon 5")
ButtonGadget(#button06, 185+35, 110, 60, 20, "Icon 6")
 
Repeat
  Event = WaitWindowEvent()
  If Event = #PB_Event_Gadget
    Select EventGadget()
      Case #button01 : Debug "Button 1  SystemAsterisk (stern)"
        iconselect=0
        Alerte()
      Case #button02 : Debug "Button 2  SystemExclamation (Advice)"
        iconselect=1
        Alerte()
      Case #button03 : Debug "Button 3  SystemHand (Kritischer Abbruch)"
        iconselect=2
        Alerte()
      Case #button04 : Debug "Button 4  SystemQuestion (Frage)"
        iconselect=3
        Alerte()
      Case #button05 : Debug "Button 5  SystemExit (Systemstart)"
        iconselect=4
        Alerte()
      Case #button06 : Debug "Button 6  SystemExit (Systemstart)"
        iconselect=5
        Alerte()
    EndSelect
  EndIf
  If Event = #PB_Event_CloseWindow
    End
  EndIf
ForEver
EndProcedure
Alerte()
End
Benutzeravatar
CSHW89
Beiträge: 489
Registriert: 14.12.2008 12:22

Re: DateQ

Beitrag von CSHW89 »

oh yes of course. My calculation of the leap year was wrong then. so was the day 1/1/0001 on a Thursday.
thx kernadec
Fixed

lg kevin
Bild Bild Bild
http://www.jasik.de - Windows Hilfe Seite
padawan hat geschrieben:Ich liebe diese von hinten über die Brust ins Auge Lösungen
Antworten