Un petit calendrier avec quelques Subs

LABEL Chan, Edannee, Majart, Supart, Clickcel, Clickbut, Retclic, Calendrier, Edf
DIM gr%, dl%, wg%, hg%, wc%, hr%, wf%, rf%, i%, j%, ms$(12), js$(7), lm%(12)
DIM a$, b$, c%, r%, Annee, Mois, Jour, x%, y%, feve$, aa, mm, jj, v, vg
DIM an$, mo$, jo$, ev$, mk$, xdl%

DATA "JANVIER","FÉVRIER","MARS","AVRIL","MAI","JUIN"
DATA "JUILLET","AOÛT","SEPTEMBRE","OCTOBRE","NOVEMBRE","DÉCEMBRE"
DATA "Dimanche","Lundi","Mardi","Mercredi","Jeudi","Vendredi","Samedi"
DATA 31,28,31,30,31,30,31,31,30,31,30,31
FOR i% = 1 TO 12: READ ms$(i%): NEXT i%
FOR i% = 0 TO 6: READ js$(i%): NEXT i%
FOR i% = 1 TO 12: READ lm%(i%): NEXT i%

' ================= CHEMIN SUIVANT A ADAPTER (Jean Claude...) ==================
feve$ = "C:\TEXTES\EvntAAAA.txt": ' fichier des événements (1 fichier par année)
' Articles de la forme #AAAAMMJJ[espace]...texte de l'événement...
' ==============================================================================

mk$ = CHR$(8): ' marqueur d'événements

wc% = 90: wf% = 22: ' largeur colonnes + colonne fixe
hr% = 22: rf% = 20: ' hauteur rangées + rangée fixe
wg% = wf% + 12*wc%+28
hg% = rf% + 31*hr%+66
WHILE hg% > (SCREEN_Y-75): hr% = hr%-1: hg% = rf%+31*hr%+66: END_WHILE

gr% = 1
GRID gr%: WIDTH gr%,wg%: HEIGHT gr%,hg%-31
WIDTH 0,WIDTH(gr%)+16: HEIGHT 0,HEIGHT(gr%)+64: BORDER_SMALL 0: COLOR 0,128,255,255
COLOR gr%,255,255,194
GRID_COLUMN gr%,13: ' total colonnes
GRID_ROW gr%,32: ' total rangées
GRID_COLUMN_WIDTH gr%,wc%: GRID_ONE_COLUMN_WIDTH gr%,1,wf%
GRID_ROW_HEIGHT gr%,hr%: GRID_ONE_ROW_HEIGHT gr%,1,rf%
GRID_FIXED_COLOR gr%,255,255,128
FONT_NAME gr%,"Consolas": FONT_SIZE gr%,11
ON_CLICK gr%, Clickcel
BUTTON 2: TOP 2,HEIGHT(0)-59: LEFT 2,WIDTH(1)/2-160: WIDTH 2,140: HEIGHT 2,20
CAPTION 2,"<- Année précédente": FONT_BOLD 2
BUTTON 3: TOP 3,TOP(2): LEFT 3,LEFT(2)+WIDTH(2)+70: WIDTH 3,140: HEIGHT 3,HEIGHT(2)
CAPTION 3,"Année suivante ->" : FONT_BOLD 3
ON_CLICK 2, Chan: ON_CLICK 3, Chan
EDIT 4: TOP 4,TOP(2)-4: LEFT 4,LEFT(2)+WIDTH(2): WIDTH 4,48: COLOR 4,255,255,128
FONT_BOLD 4: FONT_SIZE 4,12: FONT_COLOR 4,160,0,0
BUTTON 5: TOP 5,TOP(2): LEFT 5,LEFT(4)+WIDTH(4)+1: WIDTH 5,20: HEIGHT 5,HEIGHT(2)
CAPTION 5, "OK": ON_CLICK 5, Edannee
FOR i% = 1 TO 31
    GRID_WRITE gr%,i%+1,1,STR$(i%)
NEXT i%
FOR i% = 1 TO 12
    a$ = ms$(i%): j% = (10-LEN(a$))/2
    IF LEN(a$)<9 THEN a$ = STRING$(j%," ") + a$
    GRID_WRITE gr%,1,i%+1,a$
NEXT i%
PRINT_LOCATE 10,TOP(2): PRINT "Clic une cellule pour lire ou ajouter un événement"

FORM 10:BORDER_HIDE 10: HIDE 10: TOP 10,50: LEFT 10,50
TO_FOREGROUND 10: FONT_BOLD 10: COLOR 10,180,255,180
ALPHA 11: PARENT 11,10: TOP 11,3: LEFT 11,50: CAPTION 11,"Journée du:"
MEMO 12: PARENT 12,10: TOP 12,20: LEFT 12,5: WIDTH 12,WIDTH(10)-10
HEIGHT 12,HEIGHT(10)-60
BUTTON 13: PARENT 13,10: TOP 13,TOP(12)+HEIGHT(12)+8: LEFT 13,160
CAPTION 13,"Enregistrer": ON_CLICK 13, Clickbut
BUTTON 14: PARENT 14,10: TOP 14,TOP(13): LEFT 14,LEFT(13)+80
CAPTION 14,"Quitter": ON_CLICK 14, Clickbut
BUTTON 15: PARENT 15,10: TOP 15,TOP(13): LEFT 15,lEFT(13)-80
CAPTION 15,"Supprimer": ON_CLICK 15, Clickbut
BUTTON 16: PARENT 16,10: TOP 16,TOP(13)+5: LEFT 16,5: HEIGHT 16,18
WIDTH 16,60: CAPTION 16,"Edit Fichier": FONT_BOLD_OFF 16: ON_CLICK 16, Edf

