Un petit calendrier avec quelques Subs

LABEL Descal, Chan, Edannee, Majart, Supart, Clickcel, Clickbut, Affet, Edf
DIM wc%, hr%, p%, p1%, tp%, lf%, i%, j%, x%(12,32), y%(12,32), yy%, xx%, lm(12)
DIM ms$(12), js$(6), feve$, fete$, Annee, Mois, Jour, dl%, df%, a$, b$, im%
DIM an$, mo$, jo$, ev$, c%, r%, aa, mm, jj, xdl%, v, vg, afet%, db%

DATA "JANVIER","FÉVRIER","MARS","AVRIL","MAI","JUIN","JUILLET","AOUT"
DATA "SEPTEMBRE","OCTOBRE","NOVEMBRE","DÉCEMBRE"
DATA "D","L","M","M","J","V","S"
FOR i% = 1 TO 12: READ ms$(i%): NEXT i%
FOR i% = 0 TO 6: READ js$(i%): NEXT i%
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
a$ = LEFT$(DIR_CURRENT$,2): feve$ = a$+feve$: fete$ = a$+fete$: ' a$: volume actif

wc% = 80: hr% = 17
p% = 1
tp% = 25: lf% = 0
WIDTH 0, lf%+wc%*12+6: HEIGHT 0,tp%+hr%*32+4: BORDER_SMALL 0: CAPTION 0, ""
PICTURE p%: TOP p%, tp%: WIDTH p%,wc%*12-10: HEIGHT p%,hr%*32-30
FOR j% = 0 TO 31
    FOR i% = 1 TO 12
        x%(i%, j%) = lf% + (i%-1)*(wc%-1)
        y%(i%, j%) = j%*(hr%-1)
    NEXT i%
NEXT j%
2D_TARGET_IS p%: PRINT_TARGET_IS p%
FONT_NAME p%,"Arial"
ON_CLICK p%, Clickcel

p1% = 20
PICTURE p1%: TOP p1%,-1*HEIGHT(p%): WIDTH p1%,WIDTH(p%): HEIGHT p1%,HEIGHT(p%)
HIDE p1%

BUTTON 2: TOP 2,0: LEFT 2,WIDTH(1)/2-140: WIDTH 2,130: 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,130: 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
CHECK 6: TOP 6,2: LEFT 6,5: WIDTH 6,50: CAPTION 6, "Fêtes": ON_CLICK 6, Affet
ALPHA 7: TOP 7,4: LEFT 7,60: CAPTION 7,"Ajourd'hui " + DATE$: FONT_BOLD 7
FONT_COLOR 7,0,0,255
PROGRESS_BAR 8: LEFT 8,LEFT(3)+WIDTH(3): WIDTH 8,280: MIN 8,0: MAX 8,12: HIDE 8
TOP 8,10: HEIGHT 8,10

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

im% = 99: IMAGE im%
dl% = 100: DLIST dl%
df% = 101: DLIST df%
IF FILE_EXISTS(fete$) = 1
    FILE_LOAD df%, fete$
    b$ = MID$(DATE$,4,2)+LEFT$(DATE$,2): a$ = ""
    FOR i% = 1 TO COUNT(df%)
        IF LEFT$(ITEM_READ$(df%,i%),4) = b$
            a$ = " - " + MID$(ITEM_READ$(df%,i%),6,100): EXIT_FOR
        END_IF
    NEXT i%
END_IF
CAPTION 7, "Aujourd'hui " + DATE$ + a$

Annee = VAL(RIGHT$(DATE$,4))
GOSUB Descal

END
' ==============================================================================
Descal:
SHOW 8: POSITION 8,1
TEXT 4, STR$(Annee)
Bisex(Annee)
lm(2) = 28: 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
2D_TARGET_IS p1%: PRINT_TARGET_IS p1%
db% = 1
FOR Mois = 1 TO 12
    POSITION 8,Mois
    FOR Jour = 0 TO lm(Mois)
        yy% = y%(mois, Jour): xx% = x%(Mois, Jour)
        IF Jour = 0
            2D_FILL_COLOR 255,255,128
            2D_RECTANGLE xx%,yy%,xx%+wc%,yy%+hr%
            PRINT_LOCATE xx%+2,yy%+2: PRINT ms$(Mois): ' nom du mois
        ELSE
            an$ = STR$(Annee): mo$ = RIGHT$("0"+STR$(Mois),2)
            jo$ = RIGHT$("0"+STR$(Jour),2): ev$ = "#" + an$ + mo$ + jo$
            JourSem(Annee,Mois,Jour)
            IF rs_js% = 0
                2D_FILL_COLOR 160,255,255
            ELSE
                2D_FILL_COLOR 210,255,255
            END_IF
            Jmq(Annee,Mois,Jour): ' rs_qa% = quantième du jour
            a$ = js$(rs_js%)+RIGHT$(" "+STR$(Jour),2)
            b$ = ""
            IF Mois = 1 AND Jour = 1 THEN b$ = "J.de l'An"
            IF Mois = 5 AND Jour = 1 THEN b$ = "F.Travail"
            IF Mois = 5 AND Jour = 8 THEN b$ = "Vict.1945"
            IF Mois = 7 AND Jour = 14 THEN b$ = "Fêt.Nat."
            IF Mois = 8 AND Jour = 15 THEN b$ = "Assomption."
            IF Mois = 11 AND Jour = 1 THEN b$ = "Toussaint"
            IF Mois = 11 AND Jour = 11 THEN b$ = "Arm.1918"
            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$ = "Ascension"
            IF rs_qa% = rs_qpe THEN b$ = "Pentecôte."
            IF COUNT(dl%) > 0
                FOR i% = 1 TO COUNT(dl%)
                    IF LEFT$(ITEM_READ$(dl%,i%), LEN(ev$)) = ev$
                        2D_FILL_COLOR 255,180,180
                    END_IF
                NEXT i%
            END_IF
            IF b$ <> "" THEN b$ = " " + b$
            a$ = a$ + b$
            IF afet% = 1
                FOR i% = db% TO COUNT(df%)
                    b$ = ITEM_READ$(df%, i%)
                    IF LEFT$(b$,4) = mo$+jo$
                        a$ = a$ + " " + MID$(b$,6,100): db% = i%: EXIT_FOR
                    END_IF
                NEXT i%
            END_IF
            2D_RECTANGLE xx%,yy%,xx%+wc%,yy%+hr%
            PRINT_LOCATE xx%+2,yy%+2: PRINT a$
        END_IF
    NEXT Jour
