Un Calendrier de plus

' Calendrier pour sélection d'une date par Jean Claude 22/02/2014

' ce calendrier est destiné à être exécuté par un autre exécutable (EXECUTE_WAIT)
' il peut, aussi, être exploité tel quel.
' les année bissextiles sont prises en compte.
' à vous de choisir la manière de sortir au label sortie (ligne 24)
' les boutons [<<] et [>>] servent à changer d'année
' les boutons [<] et [>] servent à changer de mois
' la sélection de la date se fait par un click dans le calendrier sur le jour souhaité
' En retour 4 variables: js$=Jour de la semaine / jj$ = jour sélectionné /
' mm$ = mois sélectionné / aaaa$ =a nnée sélectionnée
' ==============================================================================
' hide 0
dim no%,nbj%,ct%,aaaa%,mm%,lf%
dim js$,ms$,jj$,mm$,aaaa$
dim form_calendar%,bouton_mav%,bouton_map%,bouton_aav%,bouton_aap%,alpha_moi%
dim alpha_Lu%,alpha_Ma%,alpha_Me%,alpha_Je%,alpha_Ve%,alpha_Sa%,alpha_Di%
label close,anavant,moiavant,anapres,moiapres,sortie
' démarrage
no%=no%+1:Calendrier(no%)
END
' =============================================== ci-dessous gestion des sorties
sortie:
jj$=caption$(number_click)
' résultat dans caption form 0
Retourne_Jour_Semaine(jj$,mm$,aaaa$)
caption 0,js$+" "+jj$+"/"+mm$+"/"+aaaa$
' ici vous pouvez enregistrer le résultat dans un fichier
' terminate
return
' ----
close:
' vide le fichier
terminate
return
' ===================================================== ci-dessous: Le programme
Sub Calendrier(num_obj%)
form_calendar%=num_obj%
 form form_calendar%:width form_calendar%,206:height form_calendar%,208
   border_small form_calendar%:on_close form_calendar%,close
   top form_calendar%,((screen_y/2)-height(form_calendar%)/2)
   left form_calendar%,((screen_x/2)-width(form_calendar%)/2)
   caption form_calendar%,"Calendrier"
 num_obj%=num_obj%+1:bouton_aav%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,"<<"
   top bouton_aav%,5:left bouton_aav%,5:hint num_obj%," Année Précédente "
 num_obj%=num_obj%+1:bouton_mav%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,"<"
   top bouton_mav%,top(bouton_aav%):left bouton_mav%,left(bouton_aav%)+23:hint num_obj%," Mois Précédent "
 num_obj%=num_obj%+1:alpha_moi%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   height num_obj%,20:font_bold num_obj%
   top alpha_moi%,top(bouton_aav%)+3
 num_obj%=num_obj%+1:bouton_map%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,">":hint num_obj%," Mois Suivant "
   top bouton_map%,top(bouton_aav%):left bouton_map%,width(form_calendar%)-66
 num_obj%=num_obj%+1:bouton_aap%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,">>":hint num_obj%," Année Suivante"
   top bouton_aap%,top(bouton_aav%):left bouton_aap%,left(bouton_map%)+23
 num_obj%=num_obj%+1:alpha_Lu%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(bouton_aav%)+9:caption num_obj%,"Lu"
 num_obj%=num_obj%+1:alpha_Ma%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Ma"
 num_obj%=num_obj%+1:alpha_Me%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Me"
 num_obj%=num_obj%+1:alpha_Je%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Je"
 num_obj%=num_obj%+1:alpha_Ve%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Ve"
 num_obj%=num_obj%+1:alpha_Sa%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Sa"
 num_obj%=num_obj%+1:alpha_Di%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Di"
 no%=number_objects
 on_click bouton_aav%,anavant:on_click bouton_mav%,moiavant:on_click bouton_aap%,anapres:on_click bouton_map%,moiapres
 jj$="01":mm$=mid$(date$,4,2):aaaa$=right$(date$,4):Retourne_Jour_Semaine(jj$,mm$,aaaa$)
 Retourne_ms(mm$)
 font_name alpha_moi%,"Arial":left alpha_moi%,left(bouton_mav%)+width(bouton_mav%)+ct%:caption alpha_moi%,ms$+" "+aaaa$
 Fab_alphas_J("01",mm$,aaaa$,nbj%)
End_Sub
' -------
moiapres:
 mm%=val(mm$)
 if mm%=12
    mm%=1:aaaa%=val(aaaa$):aaaa%=aaaa%+1:aaaa$=str$(aaaa%)
 else
    mm%=mm%+1
 end_if
 if mm%<10
    mm$="0"+str$(mm%)
 else
    mm$=str$(mm%)
 end_if
 Reinit_Calendrier()
return
' -------
moiavant:
 mm%=val(mm$)
 if mm%=1
    mm%=12:aaaa%=val(aaaa$):aaaa%=aaaa%-1:aaaa$=str$(aaaa%)
 else
    mm%=mm%-1
 end_if
 if mm%<10
    mm$="0"+str$(mm%)
 else
    mm$=str$(mm%)
 end_if
 Reinit_Calendrier()
return
' ------
anapres:
 aaaa%=val(aaaa$):aaaa%=aaaa%+1:aaaa$=str$(aaaa%)
 Reinit_Calendrier()
return
' ------
anavant:
 aaaa%=val(aaaa$):aaaa%=aaaa%-1:aaaa$=str$(aaaa%)
 Reinit_Calendrier()
return
' --------------------
Sub Reinit_Calendrier()
 Retourne_Jour_Semaine("01",mm$,aaaa$)
 Retourne_ms(mm$)
 left alpha_moi%,left(bouton_mav%)+width(bouton_mav%)+ct%:caption alpha_moi%,ms$+" "+aaaa$
 Fab_alphas_J("01",mm$,aaaa$,nbj%)
End_sub
' ------------
Sub Fab_alphas_J(jour$,moi$,annee$,nb_jour%)
  dim_local Laaaa%,bissextile%,i%,num_obj%,nbo%,tp%
  nbo%=number_objects
  if nbo%>no%
     for i%=no%+1 to nbo%
          delete i%
     next i%
  end_if
  Laaaa%=val(annee$)
  IF (FRAC(Laaaa%/4)=0 AND FRAC(Laaaa%/100)>0) OR FRAC(Laaaa%/400)=0 THEN bissextile%=1:' JL35
  if moi$="02" and bissextile%=1 then nb_jour%=nb_jour%+1
  num_obj%=13:tp%=50
  retourne_lf()
  for i%=1 to nb_jour%
     num_obj%=num_obj%+1:alpha num_obj%:parent num_obj%,form_calendar%
     width num_obj%,20:height num_obj%,20:on_click num_obj%,sortie
     top num_obj%,tp%:left num_obj%,lf%:lf%=lf%+25
       if i%<10
          caption num_obj%,"0"+str$(i%)
       else
          caption num_obj%,str$(i%)
       end_if
     if lf%>=165+25 then font_bold num_obj%:tp%=tp%+20:lf%=15
  next i%