dl% = 20: DLIST dl%

Annee = VAL(RIGHT$(DATE$,4)): ' année courante
TEXT 4, STR$(Annee)
GOSUB Calendrier
END
' ==============================================================================
Chan:
IF CLICKED(2) = 1
    Annee = Annee - 1
ELSE
    Annee = Annee + 1
END_IF
TEXT 4, STR$(Annee)
GOSUB Calendrier
RETURN
' ------------------------------------------------------------------------------
Edannee:
i% = VAL(TEXT$(4))
IF i%<1700 OR i%>2900 THEN RETURN
Annee = i%
GOSUB Calendrier
RETURN
' ------------------------------------------------------------------------------
Majart:
' enregistrer l'article modifié ou nouveau
an$ = STR$(Annee): mo$ = RIGHT$("0"+STR$(Mois),2)
jo$ = RIGHT$("0"+STR$(Jour),2): ev$ = "#" + an$ + mo$ + jo$
v = VAL(MID$(ev$,2,8)): j% = 0
IF COUNT(dl%) > 0
    FOR i% = 1 TO COUNT(dl%)
        a$ = ITEM_READ$(dl%, i%)
        IF LEFT$(a$, 1) = "#" AND LEN(a$) > 8
            vg = VAL(MID$(a$,2,8))
            IF vg = v OR vg > v
                IF vg = v
                    ' article déjà existant, supprimer puis remplacere
                    xdl% = i%: GOSUB Supart
                END_IF
                a$ = ITEM_READ$(12,1)
                IF LEFT$(a$,1) = "#" THEN a$ = LTRIM$(MID$(a$,10,500))
                ITEM_INSERT dl%, i%, ev$ + " " + a$: j% = 1
                IF COUNT(12) > 1
                    FOR j% = 2 TO COUNT(12)
                        i% = i% + 1
                        ITEM_INSERT dl%, i%, ITEM_READ$(12, j%)
                    NEXT j%
                END_IF
                EXIT_FOR
            END_IF
        END_IF
    NEXT i%
END_IF
IF j% = 0
    IF ITEM_READ$(12,COUNT(12)) = "" THEN ITEM_DELETE 12,COUNT(12)
    ITEM_ADD dl%, ev$ + " " + ITEM_READ$(12, 1)
    IF COUNT(12) > 1
        FOR j% = 2 TO COUNT(12)
            ITEM_ADD dl%, ITEM_READ$(12, j%)
        NEXT j%
    END_IF
END_IF
FILE_SAVE dl%, feve$: ' enregistrer
RETURN
' ------------------------------------------------------------------------------
Supart:
' Supprimer l'article événement affiché
IF COUNT(12) = 0 THEN RETURN: ' pas d'article affiché, on ne fait rien
ITEM_DELETE dl%, xdl%: ' suppression de l'article (1ère ligne)
WHILE xdl%<=COUNT(dl%)
    IF LEFT$(ITEM_READ$(dl%, xdl%), 1) = "#" THEN EXIT_WHILE: ' article suivant
    ITEM_DELETE dl%, xdl%: ' suppression ligne suivante de l'article
END_WHILE
IF COUNT(dl%) = 0
    IF FILE_EXISTS(feve$) = 1 THEN FILE_DELETE feve$
ELSE
    FILE_SAVE dl%, feve$: ' mise à jour du fichier correspondant
END_IF
RETURN
' ------------------------------------------------------------------------------
Clickcel:
x% = MOUSE_X_POSITION(gr%): y% = MOUSE_Y_POSITION(gr%)
c% = GRID_X_TO_COLUMN(gr%,x%): r% = GRID_Y_TO_ROW(gr%,y%)
Mois = c%-1: Jour = r%-1
CAPTION 11,"Journée du " + STR$(Jour)+ " " + ms$(Mois) + " " +STR$(Annee)
CLEAR 12
IF FILE_EXISTS(feve$) = 1
    FOR i% = 1 TO COUNT(dl%)
        a$ = ITEM_READ$(dl%, i%)
        IF LEFT$(a$,1) = "#" AND LEN(a$) > 8
            ' la date est de la forme #aaaammjj
            aa = VAL(MID$(a$,2,4)): mm = VAL(MID$(a$,6,2)): jj = VAL(MID$(a$,8,2))
            IF aa > Annee THEN EXIT_FOR
            IF aa = Annee AND mm = Mois AND jj = Jour
                ITEM_ADD 12, LTRIM$(MID$(a$,10,500))
                xdl% = i%: ' index de l'article affiché
                i% = i% + 1
                WHILE i% <= COUNT(dl%)
                    a$ = ITEM_READ$(dl%, i%)
                    IF LEFT$(a$, 1) = "#" THEN EXIT_WHILE: ' article suivant
                    ITEM_ADD 12, a$
                    i% = i% + 1
                END_WHILE
                EXIT_FOR
            END_IF
        END_IF
    NEXT i%
END_IF
SHOW 10: TO_FOREGROUND 10
RETURN
' ------------------------------------------------------------------------------
Clickbut:
IF CLICKED(14) = 1 THEN GOTO Retclic: ' quitter sans rien faire
IF CLICKED(15) = 1
    GOSUB Supart: ' supprimer l'article actuellement affiché
    GOSUB Calendrier: ' réaffichage du calendrier
ELSE
    IF COUNT(12) > 0
        ' Enregistrer (modifs ou nouveau)
        GOSUB Majart
        GOSUB Calendrier
    END_IF
