Calcul du jour de la semains entre 1583 et 9999
-----------------------------------------------
Define quel_jour()=
Prgm
:Local j,jr,m,a4,aa,s,s1,s2,n,i
:©af,a2
:0→j:0→m:0→a4:0→aa
:0→s:0→s1:0→s2:0→i
:28→n
:©0→af:0→a2
:setMode(5,2)
:For i,1,2:  Disp "":EndFor
:Disp "     Donner la date en chiffres                  "
:Disp "         appuyez sur [enter]"
:Disp "            pour continuer"
:For i,1,3:  Disp "":EndFor
:getKey(1)
:©-------------------------- entrée
:Request "Le jour : ",j
:Request "Le mois : ",m
:Request "L'année : ",a4
:©--------------------ctrl fev 28 ou 29
:If mod(a4,4)=0 and mod(a4,100)≠0 or mod(a4,400)=0
:  29→n
:If m=2 and j>n
:  Goto err
:©-----------------ctrôl jour mois année
:If j<1:Goto err
:If m<1 or m>12:Goto err
:If a4≤1583 or a4>9999:Goto err
:If j>30 Then
:  If m=4 or m=6 or m=9 or m=11
:    Goto err
:EndIf
:If j>31 Then
:  If m=1 or m=3 or m=5 or m=7 or m=8 or m=10 or m=12
:    Goto err
:EndIf
:©Les mois gardent leur numéro pour le calcul
:©--------------------------- année
:((a4)/(100))→aa
:©fPart(aa)→af:af*100→a2
:©--------------------------- siècle
:int(aa)→s
:s+1→s
:©--------------------------- calcul
:If m<3 Then
: floor(((23*m)/(9)))+j+4+a4+floor(((a4-1)/(4)))-floor(((a4-1)/(100)))+floor(((a4-1)/(400)))→s1
:Else
:  floor(((23*m)/(9)))+j+2+a4+floor(((a4)/(4)))-floor(((a4)/(100)))+floor(((a4)/(400)))→s1
:EndIf
:mod(s1,7)→s2
:©---------------------------- jour
:If s2=0:"dimanche"→jr
:If s2=1:"lundi"→jr
:If s2=2:"mardi"→jr
:If s2=3:"mercredi"→jr
:If s2=4:"jeudi"→jr
:If s2=5:"vendredi"→jr
:If s2=6:"samedi"→jr
:©-------------------------- affiche
:For i,1,2:  Disp "":EndFor
:Disp "nous sommes dans le ",s,"ième siècle"
:Disp ""
:Disp "le",j,"/",m,"/",a4,"tombe..."
:Disp ""
:Disp "un ",jr
:For i,1,2:  Disp "":EndFor
:Disp "                                 Entrer pour sortir !"
:getKey(1)
:Goto fin
:©-------------------------- erreur
:Lbl err
:For i,1,2:Disp "":EndFor
:Disp "                    le",j,"/",m,"/",a4,"  !?"
:Disp ""
:Disp "       Désolé cette date n'est pas valide"
:For i,1,2:Disp "":EndFor
:©---------------------------- fin
:Lbl fin
:EndPrgm