End_Sub
' ---------------
Sub retourne_lf()
 if js$="Lundi" then lf%=15
 if js$="Mardi" then lf%=40
 if js$="Mercredi" then lf%=65
 if js$="Jeudi" then lf%=90
 if js$="Vendredi" then lf%=115
 if js$="Samedi" then lf%=140
 if js$="Dimanche" then lf%=165
End_sub
' ------------------
Sub Retourne_ms(mm$)
 if mm$="01" then ct%=13:nbj%=31:ms$="Janvier"
 if mm$="02" then ct%=13:nbj%=28:ms$="Février"
 if mm$="03" then ct%=18:nbj%=31:ms$="Mars"
 if mm$="04" then ct%=19:nbj%=30:ms$="Avril"
 if mm$="05" then ct%=20:nbj%=31:ms$="Mai"
 if mm$="06" then ct%=19:nbj%=30:ms$="Juin"
 if mm$="07" then ct%=15:nbj%=31:ms$="Juillet"
 if mm$="08" then ct%=19:nbj%=31:ms$="Août"
 if mm$="09" then ct%=1:nbj%=30:ms$="Septembre"
 if mm$="10" then ct%=15:nbj%=31:ms$="Octobre"
 if mm$="11" then ct%=2:nbj%=30:ms$="Novembre"
 if mm$="12" then ct%=2:nbj%=31:ms$="Décembre"
End_Sub
' ---------------------------------------
Sub Retourne_Jour_Semaine(jour$,moi$,an$)
' d'après l'algorytme de Mike Keith
 dim_local Laaaa%,Lmm%,jj%,az,ma,rm,jjs,rp
 jj%=val(jour$):Lmm%=val(moi$):Laaaa%=val(an$)
 if Lmm%>=3
    az=Laaaa%:ma=2
 else
    az=Laaaa%-1:ma=0
 end_if
 rp=((int(23*Lmm%))/9)+jj%+4+Laaaa%+(int(az/4))-(int(az/100))+(int(az/400))-ma
 rm=mod(rp,7):jjs=int(rm)
 if jjs=0 then js$="Dimanche"
 if jjs=1 then js$="Lundi"
 if jjs=2 then js$="Mardi"
 if jjs=3 then js$="Mercredi"
 if jjs=4 then js$="Jeudi"
 if jjs=5 then js$="Vendredi"
 if jjs=6 then js$="Samedi"
End_Sub

' Calendrier pour sélection d'une date par Jean Claude 22/02/2014

' ce calendrier est destiné à être exécuté par un autre exécutable (EXECUTE_WAIT)
' il peut, aussi, être exploité tel quel.
' les année bissextiles sont prises en compte.
' à vous de choisir la manière de sortir au label sortie (ligne 24)
' les boutons [<<] et [>>] servent à changer d'année
' les boutons [<] et [>] servent à changer de mois
' la sélection de la date se fait par un click dans le calendrier sur le jour souhaité
' En retour 4 variables: js$=Jour de la semaine / jj$ = jour sélectionné /
' mm$ = mois sélectionné / aaaa$ =a nnée sélectionnée
' ==============================================================================
' hide 0
dim no%,nbj%,ct%,aaaa%,mm%,lf%
dim js$,ms$,jj$,mm$,aaaa$
dim form_calendar%,bouton_mav%,bouton_map%,bouton_aav%,bouton_aap%,alpha_moi%
dim alpha_Lu%,alpha_Ma%,alpha_Me%,alpha_Je%,alpha_Ve%,alpha_Sa%,alpha_Di%
label close,anavant,moiavant,anapres,moiapres,sortie
' démarrage
no%=no%+1:Calendrier(no%)
END
' =============================================== ci-dessous gestion des sorties
sortie:
if no%>0 : font_color no%,0,0,0 :end_if  :' ajout yg
if js$<>"Dimanche":font_bold_off no% :end_if :' ajout yg
no%=number_click:jj$=caption$(no%)
' résultat dans caption form 0
Retourne_Jour_Semaine(jj$,mm$,aaaa$)
caption 0,js$+" "+jj$+"/"+mm$+"/"+aaaa$
font_color no%,255,0,0 :font_bold no% :' ajout yg
' ici vous pouvez enregistrer le résultat dans un fichier
' terminate
return
' ----
close:
' vide le fichier
terminate
return
' ===================================================== ci-dessous: Le programme
Sub Calendrier(num_obj%)
form_calendar%=num_obj%
 form form_calendar%:width form_calendar%,206:height form_calendar%,208
   border_small form_calendar%:on_close form_calendar%,close
   top form_calendar%,((screen_y/2)-height(form_calendar%)/2)
   left form_calendar%,((screen_x/2)-width(form_calendar%)/2)
   caption form_calendar%,"Calendrier"
 num_obj%=num_obj%+1:bouton_aav%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,"<<"
   top bouton_aav%,5:left bouton_aav%,5:hint num_obj%," Année Précédente "
 num_obj%=num_obj%+1:bouton_mav%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,"<"
   top bouton_mav%,top(bouton_aav%):left bouton_mav%,left(bouton_aav%)+23:hint num_obj%," Mois Précédent "
 num_obj%=num_obj%+1:alpha_moi%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   height num_obj%,20:font_bold num_obj%
   top alpha_moi%,top(bouton_aav%)+3
 num_obj%=num_obj%+1:bouton_map%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,">":hint num_obj%," Mois Suivant "
   top bouton_map%,top(bouton_aav%):left bouton_map%,width(form_calendar%)-66
 num_obj%=num_obj%+1:bouton_aap%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,">>":hint num_obj%," Année Suivante"
   top bouton_aap%,top(bouton_aav%):left bouton_aap%,left(bouton_map%)+23
 num_obj%=num_obj%+1:alpha_Lu%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(bouton_aav%)+9:caption num_obj%,"Lu"
 num_obj%=num_obj%+1:alpha_Ma%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Ma"
 num_obj%=num_obj%+1:alpha_Me%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Me"
 num_obj%=num_obj%+1:alpha_Je%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Je"
 num_obj%=num_obj%+1:alpha_Ve%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Ve"
 num_obj%=num_obj%+1:alpha_Sa%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Sa"
 num_obj%=num_obj%+1:alpha_Di%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
   width num_obj%,20:height num_obj%,20:font_bold num_obj%
   top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Di"
 on_click bouton_aav%,anavant:on_click bouton_mav%,moiavant:on_click bouton_aap%,anapres:on_click bouton_map%,moiapres
 jj$="01":mm$=mid$(date$,4,2):aaaa$=right$(date$,4):Retourne_Jour_Semaine(jj$,mm$,aaaa$)
 Retourne_ms(mm$)
 font_name alpha_moi%,"Arial":left alpha_moi%,left(bouton_mav%)+width(bouton_mav%)+ct%:caption alpha_moi%,ms$+" "+aaaa$
 Fab_alphas_J("01",mm$,aaaa$,nbj%)