END_IF
Retclic:
HIDE 10
RETURN
' ------------------------------------------------------------------------------
Edf:
EXECUTE_WAIT "Notepad.exe " + feve$
RETURN
' ------------------------------------------------------------------------------
Calendrier:
CAPTION 0, " -  ANNÉE  " + STR$(Annee) + "  -"
lm%(2) = 28: Bisex(Annee): IF rs_bi% = 1 THEN lm%(2) = 29
' Lecture du fichier 'Evénement' de l'année
feve$ = LEFT$(feve$,LEN(feve$)-8)+STR$(Annee)+".txt"
CLEAR dl%
IF FILE_EXISTS(feve$) = 1
    FILEBIN_OPEN_READ 1, feve$: i% = FILEBIN_SIZE(1): FILEBIN_CLOSE 1
    IF i% < 10
        FILE_DELETE feve$: ' fichier vide, on le supprime
    ELSE
        FILE_LOAD dl%, feve$
    END_IF
END_IF
QPaques(Annee): ' quantièmes de Pâques Ascension Pentecôte rs_qpa, rs_qas, rs_qpe
FOR Mois = 1 TO 12
    c% = Mois+1: ' colonne d'affichage
    FOR Jour = 1 TO lm%(Mois)
        an$ = STR$(Annee): mo$ = RIGHT$("0"+STR$(Mois),2)
        jo$ = RIGHT$("0"+STR$(Jour),2): ev$ = "#" + an$ + mo$ + jo$
        Jmq(Annee,Mois,Jour): ' rs_qa% = quantième du jour
        b$ = ""
        IF rs_qa% = 1 THEN b$ = "J.l'AN"
        IF Mois = 5 AND Jour = 1 THEN b$ = "F.Travail"
        IF Mois = 5 AND Jour = 8 THEN b$ = "V.1945"
        IF Mois = 7 AND Jour = 14 THEN b$ = "F.Nat."
        IF Mois = 8 AND Jour = 15 THEN b$ = "Assompt."
        IF Mois = 11 AND Jour = 1 THEN b$ = "Toussaint"
        IF Mois = 11 AND Jour = 11 THEN b$ = "Ar1918"
        IF Mois = 12 AND Jour = 25 THEN b$ = "NOEL"
        IF rs_qa% = rs_qpa THEN b$ = "Pâques"
        IF rs_qa% = rs_qas THEN b$ = "Ascens."
        IF rs_qa% = rs_qpe THEN b$ = "Pentec."
        IF COUNT(dl%) > 0
            FOR i% = 1 TO COUNT(dl%)
                IF LEFT$(ITEM_READ$(dl%,i%), LEN(ev$)) = ev$
                    b$ = mk$ + " " + b$: EXIT_FOR
                END_IF
            NEXT i%
        END_IF
        JourSem(Annee,Mois,Jour)
        a$ = LEFT$(js$(rs_js%), 2)
        IF rs_js% = 0 THEN a$ = "DIM"
        IF b$ <> "" THEN a$ = a$ + " " + b$
        IF rs_js% = 0 THEN a$=a$+"_______"
        GRID_WRITE 1,Jour+1,c%,a$
    NEXT Jour
    DISPLAY
NEXT Mois
an$ = STR$(Annee): mo$ = RIGHT$("0"+STR$(Mois),2)
jo$ = RIGHT$("0"+STR$(Mois),2): b$ = an$ + mo$ + jo$
RETURN
' ------------------------------------------------------------------------------
SUB QPaques(Annee)
' Quantièmes de Pâques, Ascension, Pentecôte en fonction de Annee
' Résultats dans rs_qpa, rs_qas, rs_qpe
DIM_LOCAL qp_a,qp_b,qp_c,qp_d,qp_e,qp_f,qp_g,qp_h,qp_i,qp_k,qp_l,qp_m
DIM_LOCAL qp_bi,qp_ci,qp_cj
IF VARIABLE("rs_qpa") = 0 THEN DIM rs_qpa
IF VARIABLE("rs_qas") = 0 THEN DIM rs_qas
IF VARIABLE("rs_qpe") = 0 THEN DIM rs_qpe
qp_a = 19*FRAC(Annee/19)
qp_b = INT(Annee/100)
qp_c = 100*FRAC(Annee/100)
qp_ci = 4*FRAC(Annee/4)
qp_cj = 400*FRAC(Annee/400)
qp_bi = 0: IF qp_ci = 0 AND (qp_c <> 0 OR qp_cj = 0) THEN qp_bi = 1
qp_d = INT(qp_b/4)
qp_e = 4*FRAC(qp_b/4)
qp_f = INT((qp_b + 8) / 25)
qp_g = INT((qp_b - qp_f + 1) / 3)
qp_h = 30*FRAC((19 * qp_a + qp_b - qp_d - qp_g + 15)/30)
qp_i = INT(qp_c/4)
qp_k = 4*FRAC(qp_c/4)
qp_l = 7*FRAC((32 + 2 * qp_e + 2 * qp_i - qp_h - qp_k)/7)
qp_m = INT((qp_a + 11 * qp_h + 22 * qp_l) / 451)
rs_qpa = qp_h + qp_l - 7 * qp_m + 81 + qp_bi
rs_qpa = INT(rs_qpa + .1)
rs_qas = rs_qpa + 39: rs_qpe = rs_qpa + 49
END_SUB
' ------------------------------------------------------------------------------
SUB JourSem(Annee,Mois,Jour)
' Jour de la semaine d'une date donnée (0= Dimanche à 6= Samedi) -> rs_js%
DIM_LOCAL js_d
IF VARIABLE("rs_js%") = 0 THEN DIM rs_js%
js_d = Annee
IF Mois<3 THEN js_d = js_d-1
js_d=INT(23*Mois/9)+Jour+4+Annee+INT(js_d/4)-INT(js_d/100)+INT(js_d/400)
IF Mois>=3 THEN js_d = js_d-2
rs_js% = js_d-7*INT(js_d/7)
END_SUB
' ------------------------------------------------------------------------------
SUB Jmq(Annee,Mois,Jour)
' Quantième de l'année en fonction de Annee, Mois, Jour -> rs_qa%
DIM_LOCAL Jm_Q, Jm_m
IF VARIABLE("rs_qa%") = 0 THEN DIM rs_qa%
Jm_Q = 0
IF Mois > 1
    FOR Jm_m = 1 TO Mois - 1
        SELECT Jm_m
            CASE 1: Jm_Q = Jm_Q+31
            CASE 2: Jm_Q = Jm_Q+28