NEXT Mois
2D_IMAGE_COPY im%,0,0,WIDTH(p1%),HEIGHT(p1%)
2D_TARGET_IS p%: 2D_IMAGE_PASTE im%,0,0
HIDE 8
CAPTION 0, " - CALENDRIER " + STR$(Annee) + " -"
RETURN
' ------------------------------------------------------------------------------
Chan:
IF CLICKED(2) = 1
    Annee = Annee - 1
ELSE
    Annee = Annee + 1
END_IF
TEXT 4, STR$(Annee)
GOSUB Descal
RETURN
' ------------------------------------------------------------------------------
Edannee:
i% = VAL(TEXT$(4))
IF i%<1700 OR i%>2900 THEN RETURN
Annee = i%
GOSUB Descal
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$: ' suppression fichier vide
ELSE
    FILE_SAVE dl%, feve$: ' mise à jour du fichier correspondant
END_IF
RETURN
' ------------------------------------------------------------------------------
Clickcel:
xx% = MOUSE_X_POSITION(p%): yy% = MOUSE_Y_POSITION(p%)
Mois = 1+INT(xx%/(wc%-1)): Jour = INT(yy%/(hr%-1))
IF Jour > lm(Mois) THEN RETURN
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
    ' on quitte sans rien faire
ELSE
    IF CLICKED(15) = 1
        GOSUB Supart: ' supprimer l'article actuellement affiché
    ELSE
        IF COUNT(12) > 0
            GOSUB Majart: ' Enregistrer (modifs ou nouveau)
        END_IF
    END_IF
    GOSUB Descal: ' réaffichage du calendrier
END_IF
HIDE 10
RETURN
' ------------------------------------------------------------------------------
Affet:
IF FILE_EXISTS(fete$) = 0 THEN RETURN
IF afet% = 1
    afet% = 0
ELSE
    afet% = 1
END_IF
GOSUB Descal
RETURN
' ------------------------------------------------------------------------------
Edf:
EXECUTE_WAIT "Notepad.exe " + feve$
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 + / 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
' ------------------------------------------------------------------------------

IF FILE_EXISTS(fete$) = 0 THEN RETURN

' Calendrier/Planning
LABEL Descal, Chan, Edannee, Majart, Supart, Clickcel, Planning, uu, Retour
LABEL Clickbut, Affet, Edf, Imprime, Aide
DIM wc%, hr%, p%, p1%, tp%, lf%, i%, j%, k%, x%(12,32), y%(12,32), yy%, xx%, lm(12)
DIM ms$(12), js$(6), ja$(7), feve$, fete$, Annee, Mois, Jour, dl%, df%, a$, b$, im%
DIM an$, mo$, jo$, ev$, ev1$, av$, c%, r%, aa, mm, jj, xdl%, v, vg, afet%, db%
DIM he%, eh%, fp%, pi%, ht%, wk%, hk%, yp%, ft$(50), nft%, xa%(31),ya%(31),dec%
DIM fpr$, kgf$

DATA "JANVIER","FÉVRIER","MARS","AVRIL","MAI","JUIN","JUILLET","AOUT"
DATA "SEPTEMBRE","OCTOBRE","NOVEMBRE","DÉCEMBRE"
DATA "D","L","M","M","J","V","S"
DATA "Lundi","Mardi","Mercredi","Jeudi","Vendredi","Samedi","Dimanche"
FOR i% = 1 TO 12: READ ms$(i%): NEXT i%
FOR i% = 0 TO 6: READ js$(i%): NEXT i%
FOR i% = 1 TO 7: READ ja$(i%): NEXT i%
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

