Un petit calendrier vite fait

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

C'est essentiellement une application de l'excellente et géniale formule de Nardo26 (enfin, de Keith rapportée par Nardo), qui donne le jour de la semaine en fonction de la date jour, mois, année.
Il n'y a qu'un objet: Grid, en plus du Form 0.
J'aurais bien voulu colorier les dimanches, mais à ma connaissance on ne peut pas colorer une cellule donnée.

Code:: DIM w0, h0, wu, hu, i%, j%, a$, c$, w1, wn, lm(12), js$(7), bi, a, m, j, d
DIM Qpa, Qas, Qpe, q, a1, b1, c1, d1, e1, f1, g1, h1, i1, k1, l1, m1
LABEL Jours, Bissex, FF, FM, Qpap
DATA "JANVIER","FÉVRIER","MARS","AVRIL","MAI","JUIN","JUILLET","AOUT"
DATA "SEPTEMBRE","OCTOBRE","NOVEMBRE","DÉCEMBRE"
DATA "D","L","M","M","J","V","S"
lm(1)=31: lm(2)=28:lm(3)=31:lm(4)=30:lm(5)=31:lm(6)=30:lm(7)=31:lm(8)=31
lm(9)=30:lm(10)=31:lm(11)=30:lm(12)=31

a = 2011: ' Année
w0 = 900: h0 = 600
w1 = 1: ' 1ère colonne (date)
wu = w0-24-w1: hu = h0-55
wn = wu/12-2
WIDTH 0, w0: HEIGHT 0, h0
GRID 1: TOP 1, 18: LEFT 1, 3: WIDTH 1, w0-24: HEIGHT 1, hu
FONT_NAME 1,"Bitstream Vera Sans Mono": FONT_SIZE 1, 7
GRID_COLUMN 1, 13
GRID_ROW 1, 32
GRID_ROW_FIXED 1, 1
GRID_COLUMN_WIDTH 1, wn
GRID_ROW_HEIGHT 1, hu/32-2
GRID_ONE_COLUMN_WIDTH 1, 1,w1
FOR i% = 1 TO 31
GRID_WRITE 1, i%+1,1,STR$(i%)
NEXT i%
FOR i% = 1 TO 12
READ a$: GRID_WRITE 1, 1,i%+1,a$
NEXT i%
FOR i% = 0 TO 6: READ js$(i%): NEXT i%
GOSUB Bissex: IF bi = 1 THEN lm(2)=29: ' si année bissextile
GOSUB Qpap: ' quantièmes de Pâques, Ascension et Pentecôte
q = 0
FOR m = 1 TO 12
FOR j = 1 TO lm(m)
q = q + 1: ' quantième dans l'année
GOSUB Jours: a$ = js$(d)+RIGHT$(" "+STR$(j),3)
GOSUB FF
GOSUB FM: IF c$ <> "" THEN a$ = a$ + " " + c$
GRID_WRITE 1,j+1,m+1,a$
NEXT j
NEXT m
ALPHA 2: LEFT 2, w0/2-24: FONT_SIZE 2, 12: FONT_BOLD 2: CAPTION 2, STR$(a)
END

Jours:
' jour de la semaine (d = 0 à 6, dimanche à samedi) en fonction de
' jour j, mois m et année a
d = a
IF m<3 THEN d = d-1
d = INT(23*m/9) + j + 4 + a + INT(d/4) - INT(d/100) + INT(d/400)
IF m >=3 THEN d = d-2
d = d - 7*INT(d/7)
RETURN

Bissex:
bi = 0
IF (FRAC(a/4) = 0 and FRAC(a/100) > 0) or FRAC(a/400) = 0
bi = 1: ' *** l'année a est bissextile
END_IF
RETURN

FF:
' fêtes fixes
c$ = ""
IF m = 1 AND j = 1 THEN c$ = "J.An"
IF m = 5
IF j = 1 THEN c$ = "F.Trav."
IF j = 8 THEN c$ = "Arm.1945"
END_IF
IF m = 7 AND j = 14 THEN c$ = "F.Nat."
IF m = 8 AND j = 15 THEN c$ = "ASSOMPT."
IF m = 11
IF j = 1 THEN c$ = "TOUSS."
IF j = 11 THEN c$ = "Arm.1918"
END_IF
IF m = 12 AND j = 25 THEN c$ = "NOEL"
RETURN

FM:
' fêtes mobiles
IF q = Qpa THEN c$ = "PAQUES"
IF q = (Qpa+1) THEN c$ = "L.Pâques"
IF q = Qas THEN c$ = "ASCENS."
IF q = Qpe THEN c$ = "PENTEC."
IF q = (Qpe+1) THEN c$ = "L.Pentec."
RETURN