IF (FRAC(Annee/4)=0 AND FRAC(Annee/100)>0) OR FRAC(Annee/400)=0 THEN Jm_Q=Jm_Q+1
            CASE 3: Jm_Q = Jm_Q+31
            CASE 4: Jm_Q = Jm_Q+30
            CASE 5: Jm_Q = Jm_Q+31
            CASE 6: Jm_Q = Jm_Q+30
            CASE 7: Jm_Q = Jm_Q+31
            CASE 8: Jm_Q = Jm_Q+31
            CASE 9: Jm_Q = Jm_Q+30
            CASE 10: Jm_Q = Jm_Q+31
            CASE 11: Jm_Q = Jm_Q+30
        END_SELECT
    NEXT Jm_m
END_IF
rs_qa% = Jm_Q+Jour
END_SUB
' ------------------------------------------------------------------------------
SUB Bisex(Annee)
IF VARIABLE("rs_bi%") = 0 THEN DIM rs_bi%
rs_bi% = 0
IF (FRAC(Annee/4)=0 AND FRAC(Annee/100)>0) OR FRAC(Annee/400)=0 THEN rs_bi% = 1
END_SUB
' ------------------------------------------------------------------------------

rs_qpa = qp_h + qp_l - 7 * qp_m + 81 + qp_bi
rs_qpa = INT(rs_qpa + .1)

LABEL Descal, Recev, Clican, Cliccel, Clicbut, Edf, FF, FM
DIM w0, h0, wu, hu, i%, j%, at$, c$, w1, wn, hn, ms$(12), lm(12), js$(7)
DIM Annee, Mois, Jour, v
DIM q, feve$, fete$, dl%, gr%, col%, ran%, mk$, x%, y%

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

feve$ = "C:\TEXTES\EvntAAAA.txt": ' fichiers 'événements'
fete$ = "C:\TEXTES\Fetes.txt": ' liste des fêtes du jour

mk$ = CHR$(8)

w0 = 900: h0 = 600
w1 = 1: ' 1ère colonne (vide)
wu = w0-24-w1: hu = h0-55
wn = wu/12-2

wn = 70: wu = (wn+2)*13-60
hn = 15: hu = (hn+2)*32
w0 = wu+20: h0 = hu + 54

WIDTH 0, w0: HEIGHT 0, h0-20: BORDER_SMALL 0: CAPTION 0,""
COLOR 0,196,255,255
gr% = 1
GRID gr%: TOP gr%, 20: LEFT gr%, 3: WIDTH gr%, wu: HEIGHT gr%, hu-20
FONT_NAME gr%,"Arial": FONT_SIZE gr%, 8: FONT_BOLD gr%: ON_CLICK gr%, Cliccel
GRID_COLUMN gr%, 13
GRID_ROW gr%, 32
GRID_COLUMN_WIDTH gr%, wn
GRID_ROW_HEIGHT gr%, hu/32-2
GRID_ONE_COLUMN_WIDTH gr%, 1,w1
COLOR gr%,255,255,190
GRID_FIXED_COLOR gr%,255,255,160
FOR i% = 1 TO 31: GRID_WRITE gr%, i%+1,1,STR$(i%): NEXT i%
FOR i% = 1 TO 12: READ ms$(i%): GRID_WRITE gr%, 1,i%+1,ms$(i%): NEXT i%
FOR i% = 0 TO 6: READ js$(i%): NEXT i%
EDIT 2: TOP 2,-8: LEFT 2, w0/2-51: WIDTH 2,60: FONT_SIZE 2, 14: FONT_BOLD 2
FONT_COLOR 2,255,64,64: COLOR 2,255,255,255
BUTTON 3: LEFT 3,w0/2-90: WIDTH 3,40: HEIGHT 3,20: CAPTION 3,CHR$(223)
BUTTON 4: LEFT 4,w0/2+ 30: WIDTH 4,40: HEIGHT 4,20: CAPTION 4,CHR$(224)
BUTTON 5: LEFT 5,LEFT(2)+WIDTH(2): WIDTH 5,20: HEIGHT 5,20: CAPTION 5,"OK"
FOR i% = 3 TO 4
    FONT_NAME i%,"Wingdings": FONT_SIZE i%,10: FONT_BOLD i%: ON_CLICK i%, Clican
NEXT i%
ON_CLICK 5, Clican