End_Sub
' -------
moiapres:
 mm%=val(mm$)
 if mm%=12
    mm%=1:aaaa%=val(aaaa$):aaaa%=aaaa%+1:aaaa$=str$(aaaa%)
 else
    mm%=mm%+1
 end_if
 if mm%<10
    mm$="0"+str$(mm%)
 else
    mm$=str$(mm%)
 end_if
 Reinit_Calendrier()
return
' -------
moiavant:
 mm%=val(mm$)
 if mm%=1
    mm%=12:aaaa%=val(aaaa$):aaaa%=aaaa%-1:aaaa$=str$(aaaa%)
 else
    mm%=mm%-1
 end_if
 if mm%<10
    mm$="0"+str$(mm%)
 else
    mm$=str$(mm%)
 end_if
 Reinit_Calendrier()
return
' ------
anapres:
 aaaa%=val(aaaa$):aaaa%=aaaa%+1:aaaa$=str$(aaaa%)
 Reinit_Calendrier()
return
' ------
anavant:
 aaaa%=val(aaaa$):aaaa%=aaaa%-1:aaaa$=str$(aaaa%)
 Reinit_Calendrier()
return
' --------------------
Sub Reinit_Calendrier()
 Retourne_Jour_Semaine("01",mm$,aaaa$)
 Retourne_ms(mm$)
 left alpha_moi%,left(bouton_mav%)+width(bouton_mav%)+ct%:caption alpha_moi%,ms$+" "+aaaa$
 Fab_alphas_J("01",mm$,aaaa$,nbj%)
End_sub
' ------------
Sub Fab_alphas_J(jour$,moi$,annee$,nb_jour%)
  dim_local Laaaa%,bissextile%,i%,num_obj%,nbo%,tp%
  nbo%=number_objects
  if nbo%>13
     for i%=14 to nbo%
          delete i%
     next i%
  end_if
  Laaaa%=val(annee$)
  IF (FRAC(Laaaa%/4)=0 AND FRAC(Laaaa%/100)>0) OR FRAC(Laaaa%/400)=0 THEN bissextile%=1:' JL35
  if moi$="02" and bissextile%=1 then nb_jour%=nb_jour%+1
  num_obj%=13:tp%=50
  retourne_lf()
  for i%=1 to nb_jour%
     num_obj%=num_obj%+1:alpha num_obj%:parent num_obj%,form_calendar% :cursor_point num_obj%
     width num_obj%,20:height num_obj%,20:on_click num_obj%,sortie
     top num_obj%,tp%:left num_obj%,lf%:lf%=lf%+25
       if i%<10
          caption num_obj%,"0"+str$(i%)
       else
          caption num_obj%,str$(i%)
       end_if
     if lf%>=165+25 then font_bold num_obj%:tp%=tp%+20:lf%=15
  next i%
End_Sub
' ---------------
Sub retourne_lf()
 if js$="Lundi" then lf%=15
 if js$="Mardi" then lf%=40
 if js$="Mercredi" then lf%=65
 if js$="Jeudi" then lf%=90
 if js$="Vendredi" then lf%=115
 if js$="Samedi" then lf%=140
 if js$="Dimanche" then lf%=165
End_sub
' ------------------
Sub Retourne_ms(mm$)
 if mm$="01" then ct%=13:nbj%=31:ms$="Janvier"
 if mm$="02" then ct%=13:nbj%=28:ms$="Février"
 if mm$="03" then ct%=18:nbj%=31:ms$="Mars"
 if mm$="04" then ct%=19:nbj%=30:ms$="Avril"
 if mm$="05" then ct%=20:nbj%=31:ms$="Mai"
 if mm$="06" then ct%=19:nbj%=30:ms$="Juin"
 if mm$="07" then ct%=15:nbj%=31:ms$="Juillet"
 if mm$="08" then ct%=19:nbj%=31:ms$="Août"
 if mm$="09" then ct%=1:nbj%=30:ms$="Septembre"
 if mm$="10" then ct%=15:nbj%=31:ms$="Octobre"
 if mm$="11" then ct%=2:nbj%=30:ms$="Novembre"
 if mm$="12" then ct%=2:nbj%=31:ms$="Décembre"
End_Sub
' ---------------------------------------
Sub Retourne_Jour_Semaine(jour$,moi$,an$)
' d'après l'algorytme de Mike Keith
 dim_local Laaaa%,Lmm%,jj%,az,ma,rm,jjs,rp
 jj%=val(jour$):Lmm%=val(moi$):Laaaa%=val(an$)
 if Lmm%>=3
    az=Laaaa%:ma=2
 else
    az=Laaaa%-1:ma=0
 end_if
 rp=((int(23*Lmm%))/9)+jj%+4+Laaaa%+(int(az/4))-(int(az/100))+(int(az/400))-ma
 rm=mod(rp,7):jjs=int(rm)
 if jjs=0 then js$="Dimanche"
 if jjs=1 then js$="Lundi"
 if jjs=2 then js$="Mardi"
 if jjs=3 then js$="Mercredi"
 if jjs=4 then js$="Jeudi"
 if jjs=5 then js$="Vendredi"
 if jjs=6 then js$="Samedi"
End_Sub

' Calendrier pour sélection d'une date par Jean Claude 22/02/2014