fpr$ = "C:\TEMP\Fimpr.bmp": ' fichier d'impression (provisoire)
kgf$ = "C:\PANORAMIC\KLAUS\DLLs\KGF.dll"
feve$ = "C:\TEXTES\EvntAAAA.txt": ' fichiers 'événements'
fete$ = "C:\TEXTES\Fetes.txt": ' liste des fêtes du jour

wc% = 76: hr% = 20: ' largeur et hauteur de cellule (proportions ~ pour A4)
p% = 1
tp% = 25: lf% = 0
WIDTH 0, lf%+wc%*12+6: HEIGHT 0,tp%+hr%*32+30: BORDER_SMALL 0: CAPTION 0, ""
COLOR 0,190,255,255
PICTURE p%: TOP p%, tp%: WIDTH p%,wc%*12-10: HEIGHT p%,hr%*32-4
dec% = 25
FOR Jour = 0 TO 31
    FOR Mois = 1 TO 12
        ' coordonnées des cellules
        x%(Mois, Jour) = lf% + (Mois-1)*(wc%-1)
        y%(Mois, Jour) = Jour*(hr%-1)+dec%
    NEXT Mois
NEXT Jour
ON_CLICK p%, Clickcel

p1% = 20
PICTURE p1%: TOP p1%,-1*HEIGHT(p%): WIDTH p1%,WIDTH(p%): HEIGHT p1%,HEIGHT(p%)
HIDE p1%

BUTTON 2: TOP 2,0: LEFT 2,WIDTH(1)/2-140: WIDTH 2,130: 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,130: HEIGHT 3,HEIGHT(2)
CAPTION 3,"Année suivante ->" : FONT_BOLD 3
ON_CLICK 2, Chan: ON_CLICK 3, Chan
EDIT 4: TOP 4,-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
CHECK 6: TOP 6,2: LEFT 6,0: WIDTH 6,50: CAPTION 6, "Fêtes": ON_CLICK 6, Affet
ALPHA 7: TOP 7,4: LEFT 7,60: CAPTION 7,"Aujourd'hui " + DATE$: FONT_BOLD 7
FONT_COLOR 7,0,0,255
PROGRESS_BAR 8: LEFT 8,LEFT(3)+WIDTH(3): WIDTH 8,250: MIN 8,0: MAX 8,12: HIDE 8
TOP 8,10: HEIGHT 8,10
BUTTON 9: TOP 9,4: WIDTH 9,25: LEFT 9,WIDTH(0)-43: HEIGHT 9,20: CAPTION 9,"?"
ON_CLICK 9, Aide
BUTTON 19: TOP 19,TOP(9): LEFT 19,LEFT(9)-50: WIDTH 19,48: HEIGHT 19,20
CAPTION 19,"Imprim.": ON_CLICK 19,Imprime

FORM 10:BORDER_HIDE 10: HIDE 10: TOP 10,100: LEFT 10,40: WIDTH 10,320: HEIGHT 10,160
FONT_BOLD 10: COLOR 10,100,255,100
PICTURE 11: PARENT 11,10: TOP 11,3: LEFT 11,5: WIDTH 11,90
HEIGHT 11,HEIGHT(10)-30: COLOR 11,255,220,220: FONT_BOLD 11: FONT_COLOR 11,0,0,255
MEMO 12: PARENT 12,10: TOP 12,5: LEFT 12,LEFT(11)+WIDTH(11)+5
WIDTH 12,WIDTH(10)-WIDTH(11)-15: HEIGHT 12,HEIGHT(11)-10
BUTTON 13: PARENT 13,10: TOP 13,TOP(12)+HEIGHT(12)+5: LEFT 13,170: WIDTH 13,70
CAPTION 13,"Enregistrer"
BUTTON 14: PARENT 14,10: TOP 14,TOP(13): LEFT 14,LEFT(13)+72: WIDTH 14,70
CAPTION 14,"Quitter"
BUTTON 15: PARENT 15,10: TOP 15,TOP(13): LEFT 15,LEFT(13)-72: WIDTH 15,70
CAPTION 15,"Supprimer"
FOR i% = 13 TO 15: ON_CLICK i%, Clickbut: 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

fp% = 30: ' Form du planning mensuel (clic sur le nom du mois)
FORM fp%: HIDE fp%: TOP fp%,TOP(0)+30: LEFT fp%,LEFT(0): WIDTH fp%,WIDTH(0)
HEIGHT fp%,HEIGHT(0)-40: BORDER_HIDE fp%
pi% = fp%+1
PICTURE pi%: PARENT pi%,fp%: FULL_SPACE pi%: ON_CLICK pi%,Clickcel
BUTTON 32: PARENT 32,30: LEFT 32,WIDTH(30)-50: WIDTH 32,48: CAPTION 32,"Retour"
ON_CLICK 32,Retour
BUTTON 33: PARENT 33,30: LEFT 33,LEFT(32)-50: WIDTH 33,48: CAPTION 33,"Imprim."
ON_CLICK 33,Imprime