FORM 10:BORDER_HIDE 10: HIDE 10: TOP 10,70: LEFT 10,40
TO_FOREGROUND 10: FONT_BOLD 10: COLOR 10,180,255,180
' ALPHA 11: PARENT 11,10: TOP 11,3: LEFT 11,50: CAPTION 11,"Journée du:"
PICTURE 11: PARENT 11,10: TOP 11,3: LEFT 11,5: WIDTH 11,WIDTH(10)-10
HEIGHT 11,32: COLOR 11,255,220,220: FONT_BOLD 11
MEMO 12: PARENT 12,10: TOP 12,40: LEFT 12,5: WIDTH 12,WIDTH(10)-10
HEIGHT 12,HEIGHT(10)-80
BUTTON 13: PARENT 13,10: TOP 13,TOP(12)+HEIGHT(12)+8: LEFT 13,160
CAPTION 13,"Enregistrer"
BUTTON 14: PARENT 14,10: TOP 14,TOP(13): LEFT 14,LEFT(13)+80
CAPTION 14,"Quitter"
BUTTON 15: PARENT 15,10: TOP 15,TOP(13): LEFT 15,lEFT(13)-80
CAPTION 15,"Supprimer"
FOR i% = 13 TO 15: ON_CLICK i%, Clicbut: NEXT i%
BUTTON 16: PARENT 16,10: TOP 16,TOP(13)+5: LEFT 16,5: HEIGHT 16,18
WIDTH 16,60: CAPTION 16,"Edit Fichier": FONT_BOLD_OFF 16: ON_CLICK 16, Edf

dl% = 20: DLIST dl%

Annee = VAL(RIGHT$(DATE$,4)): ' Année courante
GOSUB Descal
END
' ==============================================================================
Descal:
TEXT 2," "+STR$(Annee)
lm(2) = 28: Bisex(Annee): IF rs_bi% = 1 THEN lm(2)=29: ' si année bissextile
QPaques(Annee): ' quantièmes de Pâques, Ascension et Pentecôte
q = 0
FOR Mois = 1 TO 12
    FOR Jour = 1 TO lm(Mois)
        q = q + 1: ' quantième dans l'année
        Joursem(Annee,mois,Jour)
        at$ = js$(rs_js%)+RIGHT$("  "+STR$(Jour),3)
        GOSUB FF
        GOSUB FM: IF c$ <> "" THEN at$ = at$ + " " + c$
        IF rs_js% = 0 THEN at$ = at$ + " "+STRING$(8,CHR$(151))
        GRID_WRITE gr%,Jour+1,Mois+1,at$
    NEXT Jour
NEXT Mois
GOSUB Recev
CAPTION 0, " - CALENDRIER " + STR$(Annee) + " -"
RETURN
' ------------------------------------------------------------------------------
Recev:
' recherche des événements
feve$ = LEFT$(feve$,LEN(feve$)-8)+STR$(Annee)+".txt"
IF FILE_EXISTS(feve$) = 0 THEN RETURN
FILEBIN_OPEN_READ 1, feve$: i% = FILEBIN_SIZE(1): FILEBIN_CLOSE 1
IF i% < 10 THEN FILE_DELETE feve$: RETURN: ' fichier vide, supprimé
FILE_LOAD dl%, feve$
FOR i% = 1 TO COUNT(dl%)
    at$ = ITEM_READ$(dl%, i%)
    IF LEFT$(at$, 1) = "#"
        Mois = VAL(MID$(at$, 6,2)): Jour = VAL(MID$(at$,8,2))
        at$ = GRID_READ$(1, Jour+1, Mois+1)
        IF LEN(at$) > 4
            at$ = LEFT$(at$,4)+" " + mk$+MID$(at$,5,100)
        ELSE
            at$ = at$ + " " + mk$
        END_IF
        GRID_WRITE gr%,Jour+1,Mois+1,at$
    END_IF
NEXT i%
RETURN
' ------------------------------------------------------------------------------
Clican:
IF CLICKED(3) = 1
    Annee = Annee - 1
ELSE
    IF CLICKED(4) = 1
        Annee = Annee + 1
    ELSE
        at$ = TEXT$(2)
        IF NUMERIC(at$)=0 THEN TEXT 2, " "+STR$(Annee): RETURN
        v = VAL(at$)
        IF v<1700 OR v>2100 THEN TEXT 2, " "+STR$(Annee): RETURN
        Annee = v
    END_IF
END_IF
GOSUB Descal
RETURN
' ------------------------------------------------------------------------------
Cliccel:
x% = MOUSE_X_POSITION(gr%): y% = MOUSE_Y_POSITION(gr%)
col% = GRID_X_TO_COLUMN(gr%,x%): ran% = GRID_Y_TO_ROW(gr%,y%)
Mois = col%-1: Jour = ran%-1
c$ = "#"+STR$(Annee)+RIGHT$("0"+STR$(Mois),2)+RIGHT$("0"+STR$(Jour),2)
PRINT_TARGET_IS 11: 2D_TARGET_IS 11: CLS
at$ = "Journée du " + STR$(Jour)+ " " + ms$(Mois) + " " +STR$(Annee)
i% = (WIDTH(11)-TEXT_WIDTH(at$,11))/2: PRINT_LOCATE i%,2: PRINT at$
IF FILE_EXISTS(fete$) = 1
    FILE_OPEN_READ 1, fete$
    WHILE FILE_EOF(1) = 0
        FILE_READLN 1, at$
        IF LEFT$(at$, 4) = RIGHT$(c$, 4)
            at$ = "Fête du jour: " + MID$(at$,6,100)
            i% = (WIDTH(11)-TEXT_WIDTH(at$,11))/2: PRINT_LOCATE i%,18: PRINT at$
        END_IF
    END_WHILE
    FILE_CLOSE 1