' ce calendrier est destiné à être exécuté par un autre exécutable (EXECUTE_WAIT)
' il peut, aussi, être exploité tel quel.
' les année bissextiles sont prises en compte.
' à vous de choisir la manière de sortir au label sortie (ligne 23)
' les boutons [<<] et [>>] servent à changer d'année
' les boutons [<] et [>] servent à changer de mois
' la sélection de la date se fait par un click dans le calendrier sur le jour souhaité
' En retour 4 variables: js$=Jour de la semaine / jj$ = jour sélectionné /
' mm$ = mois sélectionné / aaaa$ = année sélectionnée
' ==============================================================================
' hide 0: ' ligne à mettre en service suivant vos besoins
dim no%,nbj%,ct%,aaaa%,mm%,lf%,nobj%
dim js$,ms$,jj$,mm$,aaaa$
dim form_calendar%,bouton_mav%,bouton_map%,bouton_aav%,bouton_aap%,alpha_moi%
dim alpha_Lu%,alpha_Ma%,alpha_Me%,alpha_Je%,alpha_Ve%,alpha_Sa%,alpha_Di%
label close,anavant,moiavant,anapres,moiapres,sortie
' démarrage
no%=no%+1:Calendrier(no%)
END
' =============================================== ci-dessous gestion des sorties
sortie:
if no%>0 : font_color no%,0,0,0 :end_if  :' ajout yg
if js$<>"Dimanche":font_bold_off no% :end_if :' ajout yg
no%=number_click:jj$=caption$(no%)
' résultat dans caption form 0
Retourne_Jour_Semaine(jj$,mm$,aaaa$)
caption 0,js$+" "+jj$+"/"+mm$+"/"+aaaa$
font_color no%,255,0,0 :font_bold no% :' ajout yg
no%=number_objects:' remise à jour du compteur d'objet
wait 500
' ici vous pouvez enregistrer le résultat dans un fichier
' terminate :' ou pas
return
' ----
close:
' vide le fichier
terminate
return
' ===================================================== ci-dessous: Le programme
Sub Calendrier(num_obj%)
form_calendar%=num_obj%
 form form_calendar%:width form_calendar%,206:height form_calendar%,208
  border_small form_calendar%:on_close form_calendar%,close
  top form_calendar%,((screen_y/2)-height(form_calendar%)/2)
  left form_calendar%,((screen_x/2)-width(form_calendar%)/2)
  caption form_calendar%,"Calendrier"
 num_obj%=num_obj%+1:bouton_aav%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,"<<"
  top bouton_aav%,5:left bouton_aav%,5:hint num_obj%," Année Précédente "
 num_obj%=num_obj%+1:bouton_mav%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,"<"
  top bouton_mav%,top(bouton_aav%):left bouton_mav%,left(bouton_aav%)+23:hint num_obj%," Mois Précédent "
 num_obj%=num_obj%+1:alpha_moi%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  height num_obj%,20:font_bold num_obj%
  top alpha_moi%,top(bouton_aav%)+3
 num_obj%=num_obj%+1:bouton_map%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,">":hint num_obj%," Mois Suivant "
  top bouton_map%,top(bouton_aav%):left bouton_map%,width(form_calendar%)-66
 num_obj%=num_obj%+1:bouton_aap%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,">>":hint num_obj%," Année Suivante"
  top bouton_aap%,top(bouton_aav%):left bouton_aap%,left(bouton_map%)+23
 num_obj%=num_obj%+1:alpha_Lu%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(bouton_aav%)+9:caption num_obj%,"Lu"
 num_obj%=num_obj%+1:alpha_Ma%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Ma"
 num_obj%=num_obj%+1:alpha_Me%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Me"
 num_obj%=num_obj%+1:alpha_Je%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Je"
 num_obj%=num_obj%+1:alpha_Ve%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Ve"
 num_obj%=num_obj%+1:alpha_Sa%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Sa"
 num_obj%=num_obj%+1:alpha_Di%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Di"
 nobj%=number_objects
 on_click bouton_aav%,anavant:on_click bouton_mav%,moiavant:on_click bouton_aap%,anapres:on_click bouton_map%,moiapres
 jj$="01":mm$=mid$(date$,4,2):aaaa$=right$(date$,4):Retourne_Jour_Semaine(jj$,mm$,aaaa$)
 Retourne_ms(mm$)
 font_name alpha_moi%,"Arial":left alpha_moi%,left(bouton_mav%)+width(bouton_mav%)+ct%:caption alpha_moi%,ms$+" "+aaaa$
 Fab_alphas_J("01",mm$,aaaa$,nbj%)
End_Sub
' -------
moiapres:
 mm%=val(mm$)
 if mm%=12
    mm%=1:aaaa%=val(aaaa$):aaaa%=aaaa%+1:aaaa$=str$(aaaa%)
 else
    mm%=mm%+1
 end_if
 if mm%<10
    mm$="0"+str$(mm%)
 else
    mm$=str$(mm%)
 end_if
 Reinit_Calendrier()
return
' -------
moiavant:
 mm%=val(mm$)
 if mm%=1
    mm%=12:aaaa%=val(aaaa$):aaaa%=aaaa%-1:aaaa$=str$(aaaa%)
 else
    mm%=mm%-1
 end_if
 if mm%<10
    mm$="0"+str$(mm%)
 else
    mm$=str$(mm%)
 end_if
 Reinit_Calendrier()
return
' ------
anapres:
 aaaa%=val(aaaa$):aaaa%=aaaa%+1:aaaa$=str$(aaaa%)
 Reinit_Calendrier()
return
' ------
anavant:
 aaaa%=val(aaaa$):aaaa%=aaaa%-1:aaaa$=str$(aaaa%)
 Reinit_Calendrier()
return
' --------------------
Sub Reinit_Calendrier()
 Retourne_Jour_Semaine("01",mm$,aaaa$)
 Retourne_ms(mm$)
 left alpha_moi%,left(bouton_mav%)+width(bouton_mav%)+ct%:caption alpha_moi%,ms$+" "+aaaa$
 Fab_alphas_J("01",mm$,aaaa$,nbj%)
End_sub
' ------------
Sub Fab_alphas_J(jour$,moi$,annee$,nb_jour%)
  dim_local Laaaa%,bissextile%,i%,num_obj%,nbo%,tp%
  nbo%=number_objects
  if nbo%>nobj%
    for i%=nobj%+1 to nbo%
          delete i%
    next i%
  end_if
  Laaaa%=val(annee$)
  IF (FRAC(Laaaa%/4)=0 AND FRAC(Laaaa%/100)>0) OR FRAC(Laaaa%/400)=0 THEN bissextile%=1:' JL35
  if moi$="02" and bissextile%=1 then nb_jour%=nb_jour%+1
  num_obj%=13:tp%=50
  retourne_lf()
  for i%=1 to nb_jour%
    num_obj%=num_obj%+1:alpha num_obj%:parent num_obj%,form_calendar%
    cursor_point num_obj%:' ajout de Ygeronimi
    width num_obj%,20:height num_obj%,20:on_click num_obj%,sortie
    top num_obj%,tp%:left num_obj%,lf%:lf%=lf%+25
      if i%<10
          caption num_obj%,"0"+str$(i%)
      else
          caption num_obj%,str$(i%)
      end_if
    if lf%>=165+25 then font_bold num_obj%:tp%=tp%+20:lf%=15
  next i%
End_Sub
' ---------------
Sub retourne_lf()
 if js$="Lundi" then lf%=15
 if js$="Mardi" then lf%=40
 if js$="Mercredi" then lf%=65
 if js$="Jeudi" then lf%=90
 if js$="Vendredi" then lf%=115
 if js$="Samedi" then lf%=140
 if js$="Dimanche" then lf%=165