im% = 99: IMAGE im%
dl% = 100: DLIST dl%
df% = 101: DLIST df%
IF FILE_EXISTS(fete$) = 1
    FILE_LOAD df%, fete$
    b$ = MID$(DATE$,4,2)+LEFT$(DATE$,2): a$ = ""
    FOR i% = 1 TO COUNT(df%)
        IF LEFT$(ITEM_READ$(df%,i%),4) = b$
            a$ = " - " + MID$(ITEM_READ$(df%,i%),6,100): EXIT_FOR
        END_IF
    NEXT i%
END_IF
CAPTION 7, "Aujourd'hui " + DATE$ + a$

Annee = VAL(RIGHT$(DATE$,4))
GOSUB Descal
END: ' =========================================================================
' ==============================================================================
Descal:
SHOW 8: POSITION 8,1
TEXT 4, STR$(Annee)
2D_TARGET_IS p1%: 2D_FILL_COLOR 255,255,255
PRINT_TARGET_IS p1%: FONT_NAME p1%,"Arial": FONT_SIZE p1%,18: FONT_BOLD p1%
PRINT_LOCATE WIDTH(p1%)/2-25,-1: PRINT STR$(Annee)
Bisex(Annee)
lm(2) = 28: 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
Ete_Hiver(Annee,3): he% = j%: ' jour de passage heure été/hiver
Ete_Hiver(Annee,10): eh% = j%: ' jour de passage heure hiver/été
2D_TARGET_IS p1%: PRINT_TARGET_IS p1%
db% = 1: nft% = 0
FOR Mois = 1 TO 12
    POSITION 8,Mois
    2D_PEN_COLOR 0,0,0
    FOR Jour = 0 TO lm(Mois)
        yy% = y%(mois, Jour): xx% = x%(Mois, Jour)
        IF Jour = 0
            2D_FILL_COLOR 255,255,128
            2D_RECTANGLE xx%,yy%,xx%+wc%,yy%+hr%
            FONT_BOLD p1%: FONT_SIZE p1%,8: a$ = ms$(Mois): i% = TEXT_WIDTH(a$,p1%)
            PRINT_LOCATE xx%+(wc%-i%)/2,yy%+2: PRINT ms$(Mois): ' nom du mois
            FONT_BOLD_OFF p1%: FONT_SIZE p1%,7
        ELSE
            an$ = STR$(Annee): mo$ = RIGHT$("0"+STR$(Mois),2)
            jo$ = RIGHT$("0"+STR$(Jour),2)
            ev1$ = mo$ + jo$ + " ": ev$ = "#" + an$ + ev1$
            JourSem(Annee,Mois,Jour)
            IF rs_js% = 0
                2D_FILL_COLOR 200,255,255: ' dimanche
            ELSE
                2D_FILL_COLOR 255,255,255
            END_IF
            Jmq(Annee,Mois,Jour): ' rs_qa% = quantième du jour
            a$ = js$(rs_js%)+RIGHT$(" "+STR$(Jour),2)
            b$ = "": ' Fêtes fixes et mobiles
            SELECT Mois
                CASE 1: IF Jour = 1 THEN b$ = "J.de l'An"
                CASE 5: IF Jour = 1 THEN b$ = "F.Travail"
                        IF Jour = 8 THEN b$ = "Vict.1945"
                CASE 7: IF Jour = 14 THEN b$ = "Fêt.Nat."
                CASE 8: IF Jour = 15 THEN b$ = "Assomption"
                CASE 11: IF Jour = 1 THEN b$ = "Toussaint"
                         IF Jour = 11 THEN b$ = "Arm.1918"
                CASE 12: IF Jour = 25 THEN b$ = "NOEL"
            END_SELECT
            IF rs_qa% = rs_qpa THEN b$ = "Pâques"
            IF rs_qa% = rs_qas THEN b$ = "Ascension"
            IF rs_qa% = rs_qpe THEN b$ = "Pentecôte"
            IF COUNT(dl%) > 0: ' liste des événements
                FOR i% = 1 TO COUNT(dl%)
                    av$ = ITEM_READ$(dl%, i%)
                    IF LEFT$(av$,LEN(ev$))=ev$ OR LEFT$(av$,LEN(ev1$))=ev1$
                        2D_FILL_COLOR 255,180,180
                    END_IF
                NEXT i%
            END_IF
            IF b$ <> ""
                nft%=nft%+1
                ft$(nft%)=RIGHT$("0"+STR$(Mois),2)+RIGHT$("0"+STR$(Jour),2)+" "+b$
                b$ = " " + b$
            END_IF
            a$ = a$ + b$
            IF afet% = 1
                FOR i% = db% TO COUNT(df%)
                    b$ = ITEM_READ$(df%, i%)
                    IF LEFT$(b$,4) = mo$+jo$
                        a$ = a$ + " " + MID$(b$,6,100): db% = i%: EXIT_FOR
                    END_IF
                NEXT i%
            END_IF
            IF Mois=3 AND Jour=he%
                a$=a$+"         H->E"
            ELSE
                IF MOIS=10 AND Jour=eh%
                    a$=a$+"         E->H"
                END_IF
            END_IF
            2D_RECTANGLE xx%,yy%,xx%+wc%,yy%+hr%
            PRINT_LOCATE xx%+2,yy%+2: PRINT a$
        END_IF
    NEXT Jour
    IF lm(Mois) < 31
        2D_PEN_COLOR 255,255,255: 2D_FILL_COLOR 255,255,255
        FOR i% = lm(Mois)+1 TO 31
            yy% = y%(mois, i%): xx% = x%(Mois, i%)
            2D_RECTANGLE xx%+1,yy%+1,xx%+wc%,yy%+hr%
        NEXT i%
    END_IF