Qpap:
' Quantièmes de Pâques, Ascension, Pentecôte en fonction de l'année a
a1 = a - 19*INT(a/19)
b1 = INT(a/100)
c1 = a - 100*INT(a/100)
d1 = INT(b1/4)
e1 = b1 - 4*INT(b1/4)
f1 = INT((b1 + 8) / 25)
g1 = INT((b1 - f1 + 1) / 3)
h1 = 19*a1 + b1 - d1 - g1 + 15
h1 = h1 - 30*INT(h1/30)
i1 = INT(c1/4)
k1 = c1 - 4*INT(c1/4)
l1 = 32 + 2*e1 + 2*i1 - h1 - k1
l1 = l1 - 7*INT(k1/7)
m1 = INT((a1 + 11*h1 + 22*l1) / 451)
Qpa = h1 + l1 - 7*m1 + 81 + bi
Qas = Qpa + 39: Qpe = Qpa + 49
RETURN

Si on veut un peu de couleur, on peut définir un picture par jour au lieu du Grid (le reste du programme étant en gros le même):

Code:: DIM i%, k%, w0, h0, np, wp, hp, tp, lp, a$, x, y, r, g, b
DIM pic(12,31), lm(12), ms$(12), js$(6)
DIM j, m, a, d, bi, c$, q, Qpa, Qas, Qpe, a1, b1, c1, d1, e1, f1, g1, h1, i1, k1, l1, m1
LABEL Jours, Bissex, FF, FM, Qpap, Colorcel
DATA "JANVIER","FÉVRIER","MARS","AVRIL","MAI","JUIN","JUILLET","AOUT"
DATA "SEPTEMBRE","OCTOBRE","NOVEMBRE","DÉCEMBRE"
DATA "D","L","M","M","J","V","S"
lm(1)=31: lm(2)=28:lm(3)=31:lm(4)=30:lm(5)=31:lm(6)=30:lm(7)=31:lm(8)=31
lm(9)=30:lm(10)=31:lm(11)=30:lm(12)=31
FOR i% = 1 TO 12: READ ms$(i%): NEXT i%
FOR i% = 0 TO 6: READ js$(i%): NEXT i%

w0 = 900: h0 = 600
WIDTH 0, w0: HEIGHT 0, h0: COLOR 0, 128,255,255
wp = (w0-20)/12: hp = (h0-50)/32
tp = 5: lp = 2

a = 2011: ' <<<<<<<<<<<<<< ANNÉE <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
GOSUB Bissex: IF bi = 1 THEN lm(2) = 29
CAPTION 0, "CALENDRIER " + STR$(a)

np = 9: q = 0
FOR m = 1 TO 12
FOR j = 0 TO lm(m)
np = np + 1: IF j > 0 THEN q = q + 1
pic(m, j) = np
PICTURE np
TOP np, tp + j*hp: LEFT np, lp + (m-1)*wp
WIDTH np, wp
HEIGHT np, hp
2D_TARGET_IS np: IF j = 0 THEN COLOR np, 255,255,0
2D_RECTANGLE 0,0,wp-1,hp-1
PRINT_TARGET_IS np: PRINT_LOCATE 5, 2
IF j = 0
FONT_COLOR np, 0,0,255: FONT_BOLD np: PRINT ms$(m)
r = 255: g = 220: b = 220: GOSUB Colorcel
ELSE
GOSUB Jours
a$ = js$(d) + RIGHT$(" "+STR$(j), 3)
GOSUB FF: GOSUB FM
IF d = 0 OR c$ <> "" THEN FONT_COLOR np, 255,0,0: ' FONT_BOLD np
IF c$ <> "" THEN a$ = a$ + " " + c$
PRINT a$
IF d = 0 THEN r = 255: g = 255: b = 0: GOSUB Colorcel
END_IF
NEXT j
NEXT m
END

Jours:
' jour de la semaine (d = 0 à 6, dimanche à samedi) en fonction de
' jour j, mois m et année a
d = a
IF m<3 THEN d = d-1
d = INT(23*m/9) + j + 4 + a + INT(d/4) - INT(d/100) + INT(d/400)
IF m >=3 THEN d = d-2
d = d - 7*INT(d/7)
RETURN

Bissex:
bi = 0
IF (FRAC(a/4) = 0 and FRAC(a/100) > 0) or FRAC(a/400) = 0
bi = 1: ' *** l'année a est bissextile
END_IF
RETURN

FF:
' fêtes fixes
c$ = ""
IF m = 1 AND j = 1 THEN c$ = "J.l'An"
IF m = 5
IF j = 1 THEN c$ = "F.Trav."
IF j = 8 THEN c$ = "Arm.1945"
END_IF
IF m = 7 AND j = 14 THEN c$ = "F.Nat."
IF m = 8 AND j = 15 THEN c$ = "ASSOMPT."
IF m = 11
IF j = 1 THEN c$ = "TOUSS."
IF j = 11 THEN c$ = "Arm.1918"
END_IF
IF m = 12 AND j = 25 THEN c$ = "NOEL"
RETURN