End_sub
' ------------------
Sub Retourne_ms(mm$)
 if mm$="01" then ct%=13:nbj%=31:ms$="Janvier"
 if mm$="02" then ct%=13:nbj%=28:ms$="Février"
 if mm$="03" then ct%=18:nbj%=31:ms$="Mars"
 if mm$="04" then ct%=19:nbj%=30:ms$="Avril"
 if mm$="05" then ct%=20:nbj%=31:ms$="Mai"
 if mm$="06" then ct%=19:nbj%=30:ms$="Juin"
 if mm$="07" then ct%=15:nbj%=31:ms$="Juillet"
 if mm$="08" then ct%=19:nbj%=31:ms$="Août"
 if mm$="09" then ct%=1:nbj%=30:ms$="Septembre"
 if mm$="10" then ct%=15:nbj%=31:ms$="Octobre"
 if mm$="11" then ct%=2:nbj%=30:ms$="Novembre"
 if mm$="12" then ct%=2:nbj%=31:ms$="Décembre"
End_Sub
' ---------------------------------------
Sub Retourne_Jour_Semaine(jour$,moi$,an$)
' d'après l'algorytme de Mike Keith
 dim_local Laaaa%,Lmm%,jj%,az,ma,rm,jjs,rp
 jj%=val(jour$):Lmm%=val(moi$):Laaaa%=val(an$)
 if Lmm%>=3
    az=Laaaa%:ma=2
 else
    az=Laaaa%-1:ma=0
 end_if
 rp=((int(23*Lmm%))/9)+jj%+4+Laaaa%+(int(az/4))-(int(az/100))+(int(az/400))-ma
 rm=mod(rp,7):jjs=int(rm)
 if jjs=0 then js$="Dimanche"
 if jjs=1 then js$="Lundi"
 if jjs=2 then js$="Mardi"
 if jjs=3 then js$="Mercredi"
 if jjs=4 then js$="Jeudi"
 if jjs=5 then js$="Vendredi"
 if jjs=6 then js$="Samedi"
End_Sub

' Calendrier pour sélection d'une date par Jean Claude 22/02/2014

' ce calendrier est destiné à être exécuté par un autre exécutable (EXECUTE_WAIT)
' il peut, aussi, être exploité tel quel.
' les année bissextiles sont prises en compte.
' à vous de choisir la manière de sortir au label sortie (ligne 23)
' les boutons [<<] et [>>] servent à changer d'année
' les boutons [<] et [>] servent à changer de mois
' la sélection de la date se fait par un click dans le calendrier sur le jour souhaité
' En retour 4 variables: js$=Jour de la semaine / jj$ = jour sélectionné /
' mm$ = mois sélectionné / aaaa$ = année sélectionnée
' ==============================================================================

' Déclarations
dim no%,nbj%,ct%,aaaa%,mm%,lf%,nobj%
dim js$,ms$,jj$,mm$,aaaa$
dim form_calendar%,bouton_mav%,bouton_map%,bouton_aav%,bouton_aap%,alpha_moi%
dim alpha_Lu%,alpha_Ma%,alpha_Me%,alpha_Je%,alpha_Ve%,alpha_Sa%,alpha_Di%
dim jour_selection$,nb_selection
label close,anavant,moiavant,anapres,moiapres,sortie

' démarrage
' hide 0: ' ligne à mettre en service suivant vos besoins

no%=no%+1:Calendrier(no%)
END


' =============================================== ci-dessous gestion des sorties
sortie:
if no%>0 : font_color no%,0,0,0 :end_if
if js$<>"Dimanche":font_bold_off no% :end_if
Efface_Selection()
no%=number_click:jj$=caption$(no%)
' résultat dans caption form 0
Retourne_Jour_Semaine(jj$,mm$,aaaa$)
jour_selection$ = js$+" "+jj$+"/"+mm$+"/"+aaaa$
nb_selection = no%
caption 0,jour_selection$
font_color no%,255,0,0 :font_bold no%
no%=number_objects:' remise à jour du compteur d'objet
wait 500
' ici vous pouvez enregistrer le résultat dans un fichier
' terminate :' On ferme tout ou pas selon le besoin
return
' ----
close:
' vide le fichier
terminate
return


' ===================================================== ci-dessous: Le programme
Sub Calendrier(num_obj%)
form_calendar%=num_obj%
 form form_calendar%:width form_calendar%,206:height form_calendar%,208
  border_small form_calendar%:on_close form_calendar%,close
  top form_calendar%,((screen_y/2)-height(form_calendar%)/2)
  left form_calendar%,((screen_x/2)-width(form_calendar%)/2)
  caption form_calendar%,"Calendrier"
 num_obj%=num_obj%+1:bouton_aav%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,"<<"
  top bouton_aav%,5:left bouton_aav%,5:hint num_obj%," Année Précédente "
 num_obj%=num_obj%+1:bouton_mav%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,"<"
  top bouton_mav%,top(bouton_aav%):left bouton_mav%,left(bouton_aav%)+23:hint num_obj%," Mois Précédent "
 num_obj%=num_obj%+1:alpha_moi%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  height num_obj%,20:font_bold num_obj%
  top alpha_moi%,top(bouton_aav%)+3
 num_obj%=num_obj%+1:bouton_map%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,">":hint num_obj%," Mois Suivant "
  top bouton_map%,top(bouton_aav%):left bouton_map%,width(form_calendar%)-66
 num_obj%=num_obj%+1:bouton_aap%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,">>":hint num_obj%," Année Suivante"
  top bouton_aap%,top(bouton_aav%):left bouton_aap%,left(bouton_map%)+23
 num_obj%=num_obj%+1:alpha_Lu%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(bouton_aav%)+9:caption num_obj%,"Lu"
 num_obj%=num_obj%+1:alpha_Ma%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Ma"
 num_obj%=num_obj%+1:alpha_Me%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Me"
 num_obj%=num_obj%+1:alpha_Je%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Je"
 num_obj%=num_obj%+1:alpha_Ve%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Ve"
 num_obj%=num_obj%+1:alpha_Sa%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Sa"
 num_obj%=num_obj%+1:alpha_Di%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Di"
 nobj%=number_objects
 nb_selection = 0 :Efface_Selection()
 on_click bouton_aav%,anavant:on_click bouton_mav%,moiavant
 on_click bouton_aap%,anapres:on_click bouton_map%,moiapres
 jj$="01":mm$=mid$(date$,4,2):aaaa$=right$(date$,4):Retourne_Jour_Semaine(jj$,mm$,aaaa$)
 Retourne_ms(mm$)
 font_name alpha_moi%,"Arial":left alpha_moi%,left(bouton_mav%)+width(bouton_mav%)+ct%:caption alpha_moi%,ms$+" "+aaaa$
 Fab_alphas_J("01",mm$,aaaa$,nbj%)
End_Sub

' -------
Sub Efface_Selection()
 if nb_selection > 0
  font_color nb_selection,0,0,0
  if left$(jour_selection$,3)<>"Dim" then font_bold_off nb_selection
  nb_selection = 0
 end_if
 jour_selection$=""
 Caption 0,jour_selection$