NEXT Mois
2D_IMAGE_COPY im%,0,0,WIDTH(p1%),HEIGHT(p1%)
2D_TARGET_IS p%: 2D_IMAGE_PASTE im%,0,0
HIDE 8
CAPTION 0, " - CALENDRIER " + STR$(Annee) + " -"
RETURN
' ==============================================================================
Chan:
i% = NUMBER_CLICK
IF i% = 2
    Annee = Annee - 1
ELSE
    Annee = Annee + 1
END_IF
TEXT 4, STR$(Annee)
GOSUB Descal
RETURN
' ==============================================================================
Edannee:
i% = VAL(TEXT$(4))
IF i%<1700 OR i%>2900 THEN RETURN
Annee = i%
GOSUB Descal
RETURN
' ==============================================================================
Majart:
' enregistrer l'article modifié ou nouveau
feve$ = "C:\TEXTES\Evnt"+STR$(Annee)+".txt"
mo$ = RIGHT$("0"+STR$(Mois),2)
jo$ = RIGHT$("0"+STR$(Jour),2): ev$ = mo$ + jo$
v = VAL(LEFT$(ev$,4)): j% = 0
IF COUNT(dl%) > 0
    FOR i% = 1 TO COUNT(dl%)
        a$ = ITEM_READ$(dl%, i%)
        IF NUMERIC(LEFT$(a$,4)) = 1 AND MID$(a$,5,1) = " ": ' article événement
            vg = VAL(LEFT$(a$,4))
            IF vg = v OR vg > v
                IF vg = v
                    ' article déjà existant, supprimer puis remplacer
                    xdl% = i%: GOSUB Supart
                END_IF
                a$ = ITEM_READ$(12,1)
                IF NUMERIC(LEFT$(a$,4)) = 1 AND MID$(a$,5,1) = " "
                    a$ = MID$(a$,6,500))
                END_IF
                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$: ' suppression fichier vide
ELSE
    FILE_SAVE dl%, feve$: ' mise à jour du fichier correspondant
END_IF
RETURN
' ==============================================================================/
Clickcel:
i% = NUMBER_CLICK
xx% = MOUSE_X_POSITION(i%): yy% = MOUSE_Y_POSITION(i%)-dec%
IF i% = p%
    Mois = 1+INT(xx%/(wc%-1)): Jour = INT(yy%/(hr%-1))
ELSE
    FOR Jour = 1 TO lm(Mois)
        i% = xa%(Jour): j% = ya%(Jour)
        IF xx%>i% AND yy%>j% AND xx%<(i%+wk%) AND yy%<(j%+hk%) THEN EXIT_FOR
    NEXT Jour
END_IF
IF Jour > lm(Mois) THEN RETURN

IF Jour = 0 THEN GOSUB Planning: RETURN: ' clic sur l'en-tête du mois
PRINT_TARGET_IS 11: FONT_NAME 11,"Arial": FONT_SIZE 11,10: FONT_BOLD 11: FONT_COLOR 11,0,0,0
2D_TARGET_IS 11: CLS
2D_RECTANGLE 0,0,WIDTH(11),HEIGHT(11)

k% = WIDTH(11): JourSem(Annee,Mois,Jour): IF rs_js%=0 THEN rs_js%=7
a$=UPPER$(ja$(rs_js%)): i%=TEXT_WIDTH(a$,11): PRINT_LOCATE (k%-i%)/2,10: PRINT a$
a$=STR$(Jour): FONT_COLOR 11,255,0,0: FONT_SIZE 11,32: i%=TEXT_WIDTH(a$,11): PRINT_LOCATE (k%-i%)/2,25: PRINT a$
a$=ms$(Mois): FONT_COLOR 11,0,0,0: FONT_SIZE 11,10: i%=TEXT_WIDTH(a$,11): PRINT_LOCATE (k%-i%)/2,80: PRINT a$
IF COUNT(df%) > 0
    b$ = "#"+STR$(Annee)+RIGHT$("0"+STR$(Mois),2)+RIGHT$("0"+STR$(Jour),2)
    FONT_SIZE 11,7: FONT_BOLD_OFF 11
    FOR j% = 1 TO COUNT(df%)
        a$ = ITEM_READ$(df%, j%)
        IF LEFT$(a$, 4) = RIGHT$(b$, 4)
            a$ = MID$(a$,6,100): i%=TEXT_WIDTH(a$,11)
            PRINT_LOCATE (k%-i%)/2,105: PRINT a$
        END_IF
    NEXT j%
