Encore un petit planning

' Planning
LABEL Quit,Desfond,Aftex,Maj,Valid,Editer,Jours,Bissex,Imprime
DIM i%,j%,z$,p,ld,lj,lr,het,hd,hr,xd,yd,x,y,cr,cg,cb,tx$,wt,ht
DIM nm$(12),lm(12),jo$(7),Annee,Mois,Jour,pm,pa,jr$,c,d,bi,fp$,nc%,wm%,hm%
DIM jeh%,jet%,jhi%,ff$(12,31),xt,yt,iv$,mo%,xa,ya,wa,ha
iv$ = "C:\Progra~2\Irfanv~1\i_view64.exe": ' pour impression éventuelle

DATA "JANVIER", "FÉVRIER","MARS","AVRIL","MAI","JUIN","JUILLET","AOÛT"
DATA "SEPTEMBRE","OCTOBRE","NOVEMBRE","DÉCEMBRE"
DATA 31,28,31,30,31,30,31,31,30,31,30,31
FOR i% = 1 TO 12: READ nm$(i%): NEXT i%
FOR i% = 1 TO 12: READ lm(i%): NEXT i%
DATA "DIM","Lun","Mar","Mer","Jeu","Ven","Sam"
FOR i% = 0 TO 6: READ jo$(i%): NEXT i%
ff$(1,1)="JOUR DE L'AN": ff$(5,1)="FÊTE DU TRAVAIL": ff$(5,8)="VICTOIRE 1945"
ff$(7,14)="FÊTE NATIONALE": ff$(8,15)="ASSOMPTION": ff$(11,1)="TOUSSAINT"
ff$(11,11)="ARMISTICE 1918": ff$(12,25)="NOËL"
fp$ = "C:\TEXTES\Planning.txt": ' <====== à ajuster

ld = 18: ' largeur n° du jour
lj = 25: ' largeur nom du jour
lr = 182: ' largeur de la colonne mois (données)
wm% = ld+lj+lr: ' largeur totale d'un mois
het = 55: ' hauteur de l'en-tête
hd = 25: ' hauteur de la rangée 'nom du mois'
hr = 30: ' hauteur des rangées 'jour'
hm% = het+hd+31*hr: ' hauteur totale maxi
nc% = 3: ' nb de mois affichés

WIDTH 0, wm%*3+10: HEIGHT 0,hm%: BORDER_HIDE 0
COLOR 0,200,200,255: FONT_SIZE 0,10: FONT_BOLD 0: FONT_NAME 0,"Arial"

BUTTON 5: WIDTH 5,40: LEFT 5,5: CAPTION 5, "Edit": ON_CLICK 5, Editer

SPIN 6: WIDTH 6,40: LEFT 6,5: MIN 6,1: MAX 6,12
SPIN 7: WIDTH 7,60: LEFT 7,LEFT(6)+WIDTH(6)+3: MIN 7,1900: MAX 7,3000

CONTAINER_OPTION 10: TOP 10,-9: LEFT 10,LEFT(7)+WIDTH(7)+5: HEIGHT 10,35
  WIDTH 10,180: COLOR 10,255,255,180
OPTION 11: PARENT 11,10: LEFT 11,3: TOP 11,13: CAPTION 11,"3 mois": MARK_ON 11
OPTION 12: PARENT 12,10: TOP 12,TOP(11): LEFT 12,LEFT(11)+62: CAPTION 12,"6 mois"
OPTION 13: PARENT 13,10: TOP 13,TOP(11): LEFT 13,LEFT(12)+62: CAPTION 13,"1 an"
BUTTON 20: WIDTH 20,50: TOP 20,TOP(6): LEFT 20,LEFT(10)+WIDTH(10)+5: CAPTION 20,"Valider"
  ON_CLICK 20,Valid

ALPHA 15: TOP 15,31: LEFT 15,5: CAPTION 15,"W Col."
SPIN 16: TOP 16,28: LEFT 16,LEFT(15)+45: WIDTH 16,50
  MIN 16,10: MAX 16,1000: POSITION 16,lr: ON_CHANGE 16,Maj
ALPHA 17: TOP 17,TOP(15): LEFT 17,LEFT(16)+52: CAPTION 17,"H Rang."
SPIN 18: TOP 18,TOP(16): LEFT 18,LEFT(17)+50: WIDTH 18,40
  MIN 18,2: MAX 18,100: POSITION 18,hr: ON_CHANGE 18,Maj
ALPHA 19: TOP 19,TOP(17): LEFT 19,LEFT(18)+WIDTH(18)+5: COLOR 19,220,220,255
  GOSUB Maj

BUTTON 14: TOP 14,TOP(20): WIDTH 14,70: LEFT 14,LEFT(20)+WIDTH(20)+30
  CAPTION 14,"Imprimer": ON_CLICK 14,Imprime
BUTTON 29: WIDTH 29,50: TOP 29,28: LEFT 29,WIDTH(0)-55: CAPTION 29,"Edit"
  ON_CLICK 29,Editer