END_IF
CLEAR 12
IF COUNT(dl%) > 0
    FOR i% = 1 TO COUNT(dl%)
        at$ = ITEM_READ$(dl%, i%)
        IF LEFT$(at$, 9) = c$
            ITEM_ADD 12, MID$(at$, 11, 500): i% = i% + 1
            WHILE i% <= COUNT(dl%)
                at$ = ITEM_READ$(dl%, i%): IF LEFT$(at$, 1) = "#" THEN EXIT_WHILE
                ITEM_ADD 12, at$: i% = i% + 1
            END_WHILE
            EXIT_FOR
        END_IF
    NEXT i%
END_IF
SHOW 10: TO_FOREGROUND 10
RETURN
' ------------------------------------------------------------------------------
Clicbut:
IF CLICKED(14) = 1
    ' quitter sans rien faire
ELSE

    IF COUNT(12) > 0
        IF CLICKED(13) = 1
            ' enregistrer l'événement courant
            v = VAL(MID$(c$, 2, 8)): j% = 0
            IF COUNT(dl%) > 0
                FOR i% = 1 TO COUNT(dl%)
                    at$ = ITEM_READ$(dl%,i%)
                    IF LEFT$(at$, 1) = "#"
                        IF VAL(MID$(at$, 2, 8)) > v
                            j% = 1
                            ITEM_INSERT dl%, i%, c$ + " " + ITEM_READ$(12, j%): j% = j% + 1
                            WHILE j% <= COUNT(12)
                                i% = i% + 1: ITEM_INSERT dl%, i%, ITEM_READ$(12, j%)
                                j% = j% + 1
                            END_WHILE
                          EXIT_FOR
                        END_IF
                    END_IF
                NEXT i%
            END_IF
            IF j% = 0
                j% = 1: ITEM_ADD dl%, c$ + " " + ITEM_READ$(12, j%): j% = j% + 1
                WHILE j% <= COUNT(12)
                    ITEM_INSERT dl%, i%, ITEM_READ$(12, j%): j% = j% + 1
                END_WHILE
            END_IF
        ELSE
            ' supprimer l'événement courant
            FOR i% = 1 TO COUNT(dl%)
                IF LEFT$(ITEM_READ$(dl%,i%), 9) = c$
                    ITEM_DELETE dl%, i%: i% = i% + 1
                    WHILE i% <= COUNT(dl%)
                        at$ = ITEM_READ$(dl%, i%)
                        IF LEFT$(at$, 1) = "#" THEN EXIT_WHILE
                        ITEM_DELETE dl%, i%: i% = i% + 1
                    END_WHILE
                    EXIT_FOR
                END_IF
            NEXT i%
        END_IF
        at$ = FILE_EXTRACT_PATH$(feve$)
        IF DIR_EXISTS(at$) = 0 THEN DIR_MAKE at$
        FILE_SAVE dl%, feve$: ' mise à jour du fichier
        GOSUB Descal: ' régénère l'affichage
    END_IF
END_IF
HIDE 10
RETURN
' ------------------------------------------------------------------------------
Edf:
EXECUTE_WAIT "Notepad.exe " + feve$
RETURN
' ------------------------------------------------------------------------------
FF:
' Fêtes fixes
c$ = ""
IF Mois = 1 AND Jour = 1 THEN c$ = "Jdel'An"
IF Mois = 5
    IF Jour = 1 THEN c$ = "F.Trav."
    IF Jour = 8 THEN c$ = "Arm.1945"
END_IF
IF Mois = 7 AND Jour = 14 THEN c$ = "F.Nat."
IF Mois = 8 AND Jour = 15 THEN c$ = "ASSOMPT."
IF Mois = 11
    IF Jour = 1 THEN c$ = "TOUSSAINT"
    IF Jour = 11 THEN c$ = "Arm.1918"
END_IF
IF Mois = 12 AND Jour = 25 THEN c$ = "NOEL"
RETURN
' ------------------------------------------------------------------------------
FM:
' Fêtes mobiles
IF q = rs_qpa THEN c$ = "PAQUES"
IF q = (rs_qpa+1) THEN c$ = "L.Pâques"
IF q = rs_qas THEN c$ = "ASCENS."
IF q = rs_qpe THEN c$ = "PENTEC."
IF q = (rs_qpe+1) THEN c$ = "L.Pentec."
RETURN
' ------------------------------------------------------------------------------
SUB JourSem(Annee,Mois,Jour)
' Jour de la semaine d'une date donnée (0= Dimanche à 6= Samedi) -> rs_js%
DIM_LOCAL js_d
IF VARIABLE("rs_js%") = 0 THEN DIM rs_js%
js_d = Annee
IF Mois<3 THEN js_d = js_d-1
js_d=INT(23*Mois/9)+Jour+4+Annee+INT(js_d/4)-INT(js_d/100)+INT(js_d/400)
IF Mois>=3 THEN js_d = js_d-2
rs_js% = js_d-7*INT(js_d/7)
END_SUB
' ------------------------------------------------------------------------------
SUB QPaques(Annee)
' Quantièmes de Pâques, Ascension, Pentecôte en fonction de Annee
' Résultats dans rs_qpa, rs_qas, rs_qpe
DIM_LOCAL qp_a,qp_b,qp_c,qp_d,qp_e,qp_f,qp_g,qp_h,qp_i,qp_k,qp_l,qp_m
DIM_LOCAL qp_bi,qp_ci,qp_cj
IF VARIABLE("rs_qpa") = 0 THEN DIM rs_qpa
IF VARIABLE("rs_qas") = 0 THEN DIM rs_qas
IF VARIABLE("rs_qpe") = 0 THEN DIM rs_qpe
qp_a = 19*FRAC(Annee/19)
qp_b = INT(Annee/100)
qp_c = 100*FRAC(Annee/100)
qp_ci = 4*FRAC(Annee/4)
qp_cj = 400*FRAC(Annee/400)
qp_bi = 0: IF qp_ci = 0 AND (qp_c <> 0 OR qp_cj = 0) THEN qp_bi = 1
qp_d = INT(qp_b/4)
qp_e = 4*FRAC(qp_b/4)
qp_f = INT((qp_b + 8) / 25)
qp_g = INT((qp_b - qp_f + 1) / 3)
qp_h = 30*FRAC((19 * qp_a + qp_b - qp_d - qp_g + 15)/30)
qp_i = INT(qp_c/4)
qp_k = 4*FRAC(qp_c/4)
qp_l = 7*FRAC((32 + 2 * qp_e + 2 * qp_i - qp_h - qp_k)/7)
qp_m = INT((qp_a + 11 * qp_h + 22 * qp_l) / 451)
rs_qpa = qp_h + qp_l - 7 * qp_m + 81 + qp_bi
rs_qpa = INT(rs_qpa + .1)
rs_qas = rs_qpa + 39: rs_qpe = rs_qpa + 49
END_SUB
' ------------------------------------------------------------------------------
SUB Bisex(Annee)
IF VARIABLE("rs_bi%") = 0 THEN DIM rs_bi%
rs_bi% = 0
IF (FRAC(Annee/4)=0 AND FRAC(Annee/100)>0) OR FRAC(Annee/400)=0 THEN rs_bi% = 1
END_SUB
' ------------------------------------------------------------------------------

