CALENDRIER PERPÉTUEL

rem  Aide au calendrier perpétuel - Fabric-Cal-Aide
' Enregistrez-le sous le nom :  Fabric-Cal-Aide.exe
dim a$
a$="Cette aide concerne surtout la fonction IMPRIMER du calendrier, qui utilise EXCEL :"
a$=a$+chr$(13)+string$(130,"-")
a$=a$+chr$(13)+"Pour obtenir sur EXCEL un beau calendrier comme sur l'écran, il faut "
a$=a$+"procéder à"+chr$(13)+"un certain nombre d'opérations. Je vous propose celles-ci :"
a$=a$+chr$(13)+"- Mettre la hauteur des lignes à 22,50 (sauf titres d'en haut)"
a$=a$+chr$(13)+"- Mettre la largeur des colonnes à 15,00"+chr$(13)
a$=a$+"- Mettre les marges haut, bas, gauche et droite à 1"+chr$(13)
a$=a$+"- Mettre des bordures autour de toutes les cellules"+chr$(13)
a$=a$+"(comme cela, vous pourrez les imprimer sous la forme de 4 feuilles A4)"
a$=a$+chr$(13)+"Mais aussi :"+chr$(13)
a$=a$+"- Mettre tous les caractères en gras"+chr$(13)
a$=a$+"- Fusionner toutes les cellules A2 à F2, G2 à L2, M2 à R2 et S2 à X2"
a$=a$+chr$(13)+"- Colorer toute la ligne 1 et la ligne 2 en turquoise clair"
a$=a$+chr$(13)+"- Colorer les cellules correspondant aux dimanche en jaune"+chr$(13)
a$=a$+"- Colorer les cellules correspondant aux jours fériés en brun (pâle)"+chr$(13)
a$=a$+"  (les dimanche et jours fériés se terminent par 3 étoiles (***))"+chr$(13)
a$=a$+"NOTA :"+chr$(13)+"- Les lignes B, D, F... servent à écrire ensuite ce qu'on"
a$=a$+" veut à la main sur le papier"+chr$(13)
a$=a$+"- Tous les jours fériés y sont, y compris les lundi de Pâques et de Pentecôte"
a$=a$+chr$(13)+"- Les jours fériés ne sont pas colorés en brun lorsqu'il s'agit de dimanche"
a$=a$+chr$(13)+"  (vous pourrez modifier tout cela sur EXCEL si cela ne vous convient pas)"
a$=a$+chr$(13)+"- Ce calendrier n'est perpétuel que dans les limites du calendrier dit"
a$=a$+chr$(13)+"  « grégorien » qui a commencé à exister en fin 1582 et qui devrait être"
a$=a$+chr$(13)+"  remplacé par un autre en 4582."+chr$(13)
a$=a$+"  Il ne fonctionne donc que de 1583 à 4581."+chr$(13)
a$=a$+"- On ne peut imprimer qu'un seul calendrier à la fois, car le programme s'arrête alors."

left 0,200 : top 0,100 : width 0,430 : height 0,390
caption 0,"Aide au fabricateur de calendrier perpétuel"

alpha 1
left 1,10 : top 1,8
caption 1,a$

rem ' ***** Fabricateur de calendriers perpétuels ***** Fabric-Calendrier-perpet
dim ex , ie, j1 , j2 , j3 , m1 , m2 , m3 , tt , c$ , e$ , o$ , t$
dim a , b , c , d , e , f , g , h , i , j , k , m , n , p , q , r
dim  s , t , u , v , x , y , w , z , j$(7) , m$(12)
data "Dim." , "Lun." , "Mar." , "Mer." , "Jeu.." , "Ven." , "Sam"
data "JAN" , "FEV" , "MAR" , "AVR" , "MAI" , "JUIN" , "JUIL"
data "AOU" , "SEP" , "OCT" , "NOV" , "DEC"
label calcul , fin , ecran , choix , excel , aide , egal , fini
c$="Auteur de ce programme :  jjn4"

for i=0 to 6
 read j$(i)
next i
for i=1 to 12
 read m$(i)
next i

width 0,400 : height 0,240 : caption 0,"Fabricateur de calendriers"

alpha 1
left 1,60 : top 1,40
font_bold 1
font_size 1,14
caption 1,"CALENDRIER PERPÉTUEL"

alpha 2
left 2,100 : top 2,85
caption 2,"Quelle année"

edit 3
left 3,180 : top 3,80 : width 3,60 : height 3,21
on_change 3,egal
set_focus 3

button 4
left 4,250 : top 4,125 : width 4,60 : height 4,21
caption 4,"Calculer"
on_click 4,ecran

alpha 5
left 5,10 : top 5,170
caption 5,c$

spin 7
left 7,160 : top 7,2 : width 7,53
on_change 7,choix
hide 7

button 9
left 9,287 : top 9,2 : width 9,60 : height 9,21
caption 9,"Imprimer"
on_click 9,excel
hide 9

button 10
left 10,253 : top 10,2 : width 10,40 : height 10,21
caption 10,"Aide"
on_click 10,aide
hide 10

form 11
left 11,200 : top 11,100 : width 11,430 : height 11,405
caption 11,"Aide au fabricateur de calendrier perpétuel"
hide 11

alpha 12
parent 12,11
left 12,10 : top 12,8
caption 12,a$

end

egal:
if text$(3)<>"" then position 7,text$(3)
return