BUTTON 30: WIDTH 30,50: LEFT 30,WIDTH(0)-55: CAPTION 30,"Quitter"
  ON_CLICK 30, Quit
  
xd = 5: yd = het
PICTURE 100: TOP 100,yd: LEFT 100,xd: WIDTH 100,nc%*wm%+1: HEIGHT 100,hd+31*hr: p=100
  2D_TARGET_IS p: PRINT_TARGET_IS p
DLIST 90: IF FILE_EXISTS(fp$)=1 THEN FILE_LOAD 90,fp$
DLIST 91

Annee = VAL(RIGHT$(DATE$,4)): Mois = VAL(MID$(DATE$,4,2))
POSITION 6,Mois: POSITION 7,Annee

GOSUB Desfond
END
' ==============================================================================
Quit:
TERMINATE
' ==============================================================================
Desfond:
  nc% = 3: ' nombre de mois
  IF CHECKED(12) = 1 THEN nc% = 6
  IF CHECKED(13) = 1 THEN nc% = 12
  GOSUB Maj
  WIDTH 0,wm%*nc%+10: HEIGHT 0,hm%: IF WIDTH(0)<520 THEN WIDTH 0,520
  LEFT 29,WIDTH(0)-55: IF LEFT(29)>(SCREEN_X-60) THEN LEFT 29,SCREEN_X-60
  LEFT 30,LEFT(29)
  Annee = POSITION(7): Mois = POSITION(6): pa = Annee: pm = Mois
  WIDTH p,nc%*wm%: HEIGHT p,hd+31*hr: CLS
  Mois = Mois-1
  FOR j% = 1 TO nc%
    Mois = Mois+1: IF Mois = 13 THEN Mois = 1: Annee = Annee+1
    CLEAR 91
    FOR i% = 1 TO COUNT(90)
        z$ = ITEM_READ$(90, i%)
        IF z$<>"" AND MID$(z$, 5,2)=" =" AND NUMERIC(LEFT$(z$,4))=1
            IF VAL(LEFT$(z$,4)) = Annee
                i% = i% + 1
                WHILE i%<=COUNT(90)
                    z$ = ITEM_READ$(90, i%)
                    IF LEFT$(z$, 1) = "*" OR MID$(z$,5,1) = " " THEN EXIT_WHILE
                    IF z$<>"" AND LEFT$(z$,2)<>".." AND MID$(z$,4,2)<>".."
                        IF VAL(MID$(z$,4,2)) = Mois
                            ITEM_ADD 91, ITEM_READ$(90, i%)
                        END_IF
                    END_IF
                    i% = i% + 1
                END_WHILE
            END_IF
        END_IF
    NEXT i%
    lm(2) = 28: GOSUB Bissex: IF bi = 1 THEN lm(2) = 29
    QPaques(Annee): ' -> rs_qpa, rs_qas, rs_qpe Pâques, Ascension, Pentecôte
    jet% = 0: jhi% = 0
    IF Mois = 3 THEN Ete_Hiver(pa,Mois): jet% = jeh%
    IF Mois = 10 THEN Ete_Hiver(pa,Mois): jhi% = jeh%
    y = 0
    x = (j%-1)*wm%
    2D_FILL_COLOR 255,255,190: 2D_RECTANGLE x,y,x+wm%,y+hd: ' nom du mois
    2D_FILL_COLOR 255,255,255
    tx$ = nm$(Mois)+" "+STR$(Annee): tx$ = "&"+tx$: FONT_BOLD p: FONT_SIZE p,10
    xa = x: wa = wm%: ha = hd: GOSUB Aftex : FONT_SIZE p,8
    FOR Jour = 1 TO lm(Mois)
        GOSUB Jours: jr$ = LEFT$(jr$,3): ' -> jr$ jour de la semaine
        FONT_COLOR p,0,0,0
        y = hd+(Jour-1)*hr
        2D_FILL_COLOR 200,255,255: 2D_RECTANGLE x,y,x+ld+1,y+hr: ' n° du jour
        tx$ = "&"+STR$(Jour): xa = x: wa = ld: ha = hr: FONT_BOLD p: GOSUB Aftex
        2D_FILL_COLOR 255,255,255: IF jr$ = "DIM" THEN 2D_FILL_COLOR 255,210,210
        xa = x+ld: 2D_RECTANGLE xa,y,xa+lj+1,y+hr: ' nom du jour
        tx$ = "&"+jr$: wa = lj: ha = hr: GOSUB Aftex
        2D_FILL_COLOR 255,255,255: xa=x+ld+lj: wa = lr: 2D_RECTANGLE xa,y,xa+wa,y+hr: ' contenu
        Jmq(Annee,Mois,i%): ' -> rs_qa% quantième dans l'année
    tx$ = ""
    IF VAL(RIGHT$(DATE$,4))=Annee AND VAL(MID$(DATE$,4,2))=Mois AND VAL(LEFT$(DATE$,2))=Jour
        FONT_COLOR p,255,0,0: tx$="&"+"Aujourd'hui"
    END_IF
        ' y a-t'il un texte pour ce jour ?
        IF COUNT(91) > 0
            FOR i% = 1 TO COUNT(91)
                z$ = ITEM_READ$(91, i%)
                IF VAL(LEFT$(z$, 2)) = Jour
                    z$ = RIGHT_POS$(z$,7)
                    IF tx$<>""
                        tx$ = tx$+"|"+z$
                    ELSE
                        tx$ = z$
                    END_IF
                END_IF
            NEXT i%
        END_IF
        ' fêtes mobiles
        IF rs_qa% = rs_qpa then tx$ = "Pâques"
        IF rs_qa% = rs_qas THEN tx$ = "Ascension"
        IF rs_qa% = rs_qpe THEN tx$ = "Pentecôte"
        IF Jour = jet% THEN tx$ = "H.Été 2h->3h"
        IF Jour = jhi% THEN tx$ = "H.Hiver 3h->2h"
        ' + fêtes fixes ...
        IF ff$(Mois,Jour)<>"" THEN tx$ = ff$(Mois,Jour)
        IF tx$<>"" THEN GOSUB Aftex
    NEXT Jour
  NEXT j%