End_Sub

' -------
moiapres:
 Efface_Selection()
 mm%=val(mm$)
 if mm%=12
    mm%=1:aaaa%=val(aaaa$):aaaa%=aaaa%+1:aaaa$=str$(aaaa%)
 else
    mm%=mm%+1
 end_if
 if mm%<10
    mm$="0"+str$(mm%)
 else
    mm$=str$(mm%)
 end_if
 Reinit_Calendrier()
return


' -------
moiavant:
 Efface_Selection()
 mm%=val(mm$)
 if mm%=1
    mm%=12:aaaa%=val(aaaa$):aaaa%=aaaa%-1:aaaa$=str$(aaaa%)
 else
    mm%=mm%-1
 end_if
 if mm%<10
    mm$="0"+str$(mm%)
 else
    mm$=str$(mm%)
 end_if
 Reinit_Calendrier()
return

' ------
anapres:
 Efface_Selection()
 aaaa%=val(aaaa$):aaaa%=aaaa%+1:aaaa$=str$(aaaa%)
 Reinit_Calendrier()
return

' ------
anavant:
 Efface_Selection()
 aaaa%=val(aaaa$):aaaa%=aaaa%-1:aaaa$=str$(aaaa%)
 Reinit_Calendrier()
return

' --------------------
Sub Reinit_Calendrier()
 Efface_Selection()
 Retourne_Jour_Semaine("01",mm$,aaaa$)
 Retourne_ms(mm$)
 left alpha_moi%,left(bouton_mav%)+width(bouton_mav%)+ct%:caption alpha_moi%,ms$+" "+aaaa$
 Fab_alphas_J("01",mm$,aaaa$,nbj%)
End_sub


' ------------
Sub Fab_alphas_J(jour$,moi$,annee$,nb_jour%)
  dim_local Laaaa%,bissextile%,i%,num_obj%,nbo%,tp%
  nbo%=number_objects
  if nbo%>nobj%
    for i%=nobj%+1 to nbo%
          delete i%
    next i%
  end_if
  Laaaa%=val(annee$)
  IF (FRAC(Laaaa%/4)=0 AND FRAC(Laaaa%/100)>0) OR FRAC(Laaaa%/400)=0 THEN bissextile%=1:' JL35
  if moi$="02" and bissextile%=1 then nb_jour%=nb_jour%+1
  num_obj%=13:tp%=50
  retourne_lf()
  for i%=1 to nb_jour%
    num_obj%=num_obj%+1:alpha num_obj%:parent num_obj%,form_calendar%
    cursor_point num_obj%
    width num_obj%,20:height num_obj%,20:on_click num_obj%,sortie
    top num_obj%,tp%:left num_obj%,lf%:lf%=lf%+25
      if i%<10
          caption num_obj%,"0"+str$(i%)
      else
          caption num_obj%,str$(i%)
      end_if
    if lf%>=165+25 then font_bold num_obj%:tp%=tp%+20:lf%=15
  next i%
End_Sub


' ---------------
Sub retourne_lf()
 if js$="Lundi" then lf%=15
 if js$="Mardi" then lf%=40
 if js$="Mercredi" then lf%=65
 if js$="Jeudi" then lf%=90
 if js$="Vendredi" then lf%=115
 if js$="Samedi" then lf%=140
 if js$="Dimanche" then lf%=165
End_sub


' ------------------
Sub Retourne_ms(mm$)
 if mm$="01" then ct%=13:nbj%=31:ms$="Janvier"
 if mm$="02" then ct%=13:nbj%=28:ms$="Février"
 if mm$="03" then ct%=18:nbj%=31:ms$="Mars"
 if mm$="04" then ct%=19:nbj%=30:ms$="Avril"
 if mm$="05" then ct%=20:nbj%=31:ms$="Mai"
 if mm$="06" then ct%=19:nbj%=30:ms$="Juin"
 if mm$="07" then ct%=15:nbj%=31:ms$="Juillet"
 if mm$="08" then ct%=19:nbj%=31:ms$="Août"
 if mm$="09" then ct%=1:nbj%=30:ms$="Septembre"
 if mm$="10" then ct%=15:nbj%=31:ms$="Octobre"
 if mm$="11" then ct%=2:nbj%=30:ms$="Novembre"
 if mm$="12" then ct%=2:nbj%=31:ms$="Décembre"
End_Sub


' ---------------------------------------
Sub Retourne_Jour_Semaine(jour$,moi$,an$)
' d'après l'algorytme de Mike Keith
 dim_local Laaaa%,Lmm%,jj%,az,ma,rm,jjs,rp
 jj%=val(jour$):Lmm%=val(moi$):Laaaa%=val(an$)
 if Lmm%>=3
    az=Laaaa%:ma=2
 else
    az=Laaaa%-1:ma=0
 end_if
 rp=((int(23*Lmm%))/9)+jj%+4+Laaaa%+(int(az/4))-(int(az/100))+(int(az/400))-ma
 rm=mod(rp,7):jjs=int(rm)
 if jjs=0 then js$="Dimanche"
 if jjs=1 then js$="Lundi"
 if jjs=2 then js$="Mardi"
 if jjs=3 then js$="Mercredi"
 if jjs=4 then js$="Jeudi"
 if jjs=5 then js$="Vendredi"
 if jjs=6 then js$="Samedi"
End_Sub

' Calendrier pour sélection d'une date par Jean Claude 22/02/2014
'      avec la participation de JJN4, JL35, Jicehel et Ygeronimi