END_IF

a$ = "Journée du " + STR$(Jour)+ " " + ms$(Mois) + " " +STR$(Annee)
IF COUNT(df%) > 0
    FOR i% = 1 TO COUNT(df%)
        a$ = ITEM_READ$(df%, i%)
        IF LEFT$(a$, 4) = RIGHT$(b$, 4)
            a$ = "Fête du jour: " + MID$(a$,6,100)
        END_IF
    NEXT i%
END_IF
CLEAR 12
IF FILE_EXISTS(feve$) = 1
    ev1$ = RIGHT$("0"+STR$(Mois),2)+RIGHT$("0"+STR$(Jour),2)+" "
    ev$ = "#"+STR$(Annee)+ev1$
    FOR i% = 1 TO COUNT(dl%)
        av$ = ITEM_READ$(dl%, i%)
        IF LEFT$(av$,LEN(ev1$))=ev1$ OR LEFT$(av$,LEN(ev$))=ev$
            j% = INSTR(av$," ")
            ITEM_ADD 12, LTRIM$(MID$(av$,j%+1,500))
            xdl% = i%: ' index de l'article affiché
            i% = i% + 1
            WHILE i% <= COUNT(dl%)
                av$ = ITEM_READ$(dl%, i%)
                IF NUMERIC(LEFT$(av$,4)) = 1
                    IF LEFT$(av$,5) <> ev1$ THEN EXIT_FOR: ' sortie
                    av$ = MID$(av$,6,500)
                END_IF
                ITEM_ADD 12, av$
                i% = i% + 1
            END_WHILE
            EXIT_FOR
        END_IF
    NEXT i%
END_IF
SHOW 10: TO_FOREGROUND 10
RETURN
' ==============================================================================
Planning:
' Affichage du planning d'un mois donné
WIDTH pi%,WIDTH(fp%): HEIGHT pi%,HEIGHT(fp%)
ht% = 25
2D_TARGET_IS pi%: CLS: 2D_FILL_COLOR 210,210,210
2D_RECTANGLE 0,ht%,WIDTH(pi%),HEIGHT(pi%)
2D_FILL_COLOR 255,255,255
wk% = WIDTH(pi%)/7: hk% = (HEIGHT(pi%)-2*ht%)/6
FOR yy% = 2*ht% TO HEIGHT(pi%) STEP hk%
    2D_LINE 0,yy%,WIDTH(pi%),yy%
NEXT yy%
FOR xx% = 0 TO WIDTH(pi%) STEP wk%
    2D_LINE xx%,25,xx%,HEIGHT(pi%)
NEXT xx%
PRINT_TARGET_IS pi%: FONT_NAME pi%,"Arial": FONT_SIZE pi%,14
a$ = LEFT$(ms$(Mois),1)+LOWER$(RIGHT_POS$(ms$(Mois),2))
PRINT_LOCATE 10,2: PRINT a$+" "+STR$(Annee)
FONT_COLOR pi%,255,255,255
yy% = ht%+2
FOR i% = 1 TO 7
    xx% = (i%-1)*wk%+30: 2D_FLOOD xx%,yy%,128,128,128
    PRINT_LOCATE xx%,yy%: PRINT ja$(i%)
NEXT i%
FONT_COLOR pi%,0,0,0: 2D_FILL_COLOR 255,255,255: yy% = 2*ht%
FOR Jour = 1 TO lm(Mois)
    JourSem(Annee,Mois,Jour): j%=rs_js%: IF j%=0 THEN j%=7: ' 1 à 7, Lun à Dim
    xx% = (j%-1)*wk%
    b$ = RIGHT$("0"+STR$(Mois),2)+RIGHT$("0"+STR$(Jour),2): a$ = ""
    FOR i% = 1 TO nft%
        IF b$=LEFT$(ft$(i%),4) THEN a$=RIGHT_POS$(ft$(i%),6): EXIT_FOR
    NEXT i%
    2D_RECTANGLE xx%,yy%,xx%+wk%+1,yy%+hk%+1
    xa%(Jour) = xx%: ya%(Jour) = yy%
    FONT_SIZE pi%,14: FONT_COLOR pi%,0,0,255
    PRINT_LOCATE xx%+5,yy%+3: PRINT STR$(Jour)+" "+a$
    yp% = yy%+24
    IF COUNT(dl%) > 0
        FOR i% = 1 TO COUNT(dl%)
            a$ = ITEM_READ$(dl%,i%)
            IF LEFT$(a$,4) = b$
                FONT_COLOR pi%,64,0,0: FONT_SIZE pi%,9: a$ = RIGHT_POS$(a$,6)
uu:
                k% = LEN(a$): r% = TEXT_WIDTH(LEFT$(a$,k%),pi%)
                WHILE r%>(wk%-5): k%=k%-1: r% = TEXT_WIDTH(LEFT$(a$,k%),pi%): END_WHILE
                PRINT_LOCATE xx%+3,yp%: PRINT LEFT$(a$,k%)
                IF k%<LEN(a$) THEN a$ = RIGHT_POS$(a$,k%+1): yp%=yp%+14: GOTO uu
                yp% = yp%+14
            END_IF
        NEXT i%
    END_IF
    IF j%=7 THEN yy% = yy%+hk%
