Bonjour à tous, j'ai fait cette bibliothèque sur l'idée de je ne sais plus qui, un anglais, je pense.
Code : Tout sélectionner
; CALENDRIER_F 04-Jun-11
; L'utilisation d'un 63-bits (entier quad) date julienne
; Windows uniquement
; Ce fichier est probablement optimisé pour toutes les procédures pliées
; Dans ces routines:
; Les noms se terminant avec 'F' comme un code basé sur la structure FILETIME Windows
; La granularité de temps est en unités (multiples) de 100-nanosecondes, secondes (par défaut), minutes, heures ou jours
; Si (par exemple) l'unité de granularité représente les heures, les minutes et les secondes sont ignorées
; Lorsque la granualité est en minutes, heures ou jours, date longue/variables de temps sont suffisantes
; Sinon les variables de temps sont nécessaires (à moins que la gamme d'année soit limitée)
; La granularité par défaut est en secondes pour compabilité avec les routines existantes dans la bibliothèque de PB
; Les fractions de seconde ne peuvent pas être entrées ou sorties par l'une de ces routines
; Les dates valides sont 01-Jan-1601 au 31-Dec-9999 mais ...
; Si vous utilisez granualité minute et variables Long, la limite est 24-Jan-5684 02:07:00
; Dates/heures sont stockés dans le temps local, mais peuvent être convertis vers/de heure UTC/GMT
; Le calendrier Windows s'étend du 14-Sep-1752 au 31-Dec-9999 03:14:00
; Le calendrier Unix va du 01-Jan-1970 au 19-Jan-2038 03:14:07
; PureBasic 4.xx utilise le calendrier Unix
; Une routine est prévue pour calculer la date du dimanche de Pâques pour une année donnée
; Pour plus de commodité ci-dessous une sélection des fêtes mobiles / jeûnes:
; Jours après Pâques Fête / Fast
; -47 Mardi gras
; -46 Mercredi des Cendres (Rapide) Premier jour du Carême
; -21 Fête des Mères
; -14 Dimanche de la Passion
; -07 Dimanche des Rameaux
; -03 Jeudi Saint
; -02 Vendredi saint (Rapide)
; +00 Pâques
; +39 Jour de l'Ascension
; +49 Pentecôte
; +56 Dimanche de la Trinité
; Voir: www.eskimo.com/~lhowell/bcp1662/info/tables/almanac.html
; Équivalents de toutes les fonctions PB Date mises en œuvre:
; AjouterDate, Date, Jour, JourDeSemaine, JourDAnnee, DateEntreeRep, FormatDate
; ObtenirDateFichier, Heure, Minute, Mois, DiffDates, Seconde, DefinirDateFichier, Annee
; Fonctions supplémentaires:
; DateDePB, DateDeUTC, ModeDate, DateVersPB, DateVersUTC, JoursDansMois
; DiffDates, DatePaques, JoursDepuis1970, EstBissextile, MaxLongAnnee, DecalageHoraire
; ZoneFuseau, Aujourd_hui, DateSemaine1, SemaineDAnnee, DebutAnnee, Amj
;EnableExplicit
;- Constantes et Globales
#SecsParJourF = 86400 ; Secondes par jour
#AnneeEpoqueF = 1601 ; Première année valable pour la plupart des routines date
#JoursDepuis1970 = 134774 ; Jours à compter de la première journée de l'année époque (01-Jan-1601) au 01-Jan-1970
Global UniteDateF.q = 10000000 ; Unité de granularité, initialement 1 seconde pour la compatibilité avec les routines date de PB 4.xx
Global UniteJourF.q = 10000000*#SecsParJourF/UniteDateF ; Nombre de granularité unités par jour
;}
DeclareDLL.q DateF(Annee=0, Mois=0, Jour=0, Heure=0, Minute=0, Seconde=0)
DeclareDLL.i AnneeF(date.q=-1)
DeclareDLL.s FormatDateF(masque$, date.q=-1)
ProcedureDLL.i ModeDateF(Unite.q=0)
; Etablir l'unité de date Julienne / granularité heure (intervalle de temps minimum pris en charge)
; Aucune autre routine de date ne peut modifier cette granularité
; L'argument unité de granularité est soit l'un des mots réservés voir ci-dessous ou
; est donnée en millisecondes (>=10)
; Une unité est considérée comme invalide 100 nanosecondes qui est la valeur par défaut de Windows FILETIME
; Retourne la granularité en millisecondes (à l'exception 0 -> 100 nanosecondes)
If Unite>=10
UniteDateF = Unite*10000
UniteJourF = #SecsParJourF*1000/Unite
ProcedureReturn Unite ; Millisecondes
EndIf
Select Unite
Case #PB_Date_Minimum ; 1 granularité minimum qui prend en charge les Longs - au delà de l'année en cours
UniteDateF = 10000
UniteJourF = #SecsParJourF*1000 ; granularité temporaire milliseconde
Unite = DateF(AnneeF()+1) ; Millisecondes de l'époque au début de l'année suivante
Unite / 2147483647 + 1 ; Arrondi supérieur
UniteDateF = Unite*10000
UniteJourF = #SecsParJourF*1000/Unite
ProcedureReturn Unite ; Millisecondes
Case #PB_Date_Maximum ; 2 granularité minimum qui prend en charge Longs jusqu'à l'année 9998
UniteDateF = 10000
UniteJourF = #SecsParJourF*1000 ; granularité temporaire milliseconde
Unite = DateF(9999, 12, 31, 23, 59, 59) ; Millisecondes de l'époque jusqu'à la fin de 9999
Unite / 2147483647 + 1 ; Arrondi supérieur
UniteDateF = Unite*10000
UniteJourF = #SecsParJourF*1000/Unite
ProcedureReturn Unite ; Millisecondes
Case #PB_Date_Day ; 3
UniteDateF = 10000000*#SecsParJourF
UniteJourF = 1
ProcedureReturn 1000*#SecsParJourF
Case #PB_Date_Hour ; 4
UniteDateF = 10000000*3600
UniteJourF = 24
ProcedureReturn 1000*3600
Case #PB_Date_Minute ; 5
UniteDateF = 10000000*60
UniteJourF = 1440
ProcedureReturn 1000*60
Case #PB_Date_Second ; 6
UniteDateF = 10000000*1
UniteJourF = #SecsParJourF
ProcedureReturn 1000*1
Default ; 100 nanoseconds
UniteDateF = 1
UniteJourF = 10000000*#SecsParJourF
ProcedureReturn 0
EndSelect
EndProcedure
;; Exemples: fonctionne
; ModeDateF(#PB_Date_Second) ; Unité = secondes, comme dans les routines PB date/heure
; ModeDateF(15000) ; Unité = 15 secondes
; Debug ModeDateF(#PB_Date_Maximum) ; 123423 millisecondes
; Debug ModeDateF(#PB_Date_Minimum) ; 6040 millisecondes
; Voir aussi le dernier exemple pour la procédure JourDeSemaineF()
ProcedureDLL.q DateF(Annee=0, Mois=0, Jour=0, Heure=0, Minute=0, Seconde=0)
; Retourne une date/heure du calendrier julien donnée à une date/heure du calendrier grégorien
; Retourne la date Julienne local / heure pour Aujourd_huiF, si aucun argument n'est donné
; Retourne -1 si l'année est hors de portée
Protected date.q, hs.SYSTEMTIME
If Annee | Mois | Jour | Heure | Minute | Seconde = 0
GetLocalTime_(@hs) ; Heure locale
Else
If Annee=0 ; Si seulement l'heure est spécifiée
Annee = #AnneeEpoqueF
Mois = 1
Jour = 1
ElseIf Annee<#AnneeEpoqueF Or Annee>9999
ProcedureReturn -1
Else
If Mois=0
Mois = 1
EndIf
If Jour=0
Jour = 1
EndIf
EndIf
With hs
\wYear = Annee
\wMonth = Mois
\wDay = Jour
\wHour = Heure
\wMinute = Minute
\wSecond = Seconde
EndWith
EndIf
SystemTimeToFileTime_(@hs, @date) ; Heure locale
ProcedureReturn (date+UniteDateF/2)/UniteDateF
EndProcedure
;; Exemples: fonctionne
; ModeDateF(#PB_Date_Day) ; Granularité unité de jours
; Debug DateF(1969,12,31,23,59,59) ; 134773 jours depuis 1601
; Debug DateF(1970) ; 134774 jours
; Debug DateF() ; Aujourd_huiF -> jours depuis 1601
; Debug DateF(9999) ; 3067306 jours
; Debug DateF(9999,12,31,23,59,59) ; 3067671 jours
; Debug DateF(10000) ; -1 (erreur)
; ModeDateF() ; Unité de 100 nanosecondes
; Debug DateF(1600) ; Erreur retournée valeur de -1
; Debug DateF(1601) ; Minimum returné valeur de 0
; Debug DateF(9999,12,31,23,59,59) ; Maximum returné valeur de 2650467743990000000
ProcedureDLL.q DateDePbF(date.q)
; Convertir une date et heure PureBasic en équivalent FILETIME
; Retourne -1 en cas d'erreur
Protected correction.q = #JoursDepuis1970*UniteJourF
If UniteDateF=1 ; Pour éviter les débordements quad
date*10000000 + correction
Else
date = (date*UniteJourF+#SecsParJourF/2)/#SecsParJourF + correction
EndIf
If date<0
date = -1
EndIf
ProcedureReturn date
EndProcedure
;; Exemples: fonctionne
; ModeDateF(#PB_Date_Second)
; Debug DateDePbF(0) ; 11644473600 (1-Jan-1970 00:00:00)
; Debug DateDePbF(2147483647) ; 13791957247 (19-Jan-2038 03:14:07)
; ModeDateF(#PB_Date_Minute)
; Debug DateDePbF(0) ; 194074560 (1-Jan-1970 00:00:00)
; Debug DateDePbF(2147483647) ; 229865954 (19-Jan-2038 03:14:00)
ProcedureDLL.q DateVersPbF(date.q)
; Convertir une date et heure FILETIME en équivalent PureBasic
; Retourne -1 en cas d'erreur
Protected correction.q = #JoursDepuis1970*#SecsParJourF
If UniteDateF=1 ; Pour éviter les débordements quad
date = (date+5000000)/10000000 - correction
Else
date = (date*#SecsParJourF+UniteJourF/2)/UniteJourF - correction
EndIf
If date<0
date = -1
EndIf
ProcedureReturn date
EndProcedure
;; Exemples: fonctionne
; ModeDateF(#PB_Date_Second)
; Debug DateVersPbF(11644473600+86400) ; 86400 (2-Jan-1970) où 86400 = secondes par jour
; Debug DateVersPbF(13791957247) ; 2147483647 = 2^31-1 (19-Jan-2038 03:14:07)
; ModeDateF(#PB_Date_Minute)
; Debug DateVersPbF(229865954) ; 2147483640 = 2^31-1 (19-Jan-2038 03:14:00)
ProcedureDLL.q DateDeUtcF(date.q=-1)
; Convertir une date/heure UTC (GMT) en son équivalent local
; Si la date est absente, la date/heure locale pour Aujourd_huiF est retournée
Protected datelocale.q, hs.SYSTEMTIME
If date<0
GetLocalTime_(@hs) ; Heure Système
SystemTimeToFileTime_(@hs, @datelocale) ; Aujourd_huiF -> locale
Else
date * UniteDateF ; Convertir en unités de 100 nanosecondes
FileTimeToLocalFileTime_(@date, @datelocale) ; UTC -> local
EndIf
ProcedureReturn (datelocale+UniteDateF/2)/UniteDateF
EndProcedure
; ;Example: fonctionne
; Define masque$ = "%jj-%mm-%aa %hh:%ii:%ss"
; Debug FormatDateF(masque$, DateDeUtcF())
; Debug FormatDateF(masque$, DateF()) ; Même résultat que ci-dessus
; Debug FormatDateF(masque$, DateDeUtcF(DateF(2010, 1, 1, 14, 30, 00))) ; Hiver
; Debug FormatDateF(masque$, DateDeUtcF(DateF(2010, 8, 1, 14, 30, 00))) ; été
ProcedureDLL.q DateVersUtcF(date.q=-1)
; Convertir une date / heure locale en son UTC (GMT) équivalent
; Si la date est négative, l'UTC (GMT) la date / l'heure de Aujourd_huiF est retournée
Protected dateUTC.q, hs.SYSTEMTIME
If date<0
GetSystemTime_(@hs)
SystemTimeToFileTime_(@hs, @dateUTC) ; Aujourd_huiF -> UTC
Else
date * UniteDateF ; Convertir en unités de 100 nanosecondes
LocalFileTimeToFileTime_(@date, @dateUTC) ; Locale -> UTC
EndIf
ProcedureReturn (dateUTC+UniteDateF/2)/UniteDateF
EndProcedure
;; Exemples: fonctionne
; Define masque$ = "%hh:%ii:%ss"
; Debug FormatDateF(masque$, DateVersUtcF()) ; UTC date/heure
; Debug FormatDateF(masque$, DateF()) ; Date/heure locals (pareil que UTC pendant l'hiver)
; Debug FormatDateF(masque$, DateVersUtcF(DateF(2010, 1, 1, 14, 30, 00))) ; Hiver
; Debug FormatDateF(masque$, DateVersUtcF(DateF(2010, 8, 1, 14, 30, 00))) ; Eté
ProcedureDLL AmjF(date.q, *Annee, *Mois, *Jour, *Heure=0, *Minute=0, *Seconde=0)
; Retourne (dans les arguments) une date du calendrier grégorien donnée, une date julienne
; Si la date est négative, la date / heure locales pour Aujourd_huiF est retournée
; si la date est trop grande, le dernier instant de l'année 9999 est retourné
; L'inverse de la routine DateF()
Protected datemax.q=2650467743999999999
Protected hs.SYSTEMTIME
If date<0 ; Suposons maintenant
GetLocalTime_(@hs)
Else
date * UniteDateF
If date>datemax
date=datemax
EndIf
FileTimeToSystemTime_(@date, @hs)
EndIf
With hs
PokeI(*Annee, \wYear)
PokeI(*Mois, \wMonth)
PokeI(*Jour, \wDay)
If *Heure
PokeI(*Heure, \wHour)
EndIf
If *Minute
PokeI(*Minute, \wMinute)
EndIf
If *Seconde
PokeI(*Seconde, \wSecond)
EndIf
EndWith
EndProcedure
;; Exemples: fonctionne
;Define a, m, j, h, i, s
;AmjF(DateF(1970), @a, @m, @j, @h, @i, @s)
;Debug Str(j)+"/"+Str(m)+"/"+Str(a)+" "+Str(h)+":"+Str(i)+":"+Str(s)
;
;AmjF(DateF(2011), @a, @m, @j, @h, @i, @s)
;Debug Str(j)+"/"+Str(m)+"/"+Str(a)+" "+Str(h)+":"+Str(i)+":"+Str(s)
;
;AmjF(DateF(), @a, @m, @j, @h, @i, @s); Now
;Debug Str(j)+"/"+Str(m)+"/"+Str(a)+" "+Str(h)+":"+Str(i)+":"+Str(s)
;
;AmjF(DateF(2000), @a, @m, @j, @h, @i, @s)
;Debug Str(j)+"/"+Str(m)+"/"+Str(a)+" "+Str(h)+":"+Str(i)+":"+Str(s)
;
;AmjF(DateF(9999,12,31,23,59,59), @a, @m, @j, @h, @i, @s)
;Debug Str(j)+"/"+Str(m)+"/"+Str(a)+" "+Str(h)+":"+Str(i)+":"+Str(s)
;
;ModeDateF(#PB_Date_Minute) ; Unités de minutes
;AmjF(2147483647, @a, @m, @j, @h, @i, @s) ; 2^31-1 -> 24-1-5684 2:7:0
;Debug Str(j)+"/"+Str(m)+"/"+Str(a)+" "+Str(h)+":"+Str(i)+":"+Str(s)
;
;ModeDateF() ; Unités de 100 nanosecondes
;AmjF(2650467743999999999, @a, @m, @j, @h, @i, @s) ; Maximum date valide
;Debug Str(j)+"/"+Str(m)+"/"+Str(a)+" "+Str(h)+":"+Str(i)+":"+Str(s)
;
;; Routine test pour AmjF() et DateF():
;Define a=0, m=0, j=0, h=0, i=0, s=0, date, nouvdate.q
;Define tod = ElapsedMilliseconds()
;ModeDateF(#PB_Date_Day) ; Unités de jours
;For date=0 To 3067671 ; 1-Jan-1601 à 1-Jan-10000
; AmjF(date, @a, @m, @j, @h, @i, @s)
; nouvdate = DateF(a, m, j, h, i, s)
; If date<>nouvdate
; Debug "Erreur: "+Str(date)+" -> "+Str(nouvdate)
; EndIf
;Next date
;tod - ElapsedMilliseconds()
;Debug "Temps passé = "+Str(-tod)+" millisecondes"
ProcedureDLL.s FormatDateF(masque$, date.q=-1)
; Retourne une chaîne représentant la date
; en accord avec le masque$ spécifié lequel peut contenir:
; %aaaa ou %yyyy Année à 4 chiffres
; %aa ou %yy Année à 2-chiffres
; %mm Mois à 2 chiffres
; %jj ou %dd date à 2 chiffres
; %hh heure à 2 chiffres
; %ii minute à 2 chiffres
; %ss seconde à 2 chiffres
; %mois ou %mon 3-caractère pour le nom du mois par exemple Avr
; %jour ou %day 3-caractère pour le nom du jour par exemple Mer
; Si la date est absente, Aujourd_huiF est utilisé
Protected a, m, j, h, i, s
Protected Mois$ = "JanFevMarAvrMaiJunJulAouSepOctNovDec"
Protected Jour$ = "DimLunMarMerJeuVenSam"
AmjF(date, @a, @m, @j, @h, @i, @s)
masque$ = ReplaceString(masque$, "%aaaa", RSet(Str(a),4,"0"))
masque$ = ReplaceString(masque$, "%yyyy", RSet(Str(a), 4, "0"))
masque$ = ReplaceString(masque$, "%aa", RSet(Right(Str(a),2),2,"0"))
masque$ = ReplaceString(masque$, "%yy", RSet(Right(Str(a), 2), 2, "0"))
masque$ = ReplaceString(masque$, "%mm", RSet(Str(m),2,"0"))
masque$ = ReplaceString(masque$, "%jj", RSet(Str(j),2,"0"))
masque$ = ReplaceString(masque$, "%dd", RSet(Str(j), 2, "0"))
masque$ = ReplaceString(masque$, "%hh", RSet(Str(h),2,"0"))
masque$ = ReplaceString(masque$, "%ii", RSet(Str(i),2,"0"))
masque$ = ReplaceString(masque$, "%ss", RSet(Str(s),2,"0"))
masque$ = ReplaceString(masque$, "%mois", Mid(Mois$, m*3-2, 3))
masque$ = ReplaceString(masque$, "%mon", Mid(Mois$, m*3-2, 3))
masque$ = ReplaceString(masque$, "%jour", Mid(Jour$, ((date/UniteJourF+1)%7)*3+1, 3)) ; Jour de la semaine
masque$ = ReplaceString(masque$, "%day", Mid(Jour$, ((date/UniteJourF+1)%7)*3+1, 3)) ; Jour de la semaine
ProcedureReturn masque$
EndProcedure
;; Exemple: fonctionne
; Define masque$ = "%jour %jj-%mois-%aaaa %hh:%ii:%ss"
; ModeDateF(#PB_Date_Second)
; Debug FormatDateF(masque$, 6934651199) ; Lun 02-Oct-1820 03:59:59
; Debug FormatDateF(masque$, 12874637100) ; Jeu 25-Dec-2008 00:05:00
; Debug FormatDateF(masque$, 13791957247) ; Mar 19-Jan-2038 03:14:07
; Debug FormatDateF(masque$, 133740295620); Jeu 24-Jan-5839 02:07:00
ProcedureDLL.q Aujourd_huiF()
; Retourne la date julienne pour minuit au début d'aujourd'hui
ProcedureReturn DateF()/UniteJourF*UniteJourF
EndProcedure
;; Exemples: fonctionne
; ModeDateF(#PB_Date_Second)
; Debug Aujourd_huiF() ; Retourne un nombre positif
; Debug DateF() ; Aujourd_huiF, pour la comparaison
;; Calculs équivalents utilisant la routine de PB Date()
; Define correction.q = #JoursDepuis1970*#SecsParJourF ; Secondes
; Debug (Date()+correction)/#SecsParJourF*#SecsParJourF ; Aujourd'hui
; Debug Date()+correction ; Aujourd_huiF
ProcedureDLL.i HeureF(date.q=-1)
; Renvoie la valeur de l'heure (0 .. 23) de la date donnée
; S'il n'y a aucun argument, l'heure est retournée
Protected a, m, j, h
AmjF(date, @a, @m, @j, @h)
ProcedureReturn h
EndProcedure
;; Exemple: fonctionne
; Debug HeureF(DateF(1970, 1, 1, 11, 3, 45)) ; 11
ProcedureDLL.i MinuteF(date.q=-1)
; Retourne la valeur des minutes (0 .. 59) de la date indiquée
; S'il n'y a aucun argument, la minute en cours est retournée
Protected a, m, j, h, i
AmjF(date, @a, @m, @j, @h, @i)
ProcedureReturn i
EndProcedure
;; Exemple: fonctionne
; Debug MinuteF(DateF(1970, 1, 1, 11, 3, 45)) ; 3
ProcedureDLL.i SecondeF(date.q=-1)
; Retourne la valeur des secondes (0 .. 59) de la date indiquée
; S'il n'y a aucun argument, la seconde en cours est retournée
Protected a, m, j, h, i, s
AmjF(date, @a, @m, @j, @h, @i, @s)
ProcedureReturn s
EndProcedure
;; Exemple: fonctionne
; Debug SecondeF(DateF(1970, 1, 1, 11, 3, 45)) ; 45
ProcedureDLL.i JourF(date.q=-1)
; Renvoie le jour (1 .. 31) dans le mois pour la date donnée
; S'il n'y a aucun argument, le jour en cours est retourné
Protected a, m, j
AmjF(date, @a, @m, @j)
ProcedureReturn j
EndProcedure
;; Exemple: fonctionne
; Debug JourF(DateF(2002, 10, 3)) ; 3
ProcedureDLL.i MoisF(date.q=-1)
; Renvoie le mois (1 .. 12) dans l'année pour la date donnée
; S'il n'y a aucun argument, le mois en cours est retourné
Protected a, m, j
AmjF(date, @a, @m, @j)
ProcedureReturn m
EndProcedure
;; Exemple: fonctionne
; Debug MoisF(DateF(2002, 10, 3)) ; 10
ProcedureDLL.i AnneeF(date.q=-1)
; Retourne la valeur de l'année (#AnneeEpoqueF..9999) de la date donnée
; S'il n'y a aucun argument, l'année en cours est retournée
Protected a, m, j
AmjF(date, @a, @m, @j)
ProcedureReturn a
EndProcedure
;; Exemples: fonctionne
; Debug AnneeF(DateF(2002, 10, 3)) ; 2002
; Debug AnneeF() ; Année en cours
ProcedureDLL.b EstBissextileF(Annee=-1)
; Retourne Vrai si l'année est une année bissextile (366 jours)
; S'il n'y a aucun argument, l'année en cours est utilisée
; Dans le calendrier grégorien, l'année bissextile est
; toute année divisible par 4, sauf
; année du centenaire non divisible par 400
; L'année équinoxe de printemps est d'environ 365.242374 jours longs (et croissants)
; Le calendrier iranien est basée sur 8 jours bissextiles tous les 33 ans (365,242424 jours)
; dictionary.die.net/leap%20year
; en.wikipedia.org/wiki/Leap_year
If Annee<=0
Annee = AnneeF()
EndIf ; Cette année
If (Mod(Annee,4)=0 And Mod(Annee,100)<>0) Or (Mod(Annee,400)=0)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
;; Exemples: fonctionne
; Debug EstBissextileF(1600) ; True
; Debug EstBissextileF(1700) ; False
; Debug EstBissextileF(1756) ; True
; Debug EstBissextileF(1800) ; False
; Debug EstBissextileF(1900) ; False
; Debug EstBissextileF(2000) ; True
; Debug EstBissextileF(2004) ; True
; Debug EstBissextileF(2005) ; False
; Debug EstBissextileF(2100) ; False
; Debug EstBissextileF(4000) ; True
; Debug EstBissextileF() ; Cette année
ProcedureDLL.i JourDeSemaineF(date.q=-1)
; Retour le jour de la semaine comme un nombre:
; 0=Dim 1=Lun 2=Mar 3=Mer 4=Jeu 5=Ven 6=Sam
; S'il n'y a pas d'argument, le jour courant est renvoyé
If date<0
date = DateF()
EndIf ; Aujourd_huiF
ProcedureReturn Mod((date/UniteJourF+1),7) ; Comme 01-Jan-1601 C'était un lundi
EndProcedure
;; Exemples:
; Debug JourDeSemaineF(DateF(1601, 01, 01)) ; 1 (lundi 01-Jan-1601) exact
; Debug JourDeSemaineF(DateF(1752, 09, 19)) ; 2 (mardi 19-Sep-1752)
; Debug JourDeSemaineF(DateF(1752, 10, 01)) ; 0 (dimanche 01-Oct-1752)
; Debug JourDeSemaineF(DateF(2009, 12, 25)) ; 5 (vendredi 25-Dec-2009)
; Debug JourDeSemaineF(DateF(2008, 12, 28)) ; 0 (dimanche 28-Dec-2008)
; Debug JourDeSemaineF() ; Aujourd'hui
;
; ModeDateF(#PB_Date_Day)
; Debug JourDeSemaineF(#JoursDepuis1970) ; 4 (jeudi 01-Jan-1970) exact
ProcedureDLL.i JourDAnneeF(date.q=-1)
; Retourne le nombre de jours (1 .. 366) écoulés depuis le
; début de l'année pour la date donnée
; S'il n'y a pas d'argument, le numéro du jour d'aujourd'hui est retourné
Protected a, m, j
If date<0
date = DateF()
EndIf
AmjF(date, @a, @m, @j)
ProcedureReturn (date-DateF(a, 1, 1))/UniteJourF+1
EndProcedure
;; Exemples:
; Debug JourDAnneeF(DateF(1980, 1, 1)) ; 1 exact
; Debug JourDAnneeF(DateF(1980, 2, 25)) ; 56
; Debug JourDAnneeF(DateF(1980, 2, 28)) ; 59
; Debug JourDAnneeF(DateF(1980, 3, 1)) ; 61
; Debug JourDAnneeF(DateF(1980, 12, 31)) ; 366
; Debug JourDAnneeF() ; exact
ProcedureDLL.i DateSemaine1(Annee=-1, Premier_Jour=0)
; Renvoie la première date de Janvier de la semaine 1 de l'année donnée
; Une date de retour <= 0 implique le précédent Décembre à la place:
; -2=Dec29 -1=Dec30 0=Dec31
; La semaine 1 est la première semaine comportant au moins 4 jours dans l'année
; Cela signifie que la première semaine comportera toujours le 4 janvier
; qui est conforme à la norme ISO 8601 (& CalendarGadget)
; mais peut-être pas avec le calendrier de la barre d'état système Windows
; comme (sous Windows ME au moins) le biais est de 3 au lieu de 4
; L'argument 'Premier_Jour' identifie le "premier jour de chaque semaine"
; Dimanche=0 .. Samedi=6
; Si l'année est absente, l'année en cours est utilisée
Protected Decalage=4 ; La date de Janvier qui tombe toujours dans la semaine 1
Protected Jourjan ; Jour de la semaine de Janvier la date biais
Protected jandate ; Date de décembre / janvier du début de la semaine 1
If Annee<=0
Annee = AnneeF()
EndIf ; Cette année
Jourjan = (DateF(Annee, 1, Decalage)/UniteJourF+1)%7 ; Jour de la semaine
jandate = Decalage+Premier_Jour-Jourjan
If Premier_Jour>Jourjan
jandate - 7
EndIf
ProcedureReturn jandate
EndProcedure
;; Exemple:
; Define Annee, masque$ = "%aaaa/%mm/%jj"
; For Annee = 2000 To 2012
; Debug Str(Annee)+" Première date Janvier = "+Str(DateSemaine1(Annee, 4)) ; Calendrier est Jeu .. Mer
; Next Annee
; ; Resultat: -1 4 3 2 1 -1 -2 4 3 1 0 -1 -2
; ; où -2=Dec29 -1=Dec30 0=Dec31 1=Jan01 etc.
ProcedureDLL.i SemaineDAnneeF(date.q=-1, Premier_Jour=0)
; Retourne le nombre de semaines (1 .. 53) écoulés depuis le
; début de l'année pour la date donnée
; Si la date est absente, la date d'aujourd'hui est utilisée
; L'argument 'Premier_Jour' identifie la "premier jour de chaque semaine"
; Dimanche=0 .. Samedi=6
Protected jandate ; Date en Janvier du début de la semaine 1
If date<0
date = DateF()
EndIf ; Maintenant
jandate = DateSemaine1(AnneeF(date), Premier_Jour)
ProcedureReturn (JourDAnneeF(date)-jandate)/7+1
EndProcedure
;; Exemple:
; Define Annee
; For Annee = 2000 To 2012
; Debug Str(Annee)+" Semaine = "+Str(SemaineDAnneeF(DateF(Annee,1,12), 4)) ; Calendrier est Jeu..Mer comme Premier_Jour=4
; Next Annee
; ; Resultat: 2 2 2 2 2 2 3 2 2 2 2 2 3
ProcedureDLL.q DebutAnneeF(Annee=-1, Jour=0)
; Retourne la première [Julian] date de l'année donnée qui tombe sur le jour de la semaine donnée
; Si l'année est absente ou 0, l'année en cours est utilisée
; L'argument 'Jour' identifie un jour de la semaine:
; Dimanche=0 .. Samedi=6
; Par exemple, DebutAnneeF(2008, 6) renvoie la date du
; premier Samedi (Jour=6) en 2008 p.e. 5-Jan-08
; Voir: www.cpearson.com/excel/weeknum.htm
Protected jandate ; Date en décembre/janvier de début de la semaine 1
If Annee<=0
Annee = AnneeF()
EndIf ; Cette année
If jandate<0
jandate+7
EndIf
ProcedureReturn DateF(Annee, 1, jandate)
EndProcedure
;; Exemples: fonctionne
; Define masque$ = "%jj-%mois-%aa (%jour)"
; Define masque$ = "%dd-%mon-%yy (%day)"
; Debug FormatDateF(masque$, DebutAnneeF(2008, 6))
; Debug FormatDateF(masque$, DebutAnneeF(2008, 2))
; Debug FormatDateF(masque$, DebutAnneeF(2006))
; Debug FormatDateF(masque$, DebutAnneeF(2011))
ProcedureDLL.i JoursDansMoisF(Annee=-1, Mois=-1)
; Retourne le nombre de jours dans le mois donné (28 .. 31)
; Si laannée est absente, l'année en cours est utilisée
; Si l'année est présente mais le mois est absent, Février est utilisé
; Si l'année et le mois sont tous deux absents, le mois courant de l'année en cours est utilisé
Protected Jours
If Annee<=0
Annee = AnneeF()
If Mois<=0
Mois = MoisF()
EndIf
Else
If Mois<=0
Mois = 2
EndIf
EndIf
If Mois=2
Jours = 28+EstBissextileF(Annee)
Else
Jours = 31-$A55>>Mois&1
EndIf
ProcedureReturn Jours
EndProcedure
;; Exemple pour l'année 2008 (une année bissextile)
; Define mois, annee$=""
; For mois=1 To 12
; annee$ + Str(JoursDansMoisF(2008, mois))+" "
; Next mois
; Debug annee$ ; 31 29 31 30 31 30 31 31 30 31 30 31
ProcedureDLL.s ZoneFuseauF()
; Retourne le nom du fuseau horaire
; www.purebasic.fr/english/viewtopic.php?p=181541
Protected TimeZoneInfo.TIME_ZONE_INFORMATION
Protected i=0, NomStandard$=""
GetTimeZoneInformation_(TimeZoneInfo)
While TimeZoneInfo\StandardName[i]<>0 And i<=32
NomStandard$ + Chr(TimeZoneInfo\StandardName[i])
i + 1
Wend
ProcedureReturn NomStandard$
EndProcedure
;; Exemple: fonctionne
; Debug ZoneFuseauF() ; GMT Standard Time
ProcedureDLL.i DecalageHoraireF(type)
; Retourne l'heure zone d'information de polarisation en quelques minutes
; Decalage=1 retourne (localtime-UTCTime) excluant l'heure d'été
; Decalage=2 retourne (localtime-UTCTime), y compris l'heure d'été
; Decalage=3 retourne la polarisation d'été locale qui est
; en vigueur à ce moment et sera de 0 en hiver
; Decalage=4 retourne la polarisation d'été locale fixe (généralement 60)
; N.B. DecalageHoraireF(2)=DecalageHoraireF(1)+DecalageHoraireF(3)
; L'heure UTC utilisée pour être appelée GMT
; www.purebasic.fr/english/viewtopic.php?t=17158
Protected zoneid, tz.TIME_ZONE_INFORMATION, daylight
zoneid = GetTimeZoneInformation_(tz)
With tz
If zoneid=#TIME_ZONE_ID_DAYLIGHT
daylight = tz\DaylightBias
Else
daylight = 0
EndIf
Select type
Case 1
ProcedureReturn -tz\Bias
Case 2
ProcedureReturn -tz\Bias-daylight
Case 3
ProcedureReturn -daylight
Case 4
ProcedureReturn -tz\DaylightBias
EndSelect
ProcedureReturn 0
EndWith
EndProcedure
;; Exemples:
; Debug DecalageHoraireF(1) ; 0
; Debug DecalageHoraireF(2) ; 0 (ou 60 en été)
; Debug DecalageHoraireF(3) ; 0 (ou 60 en été)
; Debug DecalageHoraireF(4) ; 60 (minutes) exact
ProcedureDLL.q AnalyserDateF(masque$, chaine$, coupure=0, ignore=#False)
; Convertit une date et/ou heure contenue dans une chaîne à une date/heure Julienne
; Retourne -1 en cas d'erreur (par exemple, mois > 12)
; La chaîne de date doit contenir au moins un séparateur (par exemple slash)
; entre chaque partie numérique de la date (sauf %ymd)
; Les séparateurs dans le masque ne doivent pas correspondre aux séparateurs
; dans la chaîne (et donc plus tolérant que PB ParseDate)
; Le masque décrit comment la chaîne de date d 'entrée est formatée:
; %amj >=6 chiffres a.. ammjj (si moins de 7 chiffres, la coupure est utilisée)
; %aaaa >=4 chiffres de l'année
; %aa >=1 chiffre année (si 0 .. 99, coupure est utilisée)
; %mm 1..2 chiffres mois
; %mois >=1 caractère [mois ou] nom du mois (par exemple avr ou avril)
; %jj 1..2 chiffres date
; %hh 1..2 chiffres heure
; %ii 1..2 chiffres minute
; %ss 1..2 chiffres seconde
; %% Ignorer la reste du masque (peut-être utilisé comme un commentaire)
;
; Le paramètre 'coupure' décide de l'interprétation d'années à 2 chiffres
; et est utilisé uniquement par des champs masque %ymd et %yy
; Supposons que la valeur coupure est xx alors les années à 2 chiffres de 00 .. xx sont
; interprété comme 2000 .. 20xx et xx+1..99 comme 19xx+1..1999
; Exemples:
; Si coupure=29, 00..29 -> 2000..2029 et 30..99 -> 1930..1999
; Si coupure=99, 00..99 -> 2000..2999
; Cas particulier: coupure 00 (par défaut) est considérée comme 99
;
; Le paramètre 'ignore':
; Si le masque a plus de champs '%' que la chaîne ne dispose de nombres
; une erreur sera relevée, sauf si l'argument 'ignore' est vrai
; ou si %% est utilisé pour terminer l'analyse (Voir les exemples)
;
Protected a, m, j, h, i, s ; Champs Date/heure
Protected p, index=2, Champ$, date.q, Chiffre$="0123456789"
Protected Nombre, trouves = 0 ; Nombre de champs trouvés
Protected Mois$, pMois, c$, q ; Pour résoudre %mois
masque$ = LCase(masque$)
; Prévisualisation pour chaque nom de mois et le remplacer par le numéro du mois
If FindString(masque$, "%mois", 1)
Mois$ = "-jan-fév-mar-avr-mai-jun-jul-aoû-sep-oct-nov-déc-"
ReplaceString(Mois$, "-", Chr(1), #PB_String_InPlace)
chaine$=LCase(chaine$)
For p=1 To Len(chaine$)-3
; Est-ce que le nom du mois commence à la position p dans chaîne$?
pMois = FindString(Mois$, Mid(chaine$, p, 3), 1)
If pMois ; Position du début de nom de mois dans Mois$
; Est-ce que le nom est précédé d'un caractère non-alpha?
c$ = Mid(chaine$, p-1, 1)
If p=1 Or c$<"a" Or c$>"z"
; Trouver la fin du nom du mois
q = p+3
c$ = Mid(chaine$, q, 1)
While c$>="a" And c$<="z"
q + 1
c$ = Mid(chaine$, q, 1)
Wend
; Remplacez le nom du mois par son numéro de mois
chaine$ = Left(chaine$,p-1)+" "+Str((pMois+3)/4)+" "+Mid(chaine$,q)
Break ; Ne cherchez pas plus loin %mois
EndIf
EndIf ; pMois
Next p
EndIf ; %mois
; Résoudre les champs du masque
If coupure<=0 Or coupure>99
coupure=99
EndIf
Champ$=StringField(masque$, index, "%")
While Champ$ And chaine$
; Recherche pour le premier/suivant nombre décimal
While chaine$ And FindString(Chiffre$, Left(chaine$, 1), 1)=0
chaine$ = Mid(chaine$, 2) ; Retirer premier non-chiffres
Wend
If Len(chaine$)=0
Break
EndIf ; plus de nombre restant
; Récupérer le nombre
For p=1 To Len(chaine$)+1
If FindString(Chiffre$, Mid(chaine$, p, 1), 1)=0
Break
EndIf ; Si ce n'est pas un chiffre
Next p
trouves + 1
Nombre = Val(Left(chaine$, p-1)) ; >=0
chaine$ = Mid(chaine$, p) ; Retirer le nombre
; correspondant au champ du masque en cours avec le nombre actuel
If Left(Champ$,3)="amj"
a=Nombre/10000
m=(Nombre/100)%100
j=Nombre%100
If a<=coupure
a + 2000
ElseIf a<=99
a + 1900
EndIf
ElseIf Left(Champ$,4)="aaaa"
a = Nombre
ElseIf Left(Champ$,2)="aa"
a = Nombre
If a<=coupure
a + 2000
ElseIf a<=99
a + 1900
EndIf
ElseIf Left(Champ$,2)="mm"
m = Nombre
ElseIf Left(Champ$,3)="mois"
m = Nombre
ElseIf Left(Champ$,2)="jj"
j = Nombre
ElseIf Left(Champ$,2)="hh"
h = Nombre
ElseIf Left(Champ$,2)="ii"
i = Nombre
ElseIf Left(Champ$,2)="ss"
s = Nombre
Else
ProcedureReturn -1
EndIf ; Erreur (mauvais masque)
index + 1
Champ$=StringField(masque$, index, "%")
Wend
; Vérifier les erreurs
If trouves=0
ProcedureReturn -1
EndIf
If Champ$ And Not ignore
ProcedureReturn -1
EndIf
If a Or m Or j
If a And (a<#AnneeEpoqueF Or a>9999)
ProcedureReturn -1
EndIf
If a And m=0
m = 1
EndIf
If a And j=0
j = 1
EndIf
If m>12 Or j>31
ProcedureReturn -1
EndIf
EndIf
If h>59 Or i>59
ProcedureReturn -1
EndIf
ProcedureReturn DateF(a, m, j, h, i, s) ; date/heure Julienne
EndProcedure
;; Exemples: fonctionne
; Define masque$ = "%jj:%mm:%aaaa" , date.l
; ModeDateF(#PB_Date_Day) ; Cela permet à la date à être une variable long plutôt qu'un quad
;
; date = AnalyserDateF("%jj-%mm-%aa", "01-01-1756")
; Debug FormatDateF(masque$, date) ; 01:01:1756
;
; date = AnalyserDateF("%aaaa-%mm-%jj", "1778-01-01")
; Debug FormatDateF(masque$, date) ; 01:01:1778
;
; date = AnalyserDateF("%aa%mm%jj %hh%ii", "1980-4-17", 0, #True) ; True; ignorer le %hh%ii
; Debug FormatDateF(masque$, date) ; 17:04:1980
;
; date = AnalyserDateF(":%aa--%jj/%mm:", "8-17-4") ; Avis m et j sont permutées
; Debug FormatDateF(masque$, date) ; 17:04:2008
;
; date = AnalyserDateF("%amj%%ignorez_moi", "0080417") ; Avis le %%
; Debug FormatDateF(masque$, date) ; 17:04:2008
;
; date = AnalyserDateF("%jj-%mois-%aa", "29-Fevrier-36")
; Debug FormatDateF(masque$, date) ; 29:02:2036 (coupure=99)
;
; date = AnalyserDateF("%jj-%mois-%aa", "29-Fevrier-36", 29)
; Debug FormatDateF(masque$, date) ; 29:02:1936 (coupure=29)
ProcedureDLL.q AjouterDateF(date.q=-1, Unite=#PB_Date_Day, Valeur.q=1)
; Augmenter une date par des unités de «valeur» dont la valeur peut être négative
; Si la date est absente, Aujourd_huiF est utilisé
; Unité est une de:
; #PB_Date_Year = 0
; #PB_Date_Month = 1
; #PB_Date_Week = 2
; #PB_Date_Day = 3
; #PB_Date_Hour = 4
; #PB_Date_Minute = 5
; #PB_Date_Second = 6
; Pour une calculatrice en ligne date (années 1 .. 3999) Voir:
; ww.timeanddate.com/date/dateadd.html
Protected a, m, j, h, i, s, Dernier
If date<0
date = DateF()
EndIf ; Aujourd_huiF
Select Unite
Case #PB_Date_Year
AmjF(date, @a, @m, @j, @h, @i, @s)
a + Valeur
Dernier = JoursDansMoisF(a, m)
If m>Dernier
m = Dernier
EndIf
date = DateF(a, m, j, h, i, s)
Case #PB_Date_Month
AmjF(date, @a, @m, @j, @h, @i, @s)
m + Valeur
If m<=0
a+m/12-1
m%12+12
ElseIf m>12
m-1
a+m/12
m%12+1
EndIf
Dernier = JoursDansMoisF(a, m)
If m>Dernier
m = Dernier
EndIf
date = DateF(a, m, j, h, i, s)
Case #PB_Date_Week
date + Valeur*UniteJourF*7
Case #PB_Date_Day
date + Valeur*UniteJourF
Case #PB_Date_Hour
date + (Valeur*UniteJourF+12)/24 ; Heures par jour
Case #PB_Date_Minute
date + (Valeur*UniteJourF+720)/1440 ; Minutes par jour
Case #PB_Date_Second
date + (Valeur*UniteJourF+#SecsParJourF/2)/#SecsParJourF ; Secondes par jour
EndSelect
ProcedureReturn date
EndProcedure
;; Exemples:
; ; www.techonthenet.com/access/functions/date/dateadd.php
; Define date0.q, date.q, masque$ = "%jj/%mm/%aaaa"
; date0 = DateF(2003,11,22, 10,31,58) ; Initial date
; date = AjouterDateF(date0, #PB_Date_Year, 3)
; Debug FormatDateF(masque$, date) ; 22/11/2006
; date = AjouterDateF(date0, #PB_Date_Month, 5)
; Debug FormatDateF(masque$, date) ; 22/04/2004
; date = AjouterDateF(date0, #PB_Date_Year, -1)
; Debug FormatDateF(masque$, date) ; 22/11/2002
; date = AjouterDateF(date0, #PB_Date_Minute, 51)
; Debug FormatDateF(masque$+" %hh:%ii:%ss", date) ; 22/11/2003 10:32:01
ProcedureDLL.q DiffDatesF(datedebut.q, datefin.q=-1, Unite=#PB_Date_Day, multiple.q=1)
; Différence entre deux dates
; Calcule datefin-datedebut le résultat est retourné dans
; l'unité donnée [ou de son multiple]
; Si datefin est absente ou négatif, Aujourd_huiF est utilisé
; Retourne 0 en cas d'erreur
; Unité est une de:
; #PB_Date_Year = 0
; #PB_Date_Month = 1
; #PB_Date_Week = 2
; #PB_Date_Day = 3
; #PB_Date_Hour = 4
; #PB_Date_Minute = 5
; #PB_Date_Second = 6
; Les exemples de l'utilisation de l'argument de multiples (>0) sont:-
; La différence de date (qui peut être négative) est retournée dans:
; Semaines si l'unité=#PB_Date_Week et multiple=1 (par défaut)
; Quinzaines si l'unité=#PB_Date_Week et multiple=2
; Trimestres si l'unité=#PB_Date_Month et multiple=3
Protected sign=1, Secondes, diff.q, date.q
If multiple <= 0
ProcedureReturn 0
EndIf ; Erreur
If datefin<0
datefin = DateF()
EndIf ; Aujourd_huiF
If datedebut>datefin
sign = -1
Swap datedebut, datefin
EndIf
; Obtenir la différence de date en secondes
diff = datefin-datedebut
If UniteDateF=1 ; Pour éviter les débordements quad
diff = (diff+5000000)/10000000
Else
diff = (diff*#SecsParJourF+UniteJourF/2)/UniteJourF
EndIf
Select Unite
Case #PB_Date_Year
Secondes = 366*#SecsParJourF
Case #PB_Date_Month
Secondes = 31*#SecsParJourF
Case #PB_Date_Week
Secondes = 7*#SecsParJourF
Case #PB_Date_Day
Secondes = 1*#SecsParJourF
Case #PB_Date_Hour
Secondes = 3600
Case #PB_Date_Minute
Secondes = 60
Case #PB_Date_Second
Secondes = 1
Default
ProcedureReturn 0 ; Erreur
EndSelect
; Obtenir une réponse approximative
diff / (multiple*Secondes)
; Améliorer l'approximation
date = AjouterDateF(datedebut, Unite, multiple*diff)
While date<datefin
date = AjouterDateF(date, Unite, multiple)
diff + 1
Wend
ProcedureReturn sign*diff
EndProcedure
;; Exemples:
; Define date1.q, date2.q, masque$="%aaaa.%mm.%jj"
; date1 = DateF(2007,12,03): date2 = DateF(2009,12,03)
; Debug "A "+Str(DiffDatesF(date1, date2, #PB_Date_Year))
; Debug"22S "+Str(DiffDatesF(date1, date2, #PB_Date_Week, 22)) ; 22 semaines
; Debug "T "+Str(DiffDatesF(date1, date2, #PB_Date_Week, 13)) ; Trimestre
; Debug "M "+Str(DiffDatesF(date1, date2, #PB_Date_Month))
; Debug "Q "+Str(DiffDatesF(date1, date2, #PB_Date_Week, 2)) ; Quinzaine
; Debug "S "+Str(DiffDatesF(date1, date2, #PB_Date_Week))
; Debug "J "+Str(DiffDatesF(date1, date2, #PB_Date_Day))
; Debug "H "+Str(DiffDatesF(date1, date2, #PB_Date_Hour))
; Debug "I "+Str(DiffDatesF(date1, date2, #PB_Date_Minute))
;; Resultats:
; ; A 2
; ; 22S 5
; ; T 9
; ; M 24
; ; Q 53
; ; S 105
; ; J 731
; ; H 17544
; ; I 1052640
;
;; Exemples:
; Define.q date1, date2
; date1 = DateF(1756,1,1)
; date2 = DateF(1970,1,1)
; Debug DiffDatesF(date1, date2) ; 78162 jours = 11166 semaines
; Debug DiffDatesF(date1, date2, #PB_Date_Week) ; 11166 semaines
ProcedureDLL.q DatePaquesF(Annee.q=0)
; Retourne la date du dimanche de Pâques pour l'année donnée (valable jusqu'à 4099)
; S'il n'y a aucun argument, l'année en cours est utilisée
; Si l'argument est > 9999, c'est supposé être une date, pas une année
; Définition:
; www.merlyn.demon.co.uk/estrdate.htm
; Dimanche Pâques est le premier Dimanche après la date d'une
; pleine lune estimée se produisant le 21 Mars ou après.
; Les dates possibles vont du 22 Mars au 25 avril
; Utilise la méthode 3 à:
; users.sa.chariot.net.au/~gmarts/eastalg.htm
Protected FirstDig, Remain19, temp, d ; résultats intermediaires
Protected tA, tB, tC, tD, tE ; Résultats table A à E
If Annee<=0
Annee = AnneeF() ; Cette année
ElseIf Annee>9999
Annee = AnneeF(Annee) ; Convertir date à l'année
EndIf
FirstDig = Annee / 100 ; Siècle
Remain19 = Annee%19 ; Nombre d'or de l'année dans le cycle métonique
; Calculer Paschal Full Moon Day-of-March date (PFM)
temp = (FirstDig - 15) / 2 + 202 - 11 * Remain19
Select FirstDig
Case 21, 24, 25, 27 To 32, 34, 35, 38
temp = temp - 1
Case 33, 36, 37, 39, 40
temp - 2
EndSelect
temp = Mod(temp, 30)
tA = temp + 21
If temp=29
tA - 1
EndIf
If (temp=28 And Remain19>10)
tA - 1
EndIf
; Trouver le Dimanche suivant
tB = (tA - 19)%7
tC = (40 - FirstDig)%4
If tC=3
tC + 1
EndIf
If tC>1
tC + 1
EndIf
temp = Annee%100
tD = (temp + temp / 4)%7
tE = ((20 - tB - tC - tD)%7) + 1
d = tA + tE ; Jours après le 0 Mars
ProcedureReturn AjouterDateF(DateF(Annee, 3, 1), #PB_Date_Day, d-1)
EndProcedure
; ; Exemples:
; Define annee, masque$ = "%jour %jj-%mois-%aaaa"
; For annee = 1950 To 2011
; Debug FormatDateF(masque$, DatePaquesF(annee))
; Next annee
; Les dates ci-dessus correspondent tous celles publiées dans le livre
; Chambers 6-Figure Mathematical Tables L.J.Comrie 1949 Vols 1,2
; Debug FormatDateF(masque$, DatePaquesF(2000)) ; Dim 23-Avr-2000
; Debug FormatDateF(masque$, DatePaquesF(2010))
; Debug FormatDateF(masque$, DatePaquesF()) ; Cette année
ProcedureDLL.q JoursDepuis1970(Annee=0, Mois=1, Jour=1)
; Retourne le nombre de jours de la date donnée pour 1-Jan-1970 (à savoir renvoie la valeur appropriée pour #JoursDepuis1970)
; S'il n'y a pas d'arguments (ou année = 0), la date d'aujourd'hui est utilisée, en retournant un résultat négatif
; Cette routine est conçue comme une aide à chaque fois qu'une date d'une autre époque que le 1-Jan-1601 est examinée
If Annee=0
Annee = AnneeF()
Mois = MoisF()
Jour = JourF()
EndIf ; Aujourd'hui
ProcedureReturn (DateF(1970) - DateF(Annee, Mois, Jour))/UniteJourF
EndProcedure
;; Exemples:
; Debug JoursDepuis1970(1601) ; 01-Jan-1601 -> 134774 ; Tel qu'utilisé par ces routines
; Debug JoursDepuis1970(1752, 09, 14) ; 14-Sep-1752 -> 79366
; Debug JoursDepuis1970(1756) ; 01-Jan-1756 -> 78162
; Debug JoursDepuis1970(1970) ; 01-Jan-1970 -> 0
; Debug JoursDepuis1970(AnneeF()) ; Cette année -> Quelques nombres négatifs
ProcedureDLL.q DateEntreeRepF(Repertoire, DateType)
; Renvoie la date de l'entrée actuelle dans le répertoire en cours d'examen
ProcedureReturn DateDePbF(DirectoryEntryDate(Repertoire, DateType))
EndProcedure
; Voir l'exemple pour DefinirDateFichierF()
ProcedureDLL.q ObtenirDateFichierF(Filename$, DateType)
; Renvoie la date du fichier spécifié
ProcedureReturn DateDePbF(GetFileDate(Filename$, DateType))
EndProcedure
; Voir l'exemple pour DefinirDateFichierF()
ProcedureDLL DefinirDateFichierF(Filename$, DateType, Date.q)
; Changer la date du fichier spécifié
SetFileDate(Filename$, DateType, DateVersPbF(Date))
EndProcedure
;; Exemple:
; Define fichier$ = "D:\FichierTestIndesirable.txt"
; Define masque$ = "%jj-%mois-%aa %hh:%ii:%ss"
; Define Repertoire$ = "D:\"
; If CreateFile(0, fichier$)
; CloseFile(0)
;EndIf
; Debug FormatDateF(masque$, ObtenirDateFichierF(fichier$, #PB_Date_Created))
; Debug FormatDateF(masque$, ObtenirDateFichierF(fichier$, #PB_Date_Modified))
; DefinirDateFichierF(fichier$, #PB_Date_Modified, Aujourd_huiF()) ; Minuit
; Debug FormatDateF(masque$, ObtenirDateFichierF(fichier$, #PB_Date_Modified))
;
; ExamineDirectory(0, Repertoire$, "*.*") ; Lister toutes les entrées de haut niveau dans D:\
; While NextDirectoryEntry(0)
; If DirectoryEntryName(0) = GetFilePart(fichier$)
; Debug FormatDateF(masque$, DirectoryEntryDate(0, #PB_Date_Modified))+" "+DirectoryEntryName(0)
; Break
; EndIf
; Wend
; FinishDirectory(0)
; DeleteFile(fichier$)
ProcedureDLL.i MaxLongAnneeF()
; Retourner l'année complète maximale supportée par des (non quad) variables
; (Supposons que la limite pour les variables quad est l'année 9999)
; Une valeur retournée de -1 signifie que les quads sont nécessaires pour les paramètres actuels
; Le résultat dépendra de la valeur de #AnneeEpoqueF et l'unité de granularité
Protected date.q, a, m, j
Protected limite=2147483647 ; 2^31-1
date = DateF(9999, 12, 31, 23, 59, 59)
If date<0
ProcedureReturn -1
EndIf
If date<=limite
ProcedureReturn 9999
EndIf
AmjF(limite, @a, @m, @j)
If a<=AnneeF()
a=0
EndIf ; Supposons que les années à venir devront être prises en charge
ProcedureReturn a-1
EndProcedure
;; Exemples: fonctionne
; ModeDateF(#PB_Date_Minute) ; Granularite = 1 minute
; Debug MaxLongAnneeF() ; 5683 est l'année maximale supportée par cette granularité
; ModeDateF(10000); Granularite = 10 secondes
; Debug MaxLongAnneeF() ; 2280
; ModeDateF(15000); Granularite = 15 secondes
; Debug MaxLongAnneeF() ; 2620
; Debug ModeDateF(#PB_Date_Minimum) ; 6.011 secondes ; 6040
; Debug MaxLongAnneeF() ; cette année
; Debug ModeDateF(#PB_Date_Maximum) ; 123.423 secondes 123423
; Debug MaxLongAnneeF() ; 9999