RETURN
' ==============================================================================
Aftex:
  ' Affichage du texte tx$ dans la case en xa,y de dimensions wa x ha
  IF LEFT$(tx$,1) = "&": ' texte centré
      IF LEFT$(tx$,1)="&" THEN tx$ = RIGHT_POS$(tx$,2)
      wt = TEXT_WIDTH(tx$,p): ht = TEXT_HEIGHT(tx$,p)
      xt = (wa-wt)/2+1
  ELSE
      xt = 5
  END_IF
  yt = (ha-ht)/2
  PRINT_LOCATE xa+xt,y+yt: PRINT tx$
  FONT_BOLD_OFF p
RETURN
' ==============================================================================
Jours:
  ' Jour de la semaine (d = 0 à 6, dimanche à samedi) en fonction de
  ' jour, mois et année
  d = Annee
  IF Mois < 3 THEN d = d - 1
  d = INT(23*Mois/9) + Jour + 4 + Annee + INT(d/4) - INT(d/100) + INT(d/400)
  IF Mois >= 3 THEN d = d - 2
  d = d - 7 * INT(d/7)
  jr$ = jo$(d)
RETURN
' ==============================================================================
Maj:
  lr = POSITION(16): wm% = ld+lj+lr: ' largeur totale un mois
  hr = POSITION(18): hm% = het+hd+31*hr: ' hauteur totale
  wt =  wm%*nc%: ht = hd+31*hr: z$ = STR$(wt/ht): IF LEN(z$)>6 THEN z$ = LEFT$(z$,6)
  CAPTION 19,"Image totale= "+STR$(wt)+"x"+STR$(ht)+" pixels (r="+z$+")"
  mo% = 1
RETURN
' ==============================================================================
Valid:
  Annee = POSITION(7): Mois = POSITION(6)
  GOSUB Desfond
RETURN
' ==============================================================================
Editer:
  EXECUTE_WAIT "Notepad.exe " + fp$
  FILE_LOAD 90, fp$
RETURN
' ==============================================================================
Bissex:
  bi = 0
  IF (FRAC(Annee/4)=0 AND FRAC(Annee/100)>0) OR FRAC(Annee/400)=0 THEN bi = 1
RETURN
' ==============================================================================
Imprime:
  IF mo% = 1 THEN GOSUB Valid
  CLIPBOARD_COPY p
  EXECUTE_WAIT iv$+" /clippaste"
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 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 Qjm(Annee,Q)
  ' Mois et jour en fonction du quantième -> Mois, Jour
  DIM_LOCAL qj_bi%, qj_qt%, qj_lm%
  qj_bi% = 0: qj_qt% = 0
  IF (FRAC(Annee/4)=0 AND FRAC(Annee/100)>0) OR FRAC(Annee/400)=0 THEN qj_bi%=1
  Mois = 1: qj_qt% = 31
  IF Q<32
    Jour = Q
  ELSE
    WHILE Q > qj_qt%
        Mois = Mois + 1
        IF Mois = 4 OR Mois = 6 OR Mois = 9 OR Mois = 11
            qj_lm% = 30
        ELSE
            IF Mois = 2
                qj_lm% = 28 + qj_bi%
            ELSE
                qj_lm% = 31
            END_IF
        END_IF
        qj_qt% = qj_qt% + qj_lm%
    END_WHILE
    Jour = Q - qj_qt% + qj_lm%
  END_IF
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("jeh%") = 0 THEN DIM jeh%
  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
  jeh% = 31-INT((b_h%/7-INT(b_h%/7))*7+.1)
END_SUB
' ==============================================================================