NEXT Jour
SHOW fp%
RETURN
' ==============================================================================
Retour:
HIDE fp%
RETURN
' ==============================================================================
Clickbut:
IF CLICKED(14) = 1
    ' on quitte sans rien faire (juste hide)
ELSE
    IF CLICKED(15) = 1
        GOSUB Supart: ' supprimer l'article actuellement affiché
    ELSE
        IF COUNT(12) > 0
            GOSUB Majart: ' Enregistrer (modifs ou nouveau)
        END_IF
    END_IF
    GOSUB Descal: ' réaffichage du calendrier
END_IF
HIDE 10
RETURN
' ==============================================================================
Affet:
IF FILE_EXISTS(fete$) = 0 THEN RETURN
IF afet% = 1
    afet% = 0
ELSE
    afet% = 1
END_IF
GOSUB Descal
RETURN
' ==============================================================================
Edf:
EXECUTE_WAIT "Notepad.exe " + feve$
RETURN
' ==============================================================================
Imprime:
IF FILE_EXISTS(kgf$) = 0 THEN MESSAGE kgf$+"l non trouvé !": RETURN
i% = NUMBER_CLICK
IF i% = 19: ' impression du calendrier annuel
    FILE_SAVE p1%,fpr$
ELSE: ' impression du planning mensuel
    FILE_SAVE pi%,fpr$