FM:
' fêtes mobiles
IF q = Qpa THEN c$ = "PAQUES"
IF q = (Qpa+1) THEN c$ = "L.Pâques"
IF q = Qas THEN c$ = "ASCENS."
IF q = Qpe THEN c$ = "PENTEC."
IF q = (Qpe+1) THEN c$ = "L.Pentec."
RETURN

Qpap:
' Quantièmes de Pâques, Ascension, Pentecôte en fonction de l'année a
a1 = a - 19*INT(a/19)
b1 = INT(a/100)
c1 = a - 100*INT(a/100)
d1 = INT(b1/4)
e1 = b1 - 4*INT(b1/4)
f1 = INT((b1 + 8) / 25)
g1 = INT((b1 - f1 + 1) / 3)
h1 = 19*a1 + b1 - d1 - g1 + 15
h1 = h1 - 30*INT(h1/30)
i1 = INT(c1/4)
k1 = c1 - 4*INT(c1/4)
l1 = 32 + 2*e1 + 2*i1 - h1 - k1
l1 = l1 - 7*INT(k1/7)
m1 = INT((a1 + 11*h1 + 22*l1) / 451)
Qpa = h1 + l1 - 7*m1 + 81 + bi
Qas = Qpa + 39: Qpe = Qpa + 49
RETURN

Colorcel:
k% = pic(m, j): 2D_TARGET_IS k%: 2D_PEN_COLOR r,g,b
FOR y = 1 TO hp-2
FOR x = 1 TO wp-2
i% = COLOR_PIXEL_RED(k%,x,y)+COLOR_PIXEL_GREEN(k%,x,y)+COLOR_PIXEL_BLUE(k%,x,y)
IF i% = 765 THEN 2D_POINT x,y
NEXT x
NEXT y
RETURN

Qpap :en plus propre... Wink

Code:: Qpap:
' Quantièmes de Pâques, Ascension, Pentecôte en fonction de l'année a
a1 = a- 19*int(a/19)
b1 = INT(a/100)
c1= a - 100*int(a/100)
d1 = INT(b1/4)
e1 = b1 - 4*int(b1/4)
f1 = INT((b1 + 8) / 25)
g1 = INT((b1 - f1 + 1) / 3)
h1 = 19 * a1 + b1 - d1 - g1 + 15
h1 = h1 - 30*int(h1/30)
i1 = INT(c1/4)
k1 = c1 - 4*int(c1/4)
l1 = 32+2 * e1+2 * i1 - h1 - k1
l1 = l1 - 7*int(k1/7)
m1 = INT((a1 + 11 * h1 + 22 * l1) / 451)
Qpa = h1 + l1 - 7 * m1 + 81 + bi
Qas = Qpa + 39: Qpe = Qpa + 49
RETURN

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Exact, c'est plus propre et je prends.

L'utilisation de FRAC n'est pas du tout intéressante dans ce cas.

Du coup, j'ai corrigé ci-dessus (en plus il y avait un petit bug dans la deuxième version Embarassed

)

En plus tu pex te servir de tes objets comme lien ou bouton

J"ai beau chercher sur le net mais je n'ai rien trouvé de plus efficace que le truc infâme que tu utilises pour la détermination de la Pâques. Ça bouffe une flopée de variables !

C'est franchement tordu cette histoire de lune "ecclésiastique", le calcul de l'épacte,etc !...
cf ce lien pour des explications détaillées

Nombre de messages : 2706 Date d'inscription : 13/09/2009

J'avais utilisé une formule pour calculer Pâques
dans le calendrier perpétuel que j'avais publié dans :
https://panoramic.1fr1.net/t503-calendrier-perpetuel?highlight=perp%E9tuel
Elle n'est pas vraiment simple, mais il n'existe pas plus simple
et elle marche.
Laughing

Bonjour jjn4 !

J'ai regardé ta formule, c'est la même que celle employé par JL35 (Variante de la méthode Zeller si je ne me trompe pas....)
scratch

Ce que je recherche, c'est une version "optimisée" de ce calcul.
Apparement il n'y a pas de version "light", vu toutes les conditions à remplir...

geek

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Non, apparemment, malgré l'aspect plutôt tarabiscoté de la formule il n'y a rien de plus simple, je suis déjà émerveillé que ça ça marche ! il faut avoir l'esprit drôlement tordu pour conçevoir ça !
Je me souviens d'avoir entendu parler de 2 années (seulement) où le calcul ne collait pas, mais je ne suis pas sûr que ce soit avec cette formule-ci.

Ca coûte cher en variables, mais elles sont en solde en ce moment...

Nombre de messages : 2706 Date d'inscription : 13/09/2009

Avec cette formule-là, ça marche à tous les coups
et ça m'étonnerait qu'il y en ait de plus simple
(parce que pour tenir compte à la fois de le course du soleil
et de celle de la lune, ça peut difficilement être simple)
Laughing

» Un peu de couleur vite fait
» Un petit calendrier
» Un petit calendrier à feuilleter
» Encore un petit calendrier
» Un petit calendrier avec quelques Subs