SPIN et DATE

dim Jo ,Mo ,An ,J$ ,M$ ,A$ ,Bi ,Jr$ ,Ms$
label DateVal ,DateTxt ,Verif ,Err
on_error_goto Err

' ************  INITIALISATION  *************
width 0,210  :height 0,160  :left 0,(screen_x-width(0))/2  :top 0,(screen_y-height(0))/2  :border_small 0
spin 1  :left 1,85  :top 1,45  :width 1,56  :max 1,73050  :on_change 1,DateTxt
edit 2  :left 2,55  :top 2,45  :width 2,68  :text 2,date$ :on_change 2,Verif
gosub DateVal  :position 1,Jo+Mo+An  :end

' *** CALCUL VALEUR ET TEXTE DE LA DATE (Réf. 1 janvier 1901) ***
DateVal:
' Nombre de Jours dans le Mois
  Jo=val(left$(text$(2),2))
' Nombre de Jours dans les Mois avant la date
  if frac(val(right$(text$(2),4))/4)=0 then Bi=1  :else  :Bi=0
  select val(mid$(text$(2),4,2))
    case 1  :Mo=0  :Ms$=" janvier "
    case 2  :Mo=31 :Ms$=" février "
    case 3  :Mo=59+Bi  :Ms$=" mars "
    case 4  :Mo=90+Bi  :Ms$=" avril "
    case 5  :Mo=120+Bi :Ms$=" mai "
    case 6  :Mo=151+Bi :Ms$=" juin "
    case 7  :Mo=181+Bi :Ms$=" juillet "
    case 8  :Mo=212+Bi :Ms$=" août "
    case 9  :Mo=243+Bi :Ms$=" septembre "
    case 10 :Mo=273+Bi :Ms$=" novembre "
    case 11 :Mo=304+Bi :Ms$=" octobre "
    case 12 :Mo=334+Bi :Ms$=" décembre "
  end_select
' Nombre de Jours dans les années avant la date
  An=int((val(right$(text$(2),4))-1901)*365.25)
' Définition du jour de semaine
  select mid$(str$(frac(int(Jo+Mo+An)/7)+0.1),3,1)
    case 1 :Jr$="Lundi "
    case 2 :Jr$="Mardi "
    case 3 :Jr$="Mercredi "
    case 5 :Jr$="Jeudi "
    case 6 :Jr$="Vendredi "
    case 8 :Jr$="Samedi "
    case 9 :Jr$="Dimanche "
  end_select
' Affichage de la date complète
  caption 0,Jr$+left$(text$(2),2)+Ms$+right$(text$(2),4)
  return

' ***** MISE AU FORMAT TEXTE DATE "JJ/MM/AAAA" *****
DateTxt:
' Recherche de l'année
  An=int(val(text$(1))/365.25)  :A$=An+1901
' Recherche du mois et du jour
  if frac(val(right$(text$(2),4))/4)=0 then Bi=1  :else  :Bi=0
  Mo=val(text$(1))-int(An*365.25)
  if Mo>0  then M$=01  :Jo=Mo
  if Mo>31 then M$=02  :Jo=Mo-31
  if Mo>59+Bi  then M$=03  :Jo=Mo-59-Bi
  if Mo>90+Bi  then M$=04  :Jo=Mo-90-Bi
  if Mo>120+Bi then M$=05  :Jo=Mo-120-Bi
  if Mo>151+Bi then M$=06  :Jo=Mo-151-Bi
  if Mo>181+Bi then M$=07  :Jo=Mo-181-Bi
  if Mo>212+Bi then M$=08  :Jo=Mo-212-Bi
  if Mo>243+Bi then M$=09  :Jo=Mo-243-Bi
  if Mo>273+Bi then M$=10  :Jo=Mo-273-Bi
  if Mo>304+Bi then M$=11  :Jo=Mo-304-Bi
  if Mo>334+Bi then M$=12  :Jo=Mo-334-Bi
' Affichage de la date
  text 2,right$(str$(Jo+100),2)+"/"+M$+"/"+A$
  end

' ********** VERIFICATION DES SAISIES **********
Verif:
' Validité de la saisie
  if len(text$(2))<>10 then caption 0,"Date :  jj/mm/aaaa"  :end
  if numeric(left$(text$(2),2)+mid$(text$(2),4,2)+right$(text$(2),4))=0 then caption 0,"Date :  jj/mm/aaaa"  :end
' Vérification de lannée
  if val(right$(text$(2),4))<1901 then A$="1901"  :else  :A$=right$(text$(2),4)
  if val(right$(text$(2),4))>2100 then A$="2100"  :else  :A$=right$(text$(2),4)
' Vérification du mois
  if val(mid$(text$(2),4,2))<01 or val(mid$(text$(2),4,2))>12 then M$="01"  :else  :M$=mid$(text$(2),4,2)
' Vérification du jour
  if val(left$(text$(2),2))<01 then J$="01"  :else  :J$=left$(text$(2),2)
  if val(left$(text$(2),2))>31 then J$="31"
  if val(M$)=4 or val(M$)=6 or val(M$)=9 or val(M$)=11 and val(J$)>30 then J$="30"
  if val(M$)=2 and frac(val(A$)/4)=0 and val(J$)>29 then J$=29
  if val(M$)=2 and frac(val(A$)/4)>0 and val(J$)>28 then J$=28
' Validation de la saisie
  text 2,J$+"/"+M$+"/"+A$
  gosub DateVal  :position 1,Jo+Mo+An

Err:
  return