END_IF
DLL_ON kgf$
Pr_Init(1): ' orientation 'paysage': les dimensions rendues sont fonction de l'orientation
Pr_Image(fpr$,Pr_mg%,Pr_mh%,Pr_lu%,Pr_hu%,0)
Pr_Impr(): ' lancement de l'impression
FILE_DELETE fpr$: ' suppression du fichier image d'impression
DLL_OFF kgf$
RETURN
' ==============================================================================
Aide:
a$ = CHR$(9)+CHR$(9)+CHR$(9)+"- UTILISATION -"+CHR$(10)+CHR$(10)
a$=a$+"1) CALENDRIER :"+CHR$(10)
a$=a$+"     Pour changer d'année, on peut soit cliquer sur les boutons 'Année"+CHR$(10)
a$=a$+"précédente' et 'Année suivante', soit entrer une année donnée et valider"+CHR$(10)
a$=a$+"par le bouton'OK'."+CHR$(10)
a$=a$+"   Sont indiquées les fêtes fixes et les fêtes mobiles. Il est possible de faire"+CHR$(10)
a$=a$+"afficher l'ensemble des fêtes en cochant la case 'Fetes' en haut à gauche."+CHR$(10)
a$=a$+"Décocher cette case pour revenir à l'affichage simple."+CHR$(10)
a$=a$+"   Les jours de passage aux heures d'été/hiver (dernier dimanche de mars et"+CHR$(10)
a$=a$+"octobre) sont marqués respectivement H->E et E->H."+CHR$(10)+CHR$(10)
a$=a$+"2) ÉVÉNEMENTS :"+CHR$(10)
a$=a$+"     Il est possible de noter ou d'afficher un événement pour un jour donné:"+CHR$(10)
a$=a$+"cliquer la case correspondante, entrer le texte à archiver dans la fenêtre"+CHR$(10)
a$=a$+"présentée, puis valider par 'Enregistrer'. La case correspondante sera"+CHR$(10)
a$=a$+"colorée en rose au moment des affichages ultérieurs du calendrier."+CHR$(10)
a$=a$+"     On peut modifier ou supprimer un événement au moment de son"+CHR$(10)
a$=a$+"affichage (un événement peut comporter plusieurs lignes de texte)."+CHR$(10)+CHR$(10)
a$=a$+"     La liste des fêtes du jour se trouve dans le fichier Fetes.txt,"+CHR$(10)
a$=a$+"sous la forme 0907,Ste Reine 0907 étant le mois et le jour correspondants."+CHR$(10)
a$=a$+"     Les événements sont archivés dans des fichiers EvntAAAA.txt, un"+CHR$(10)
a$=a$+"fichier par année (AAAA représentant l'année)."+CHR$(10)
a$=a$+"(Le chemin d'accès à ces fichiers est à préciser en début de programme)."+CHR$(10)+CHR$(10)
a$=a$+"3) PLANNING MENSUEL :"+CHR$(10)
a$=a$+"     En cliquant sur le nom du mois, on fait apparaître une fenêtre avec le"+CHR$(10)
a$=a$+"planning de ce mois. Cliquer 'Quitter' pour revenir au calendrier annuel."+CHR$(10)+CHR$(10)
a$=a$+"4) IMPRESSIONS :"+CHR$(10)
a$=a$+"     On peut imprimer soit le calendrier de l'année complète, soit le"+CHR$(10)
a$=a$+"planning mensuel : bouton 'Imprim.' qui renvoie l'image à IrfanView."+CHR$(10)
a$=a$+"Dans IrfanView, 'Imprimer', mettre en mode 'Paysage', sans marges, avec"+CHR$(10)
a$=a$+"option 'Ajuster à la page'."
MESSAGE a$
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 +  / 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
' ==============================================================================
SUB Ete_Hiver(annee%,mois%)
' quantième j% de Mars (heure d'été) ou Octobre (heure d'hiver) de l'année donnée
' (c'est le dernier dimanche du mois donné, été: +1/heure, hiver -1/heure)
IF VARIABLE("j%") = 0 THEN DIM j%
DIM_LOCAL a_h%, b_h%, s_h%
mois% = mois%-2
s_h% = INT(annee%/100): a_h% = annee% - s_h%*100
b_h% = INT(2.6*mois% - .19) + 31 + a_h%+INT(a_h%/4)+INT(s_h%/4)-s_h%*2
j% = 31-INT((b_h%/7-INT(b_h%/7))*7+.1)
END_SUB
' ==============================================================================
SUB Pr_init(orient%)
' Initialisation imprimante ('début d'impression')
' orient% = 0 Portrait, = 1 Paysage
' Dans les paramètres des fonctions, le positionnement initial doit être fait en
' valeurs absolues: distances par rapport aux bords gauche et haut de la feuille
' A4, sans tenir compte des marges non imprimables.
' Les couleurs sont à exprimer au format BGR (en non pas RGB): B*256*256+G*256+R
IF VARIABLE("phnd%") = 0 THEN DIM phnd%
IF VARIABLE("chnd%") = 0 THEN DIM chnd%
IF VARIABLE("inip%") = 0 THEN DIM inip%
IF VARIABLE("Pr_res%") = 0 THEN DIM Pr_res%
IF VARIABLE("Pr_mmpix") = 0 THEN DIM Pr_mmpix: ' pixels par mm
IF VARIABLE("Pr_mg%") = 0 THEN DIM Pr_mg%: ' marge gauche
IF VARIABLE("Pr_mh%") = 0 THEN DIM Pr_mh%: ' marge haut
IF VARIABLE("Pr_lu%") = 0 THEN DIM Pr_lu%: ' largeur utile
IF VARIABLE("Pr_hu%") = 0 THEN DIM Pr_hu%: ' hauteur utile
' Orientation portrait (0) ou paysage (1)
Pr_res% = DLL_CALL4("PrinterManager",4,ADR(phnd%),ADR(chnd%),orient%): ' orientation
Pr_res% = DLL_CALL4("PrinterManager",1,ADR(phnd%),ADR(chnd%),0): ' init
Pr_res% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),4,0,0)
Pr_mmpix = Pr_res%/297: ' pixels par mm, à l'impression en 600 dpi
' Marges non imprimables: décalage en pixels à soustraire gauche et haut:
Pr_mg% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),1,0,0): ' marge gauche
Pr_mh% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),2,0,0): ' marge haut
' Dimensions utiles, largeur et hauteur, sans les marges, en pixels:
' ==========
' ATTENTION: Les dimensions sont actualisées en fonction de l'option orientation !
' ==========
Pr_lu% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),7,0,0): ' largeur utile
Pr_hu% = DLL_CALL6("PrinterFunction",8,ADR(phnd%),ADR(chnd%),8,0,0): ' hauteur utile
' Couleur trait noir, épaisseur = 1, arrière-plan transparent:
inip% = -2
Pr_res% = DLL_CALL6("PrinterFunction",6,ADR(phnd%),ADR(chnd%),0,inip%,1)
inip% = 1
END_SUB
' ==============================================================================
SUB Pr_Image(f$,x%,y%,w%,h%,u%)
' Impression de l'image f$ en x%,y%, dimensions w% x h% (sera redimensionnée pour
' tenir dans le cadre donné).
' u% = 0: unités pixels, u% = 1, unités millimètres
' ******** NB: coordonnées d'impression (pixels): de 75,75 à 4811,6862 ********
IF inip% = 0 THEN EXIT_SUB: ' imprimante non initialisée (Sub Pr_Init)
IF u% = 1: ' unités en mm, conversion en pixels
    x% = x%*Pr_mmpix: y% = y%*Pr_mmpix: w% = w%*Pr_mmpix: h% = h%*Pr_mmpix
END_IF
x% = x%-Pr_mg%: y% = y%-Pr_mh%
Pr_res% = DLL_call6("PrinterFunction",4,ADR(phnd%),ADR(chnd%),0,x%,y%): ' positionnement
Pr_res% = DLL_call6("PrinterFunction",7,ADR(phnd%),ADR(chnd%),ADR(f$),w%,h%)
END_SUB
' ==============================================================================
SUB Pr_Impr()
' Lancement de l'impression réelle ('fin d'impression')
IF inip% = 0 THEN EXIT_SUB: ' imprimante non initialisée (Sub Pr_Init)
Pr_res% = DLL_CALL4("PrinterManager",3,ADR(phnd%),ADR(chnd%),0)
inip% = 0
END_SUB
' ==============================================================================