ecran:
caption 5,"ATTENDEZ" : wait 1
if ie=0
 width 0,1019 : height 0,637
 left 2,20 : top 2,4
 left 3,95 : top 3,2
 tt=0 : if text$(3)<>"" then tt=val(text$(3))
 show 7 : position 7,tt
 left 1,500 : top 1,1
 caption 1,"CALENDRIER  "+text$(3)
 left 5,850 : top 5,4
 left 4,220 : top 4,2
 picture 8 : left 8,0 : top 8,25 : width 8,1011 : height 8,578
 color 8,192,192,192 : show 9 : left 10,353 : show 10
 for i=9 to 20
  for j=1 to 32
  alpha (i-8)*32+j :              alpha (i-8)*32+j+400
  left (i-8)*32+j,(i-9)*84+2 :    left (i-8)*32+j+400,(i-9)*84+2
  top (i-8)*32+j,j*18+8 :        top (i-8)*32+j+400,j*18+8
  width (i-8)*32+j,83 :          width (i-8)*32+j+400,83
  color (i-8)*32+j,255,255,255 :  color (i-8)*32+j+400,255,255,255
  next j
  color (i-8)*32+1,180,255,255
 next i
else
 for i=9 to 20
  for j=1 to 32
  caption (i-8)*32+j+400,""
  color (i-8)*32+j,255,255,255
  color (i-8)*32+j+400,255,255,255
  next j
  color (i-8)*32+1,180,255,255
 next i
 caption 1,"CALENDRIER  "+text$(3)
end_if
ie=1
gosub calcul
return

choix:
text 3,position(7)
return

excel:
message "En passant à EXCEL, vous fermez le calendrier"
ex=1 : gosub calcul
return

aide:
execute "Fabric-Cal-Aide.exe"
return

calcul:
t$=text$(3) : if t$="" then return
if val(t$)<1583 or val(t$)>4581 then beep : caption 5,"Non, pas possible (1583 à 4581)" : return
tt=val(t$)
' Calcul du lundi de Pâques - Algorithme de Oudin
g=tt-int(tt/19)*19
w=int(tt/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(tt/4)+tt
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
else
 j1=r+1 : m1=3
end_if
' Calcul du jeudi de l'Ascension
y=r+39
if y>92
 j3=y-92 : m3=6
else
 j3=y-61 : m3=5
end_if
' Calcul du lundi de Pentecôte
x=r+50
if x>92
 j2=x-92 : m2=6
else
 j2=x-61 : m2=5
end_if
' Calcul du jour de la semaine et affichage
c=val(left$(t$,2))
a=val(right$(t$,2))
if ex=1 then excel_start : excel_file_new 1
for m=1 to 12
 for j=1 to 31
  select m
  case 1 : t=0
  case 2 : t=3
  case 3 : t=3
  case 4 : t=6
  case 5 : t=1
  case 6 : t=4
  case 7 : t=6
  case 8 : t=2
  case 9 : t=5
  case 10 : t=0
  case 11 : t=3
  case 12 : t=5
  end_select
  if a=0 and m<3
  p=(20-c)*2+int((c-1)/4)-5
  else
  p=(19-c)*2+int(c/4)-4
  end_if
  b=int(a/4)
  if a/4=int(a/4) and m<3 then b=b-1
  s=(j+t+a+b+p)-7*int((j+t+a+b+p)/7) : s=s-int(s/7)*7
  if j=31 and (m=2 or m=4 or m=6 or m=9 or m=11) then goto fin
  if (m=2 and j>29) or (m=2 and a/4<>int(a/4) and j>28) then goto fin
  if a=0 and c/4<>int(c/4) and m=2 and j=29 then goto fin
  e$="" : if s=0 then e$="***"
  if j=1 and m=5 and tt>1946 then e$="***"
  if j=8 and m=5 and tt>1952 and tt<1960 then e$="***"
  if j=8 and m=5 and tt>1981 then e$="***"
  if j=14 and m=7 and tt>1879 then e$="***"
  if (j=15 and m=8) or (j=1 and m=11) then e$="***"
  if j=11 and m=11 and tt>1921 then e$="***"
  if (j=25 and m=12) or (j=1 and m=1) then e$="***"
  if (j=j1 and m=m1) or (j=j2 and m=m2) or (j=j3 and m=m3) then e$="***"
  o$="" : if j<10 then o$="0"
  if ex=0 then caption m*32+j+401,j$(s)+"."+o$+str$(j)+e$
  if e$="***" and ex=0
  if j$(s)="Dim."
    color m*32+j+1,255,255,0 : color m*32+j+401,255,255,0
  else
    color m*32+j+1,255,204,153 : color m*32+j+401,255,204,153
  end_if
  end_if
  if ex=1 then excel_write chr$(64+m*2-1)+str$(j+2),j$(s)+"."+o$+str$(j)+e$
fin:
 next j
 if ex=0
  caption m*32+401," "+m$(m)+".."+t$ : color m*32+401,180,255,255
  font_size m*32+401,10 : font_bold m*32+401
 end_if
 if ex=1 then excel_write chr$(64+m*2-1)+"2",m$(m)+".."+t$
next m
for j=1 to 19 step 6
 if ex=1 then excel_write chr$(64+j)+"1","CALENDRIER "+t$
next j
caption 5,c$
if ex=1 then goto fini
ex=0
return

fini:
terminate