' ce calendrier est destiné à être exécuté par un autre exécutable (EXECUTE_WAIT)
' il peut, aussi, être exploité tel quel.
' les année bissextiles sont prises en compte, ainsi que les jours fériés.
' à vous de choisir la manière de sortir au label sortie (ligne 27)
' les boutons [<<] et [>>] servent à changer d'année
' les boutons [<] et [>] servent à changer de mois
' la sélection de la date se fait par un click dans le calendrier sur le jour souhaité
' En retour 4 variables: js$=Jour de la semaine / jj$ = jour sélectionné /
' mm$ = mois sélectionné / aaaa$ = année sélectionnée
' ==============================================================================
' Déclarations
dim no%,nbj%,ct%,aaaa%,mm%,lf%,nobj%
dim Lundi_paque%,Jeudi_Ascension%,Lundi_Pentecote%,m1%,m2%,m3%,m4%
dim js$,ms$,jj$,mm$,aaaa$
dim form_calendar%,bouton_mav%,bouton_map%,bouton_aav%,bouton_aap%,alpha_moi%
dim alpha_Lu%,alpha_Ma%,alpha_Me%,alpha_Je%,alpha_Ve%,alpha_Sa%,alpha_Di%
dim jour_selection$,nb_selection%
label close,anavant,moiavant,anapres,moiapres,sortie
' démarrage
' hide 0: ' ligne à mettre en service suivant vos besoins
no%=no%+1:Calendrier(no%)
END
' =============================================== ci-dessous gestion des sorties
sortie:
if no%>0 : font_color no%,0,0,0 :end_if
if js$<>"Dimanche":font_bold_off no% :end_if
Efface_Selection()
no%=number_click:jj$=caption$(no%)
' résultat dans caption form 0
Retourne_Jour_Semaine(jj$,mm$,aaaa$)
jour_selection$ = js$+" "+jj$+"/"+mm$+"/"+aaaa$
nb_selection% = no%
caption 0,jour_selection$
font_color no%,255,0,0 :font_bold no%
no%=number_objects:' remise à jour du compteur d'objet
wait 500
' ici vous pouvez enregistrer le résultat dans un fichier
' terminate :' On ferme tout ou pas selon le besoin
return
' ----
close:
' vide le fichier
terminate
return
' ===================================================== ci-dessous: Le programme
Sub Calendrier(num_obj%)
form_calendar%=num_obj%
 form form_calendar%:width form_calendar%,206:height form_calendar%,208
  border_small form_calendar%:on_close form_calendar%,close
  top form_calendar%,((screen_y/2)-height(form_calendar%)/2)
  left form_calendar%,((screen_x/2)-width(form_calendar%)/2)
  caption form_calendar%,"Calendrier"
 num_obj%=num_obj%+1:bouton_aav%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,"<<"
  top bouton_aav%,5:left bouton_aav%,5:hint num_obj%," Année Précédente "
 num_obj%=num_obj%+1:bouton_mav%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,"<"
  top bouton_mav%,top(bouton_aav%):left bouton_mav%,left(bouton_aav%)+23:hint num_obj%," Mois Précédent "
 num_obj%=num_obj%+1:alpha_moi%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  height num_obj%,20:font_bold num_obj%
  top alpha_moi%,top(bouton_aav%)+3
 num_obj%=num_obj%+1:bouton_map%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,">":hint num_obj%," Mois Suivant "
  top bouton_map%,top(bouton_aav%):left bouton_map%,width(form_calendar%)-66
 num_obj%=num_obj%+1:bouton_aap%=num_obj%:button num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%:caption num_obj%,">>":hint num_obj%," Année Suivante"
  top bouton_aap%,top(bouton_aav%):left bouton_aap%,left(bouton_map%)+23
 num_obj%=num_obj%+1:alpha_Lu%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(bouton_aav%)+9:caption num_obj%,"Lu"
 num_obj%=num_obj%+1:alpha_Ma%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Ma"
 num_obj%=num_obj%+1:alpha_Me%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Me"
 num_obj%=num_obj%+1:alpha_Je%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Je"
 num_obj%=num_obj%+1:alpha_Ve%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Ve"
 num_obj%=num_obj%+1:alpha_Sa%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Sa"
 num_obj%=num_obj%+1:alpha_Di%=num_obj%:alpha num_obj%:parent num_obj%,form_calendar%
  width num_obj%,20:height num_obj%,20:font_bold num_obj%
  top num_obj%,top(bouton_aav%)+25:left num_obj%,left(num_obj%-1)+25::caption num_obj%,"Di"
 nobj%=number_objects
 nb_selection% = 0 :Efface_Selection()
 on_click bouton_aav%,anavant:on_click bouton_mav%,moiavant
 on_click bouton_aap%,anapres:on_click bouton_map%,moiapres
 jj$="01":mm$=mid$(date$,4,2):aaaa$=right$(date$,4):Retourne_Jour_Semaine(jj$,mm$,aaaa$)
 Retourne_ms(mm$)
 font_name alpha_moi%,"Arial":left alpha_moi%,left(bouton_mav%)+width(bouton_mav%)+ct%:caption alpha_moi%,ms$+" "+aaaa$
 Fab_alphas_J("01",mm$,aaaa$,nbj%)
End_Sub
' -------
Sub Efface_Selection():' Jicehel
 if nb_selection% > 0
  font_color nb_selection%,0,0,0
  if left$(jour_selection$,3)<>"Dim" then font_bold_off nb_selection%
  nb_selection% = 0
 end_if
 jour_selection$=""
 Caption 0,jour_selection$
End_Sub
' -------
moiapres:
 Efface_Selection()
 mm%=val(mm$)
 if mm%=12
    mm%=1:aaaa%=val(aaaa$):aaaa%=aaaa%+1:aaaa$=str$(aaaa%)
 else
    mm%=mm%+1
 end_if
 if mm%<10
    mm$="0"+str$(mm%)
 else
    mm$=str$(mm%)
 end_if
 Reinit_Calendrier()
return
' -------
moiavant:
 Efface_Selection()
 mm%=val(mm$)
 if mm%=1
    mm%=12:aaaa%=val(aaaa$):aaaa%=aaaa%-1:aaaa$=str$(aaaa%)
 else
    mm%=mm%-1
 end_if
 if mm%<10
    mm$="0"+str$(mm%)
 else
    mm$=str$(mm%)
 end_if
 Reinit_Calendrier()
return
' ------
anapres:
 Efface_Selection()
 aaaa%=val(aaaa$):aaaa%=aaaa%+1:aaaa$=str$(aaaa%)
 Reinit_Calendrier()
return
' ------
anavant:
 Efface_Selection()
 aaaa%=val(aaaa$):aaaa%=aaaa%-1:aaaa$=str$(aaaa%)
 Reinit_Calendrier()
return
' --------------------
Sub Reinit_Calendrier()
 Efface_Selection()
 Retourne_Jour_Semaine("01",mm$,aaaa$)
 Retourne_ms(mm$)
 left alpha_moi%,left(bouton_mav%)+width(bouton_mav%)+ct%:caption alpha_moi%,ms$+" "+aaaa$
 Fab_alphas_J("01",mm$,aaaa$,nbj%)
End_sub
' ------------
Sub Fab_alphas_J(jour$,moi$,annee$,nb_jour%)
  dim_local Laaaa%,bissextile%,i%,num_obj%,nbo%,tp%
  nbo%=number_objects
  if nbo%>nobj%
    for i%=nobj%+1 to nbo%
          delete i%
    next i%
  end_if
  Laaaa%=val(annee$)
  paques(Laaaa%):' Retourne Lundi_paque%
  IF (FRAC(Laaaa%/4)=0 AND FRAC(Laaaa%/100)>0) OR FRAC(Laaaa%/400)=0 THEN bissextile%=1:' JL35
  if moi$="02" and bissextile%=1 then nb_jour%=nb_jour%+1
  num_obj%=13:tp%=50
  retourne_lf()
  for i%=1 to nb_jour%
    num_obj%=num_obj%+1:alpha num_obj%:parent num_obj%,form_calendar%
    cursor_point num_obj%
    width num_obj%,20:height num_obj%,20:on_click num_obj%,sortie
    top num_obj%,tp%:left num_obj%,lf%:lf%=lf%+25
      if i%<10
          caption num_obj%,"0"+str$(i%)
      else
          caption num_obj%,str$(i%)
      end_if