0101,JOUR DE L'AN
0102,St Basile
0103,Ste Geneviève
0104,St Odilon
0105,St Edouard
0106,Ste Mélaine
0107,St Raymond
0108,St Lucien
0109,St Alix
0110,St Guillaume
0111,St Paulin
0112,Ste Tatiana
0113,Ste Yvette
0114,Ste Nina
0115,St Rémi
0116,St Marcel
0117,Ste Roseline
0118,Ste Prisca
0119,St Marius
0120,St Sébastien
0121,Ste Agnès
0122,St Vincent
0123,St Barnard
0124,St François de Sales
0125,St Apollos
0126,Ste Paule
0127,Ste Angèle
0128,St Thomas d'Aquin
0129,St Gildas
0130,Ste Martine
0131,Ste Marcelle
*
0201,Ste Ella
0202,Prés. Seigneur
0203,St Blaise
0204,Ste Véronique
0205,Ste Agathe
0206,St Gaston
0207,Ste Eugénie
0208,Ste Jacqueline
0209,Ste Apolline
0210,St Arnaud
0211,ND de Lourdes
0212,St Félix
0213,Ste Béatrice
0214,St Valentin
0215,St Claude
0216,Ste Julienne
0217,St Alexis
0218,Ste Bernadette
0219,St Gabin
0220,Ste Aimée
0221,St Damien
0222,Ste Isabelle
0223,St Lazare
0224,St Modeste
0225,St Roméo
0226,St Nestor
0227,Ste Honorine
0228,St Romain
0229,St Auguste
*
0301,St Aubin
0302,St Charles le Bon
0303,St Guénolé
0304,St Casimir
0305,Ste Olivia
0306,Ste Colette
0307,Ste Félicité
0308,St Jean de Dieu
0309,Ste Françoise
0310,St Vivien
0311,Ste Rosine
0312,Ste Justine
0313,St Rodrigue
0314,Ste Mathilde
0315,Ste Louise
0316,Ste Bénédicte
0317,St Patrice
0318,St Cyrille
0319,St Joseph
0320,PRINTEMPS
0321,Ste Clémence
0322,Ste Léa
0323,St Victorien
0324,Ste Catherine de Suède
0325,Annonciation
0326,Ste Larissa
0327,St Habib
0328,St Gontran
0329,Ste Gwladys
0330,St Amédée
0331,St Benjamin
*
0401,St Hugues
0402,Ste Sandrine
0403,St Richard
0404,St Isidore
0405,Ste Irène
0406,St Marcellin
0407,St Jean-Baptiste de la Salle
0408,Ste Julie
0409,St Gautier
0410,St Fulbert
0411,St Stanislas
0412,St Jules
0413,Ste Ida
0414,St Maxime
0415,St Paterne
0416,St Benoît-Joseph
0417,St Anicet
0418,St Parfait
0419,Ste Emma
0420,Ste Odette
0421,St Anselme
0422,St Alexandre
0423,St Georges
0424,St Fidèle
0425,St Marc
0426,Ste Alida
0427,Ste Zita
0428,Ste Valérie
0429,Ste Catherine de Sienne
0430,St Robert
*
0501,FETE DU TRAVAIL
0502,St Boris
0503,St Philippe/Jacques
0504,St Sylvain
0505,Ste Judith
0506,Ste Prudence
0507,Ste Gisèle
0508,VICTOIRE 1945
0509,Ste Pacôme
0510,Ste Solange
0511,Ste Estelle
0512,St Achille
0513,Ste Rolande
0514,St Mathias
0515,Ste Denise
0516,St Honoré
0517,St Pascal
0518,St Eric
0519,St Yves
0520,St Bernardin
0521,St Constantin
0522,St Emile
0523,St Didier
0524,St Donatien
0525,Ste Sophie
0526,St Bérenger
0527,St Augustin de C.
0528,St Germain
0529,St Aymar
0530,St Ferdinand
0531,Visitation
*
0601,St Justin
0602,Ste Blandine
0603,St Kévin
0604,Ste Clotilde
0605,St Boniface
0605,St Igor
0606,St Norbert
0607,St Gilbert
0608,St Médard
0609,Ste Diane
0610,St Landry
0611,St Barnabé
0612,St Guy
0613,St Antoine de Padoue
0614,St Elisée
0615,Ste Germaine
0616,St J.F. Régis
0617,St Hervé
0618,St Léonce
0619,St Romuald
0620,St Silvère
0621,ETE
0622,St Alban
0623,Ste Audrey
0624,St Jean-Baptiste
0625,St Salomon
0626,St Anthelme
0627,St Fernand
0628,St Irénée
0629,St Pierre et Paul
0630,St Martial
*
0701,St Thierry
0702,St Martinien
0703,St Thomas
0704,St Florent
0705,St Antoine
0706,Ste Mariette
0707,ST Raoul
0708,St Thibaut
0709,Ste Amandine
0710,St Ulrich
0711,St Benoît
0712,St Olivier
0713,St Henri Joël
0714,FETE NATIONALE
0715,St Donald
0716,ND du Mt Carmel
0717,Ste Charlotte
0718,St Frédéric
0719,St Arsène
0720,Ste Marina
0721,St Victor
0722,Ste Marie-Madeleine
0723,Ste Brigitte
0724,Ste Christine
0725,St Jacques
0726,Ste Anne
0727,Ste Nathalie
0728,St Samson
0729,Ste Marthe
0730,Ste Juliette
0731,St Ignace de Loyola
*
0801,St Alphonse
0802,St Julien-Eymard
0803,Ste Lydie
0804,St Jean-Marie Vianney
0805,St Abel
0806,Transfiguration
0807,St Gaétan
0808,St Dominique
0809,St Amour
0810,St Laurent
0811,Ste Claire
0812,Ste Clarisse
0813,St Hippolyte
0814,St Evrard
0815,ASSOMPTION
0816,St Armel
0817,St Hyacinthe
0818,Ste Hélène
0819,St Jean Eudes
0820,St Bernard
0821,St Christophe
0822,St Fabrice
0823,Ste Rose de lima
0824,St Barthélémy
0825,St Louis
0826,Ste Natacha
0827,Ste Monique
0828,St Augustin
0829,Ste Sabine
0830,St Fiacre
0831,St Aristide
*
0901,St Gilles
0902,Ste Ingrid
0903,Grégoire
0904,Ste Rosalie
0905,Ste Raïssa
0906,St Bertrand
0907,Ste Reine
0908,Nativité ND
0909,St Alain
0910,Ste Inès
0911,St Adelphe
0912,St Apollinaire
0913,St Aimé
0914,Ste Croix
0915,St Roland
0916,Ste Edith
0917,St Renaud
0918,Ste Nadège
0919,Ste Emilie
0920,St Davy
0921,St Matthieu
0922,AUTOMNE
0923,St Constant
0924,Ste Thècle
0925,St Hermann
0926,St Côme Damien
0927,St Vincent de Paul
0928,St Venceslas
0929,St Michel Gabriel
0930,St Jérôme
*
1001,Ste Thérèse E.J.
1002,St Léger
1003,St Gérard
1004,St François d'Assise
1005,Ste Fleur
1006,St Bruno
1007,St Serge
1008,Ste Pélagie
1009,St Denis
1010,St Ghislain
1011,St Firmin
1012,St Wilfried
1013,St Géraud
1014,St Juste
1015,Ste Thérèse d'Avila
1016,Ste Edwige
1017,St Baudouin
1018,St Luc
1019,St René
1020,Ste Adeline
1021,Ste Céline
1022,Ste Salomé
1023,St Jean de Capistran
1024,St Florentin
1025,St Enguerrand
1026,St Dimitri
1027,Ste Emeline
1028,St Simon
1029,St Narcisse
1030,Ste Bienvenue
1031,St Quentin
*
1101,TOUSSAINT
1102,Défunts
1103,St Hubert
1104,St Charles
1105,Ste Sylvie
1106,Ste Bertille
1107,Ste Carine
1108,St Geoffroy
1109,St Théodore
1110,St Léon
1111,ARMISTICE 1918
1112,St Christian
1113,St Brice
1114,Ste Sidoine
1115,St Albert
1116,Ste Marguerite
1117,Ste Elisabeth
1118,Ste Aude
1119,St Tanguy
1120,St Edmond
1121,Présentation de Marie
1122,Ste Cécile
1123,St Clément
1124,Ste Flora
1125,Ste Catherine Labouré
1126,Ste Delphine
1127,St Séverin
1128,St Jacques de la Marche
1129,St Saturnin
1130,St André
*
1201,Ste Florence
1202,Ste Viviane
1203,St François Xavier
1204,Ste Barbara
1205,St Gérald
1206,St Nicolas
1207,St Ambroise
1208,Immaculée Conception
1209,St Pierre Fourier
1210,St Romaric
1211,St Daniel
1212,Ste Jeanne Françoise Chantal
1213,Ste Lucie
1214,Ste Odile
1215,Ste Ninon
1216,Ste Alice
1217,St Judicaël
1218,St Gatien
1219,St Urbain
1220,St Théophile
1221,HIVER
1223,St Armand
1224,Ste Adèle
1225,Noël
1226,St Etienne
1227,St Jean Apôtre
1228,Sts Innocents
1229,St David
1230,St Roger
1231,St Sylvestre