' Pâques
  if Lundi_paque%=1 and moi$="03" and m1%=4 and i%=31
      color num_obj%,50,255,150:font_bold num_obj%
  else
    if i%=Lundi_paque% and moi$="03" and m1%=3
      color num_obj%,50,255,150:font_bold num_obj%
      if num_obj%>1 and i%<>31 then color num_obj%-1,50,255,150:font_bold num_obj%-1
    end_if
  end_if
    if i%=Lundi_paque% and moi$="04" and m1%=4
      color num_obj%,50,255,150:font_bold num_obj%
      if i%>1 then color num_obj%-1,50,255,150:font_bold num_obj%-1
    End_if
'  Ascension
    if i%=Jeudi_Ascension% and moi$="05" and m3%=5
        color num_obj%,50,255,150:font_bold num_obj%
    end_if
    if i%=Jeudi_Ascension% and moi$="06" and m3%=6
        color num_obj%,50,255,150:font_bold num_obj%
    end_if
'  Pentecôte
    if i%=Lundi_Pentecote% and moi$="05" and m2%=5
        color num_obj%,50,255,150:font_bold num_obj%
    end_if
    if i%=Lundi_Pentecote% and moi$="06" and m2%=6
        color num_obj%,50,255,150:font_bold num_obj%
    end_if
'    autres jours feriés
      if i%=1 and moi$="01" then color num_obj%,50,255,150:font_bold num_obj%
      if i%=14 and moi$="02" then color num_obj%,255,220,220:' font_bold num_obj%
      if i%=1 and moi$="05" and Laaaa%>1889 then color num_obj%,50,255,150:font_bold num_obj%
      if i%=8 and moi$="05" and Laaaa%>1952 and Laaaa%<1959 then color num_obj%,50,255,150:font_bold num_obj%
      if i%=8 and moi$="05" and Laaaa%>1981 then color num_obj%,50,255,150:font_bold num_obj%
      if i%=14 and moi$="07" and Laaaa%>1790 then color num_obj%,50,255,150:font_bold num_obj%
      if i%=15 and moi$="08" then color num_obj%,50,255,150:font_bold num_obj%
      if i%=1 and moi$="11" then color num_obj%,50,255,150:font_bold num_obj%
      if i%=11 and moi$="11" and Laaaa%>1922 then color num_obj%,50,255,150:font_bold num_obj%
      if i%=25 and moi$="12" then color num_obj%,50,255,150:font_bold num_obj%
    if lf%>=165+25 then font_bold num_obj%:tp%=tp%+20:lf%=15
  next i%
End_Sub
' ----------
Sub paques(aaaaP%)
' Calcul du lundi de Pâques - Algorithme de Oudin - code JJN4
dim_local g,w,d,e,h,k,u,q,v,z,f,n,r,j1,j2,j3,x,y
g=aaaaP%-int(aaaaP%/19)*19
w=int(aaaaP%/100)
d=int(w/4)
e=int((8*w+13)/25)
h=19*g+w-d-e+15-int((19*g+w-d-e+15)/30)*30
k=int(h/28)
u=int(29/(h+1))
q=int((21-g)/11)
v=(k*u*q-1)*k+h
z=int(aaaaP%/4)+aaaaP%
n=z+v+2+d-w
f=n-int(n/7)*7
r=28+v-f
if h=29 and r=50 then r=57
if h=28 and g>10 and r=49 then r=56
if r>30
 j1=r-30 : m1%=4 : Lundi_paque%=j1
else
 j1=r+1 : m1%=3 : Lundi_paque%=j1
end_if
' Calcul du jeudi de l'Ascension
y=r+39
if y>92
 j3=y-92 : m3%=6 : Jeudi_Ascension%=j3
else
 j3=y-61 : m3%=5 : Jeudi_Ascension%=j3
end_if
' Calcul du lundi de Pentecôte
x=r+50
if x>92
 j2=x-92 : m2%=6 : Lundi_Pentecote%=j2
else
 j2=x-61 : m2%=5 : Lundi_Pentecote%=j2
end_if
End_sub
' ---------------
Sub retourne_lf()
 if js$="Lundi" then lf%=15
 if js$="Mardi" then lf%=40
 if js$="Mercredi" then lf%=65
 if js$="Jeudi" then lf%=90
 if js$="Vendredi" then lf%=115
 if js$="Samedi" then lf%=140
 if js$="Dimanche" then lf%=165
End_sub
' ------------------
Sub Retourne_ms(mm$)
 if mm$="01" then ct%=13:nbj%=31:ms$="Janvier"
 if mm$="02" then ct%=13:nbj%=28:ms$="Février"
 if mm$="03" then ct%=18:nbj%=31:ms$="Mars"
 if mm$="04" then ct%=19:nbj%=30:ms$="Avril"
 if mm$="05" then ct%=20:nbj%=31:ms$="Mai"
 if mm$="06" then ct%=19:nbj%=30:ms$="Juin"
 if mm$="07" then ct%=15:nbj%=31:ms$="Juillet"
 if mm$="08" then ct%=19:nbj%=31:ms$="Août"
 if mm$="09" then ct%=1:nbj%=30:ms$="Septembre"
 if mm$="10" then ct%=15:nbj%=31:ms$="Octobre"
 if mm$="11" then ct%=2:nbj%=30:ms$="Novembre"
 if mm$="12" then ct%=2:nbj%=31:ms$="Décembre"
End_Sub
' ---------------------------------------
Sub Retourne_Jour_Semaine(jour$,moi$,an$)
' d'après l'algorytme de Mike Keith
 dim_local Laaaa%,Lmm%,jj%,az,ma,rm,jjs,rp
 jj%=val(jour$):Lmm%=val(moi$):Laaaa%=val(an$)
 if Lmm%>=3
    az=Laaaa%:ma=2
 else
    az=Laaaa%-1:ma=0
 end_if
 rp=((int(23*Lmm%))/9)+jj%+4+Laaaa%+(int(az/4))-(int(az/100))+(int(az/400))-ma
 rm=mod(rp,7):jjs=int(rm)
 if jjs=0 then js$="Dimanche"
 if jjs=1 then js$="Lundi"
 if jjs=2 then js$="Mardi"
 if jjs=3 then js$="Mercredi"
 if jjs=4 then js$="Jeudi"
 if jjs=5 then js$="Vendredi"
 if jjs=6 then js$="Samedi"
End_Sub