Encore un petit calendrier

' Cal_Annu.bas
' Calendrier sur A4, 3,6 ou 12 mois
LABEL Qt,Modm,Exec,Ajout
DIM an,xc(12,31),yc(12,31),qpa,qas,qpe,m%,da,j%,x,y,a$,nm,m1,dm,i,wf,hf,fimp$
fimp$ = "Caltmp.bmp": ' fichier temporaire d'impression
BORDER_SMALL 0: HIDE 0
PICTURE 1
IMAGE 2

FORM 10: BORDER_SMALL 10: TOP 10,50: LEFT 10,100: WIDTH 10,250: HEIGHT 10,240
         COLOR 10,255,255,0: ON_CLOSE 10,Qt
         FONT_SIZE 10,12: CAPTION 10,"    -   CALENDRIER   ANNUEL  A4   -"
ALPHA 15: PARENT 15,10: TOP 15,10: LEFT 15,10: CAPTION 15,"Année"
SPIN 16: PARENT 16,10: TOP 16,TOP(15)+25: LEFT 16,5: WIDTH 16,75: POSITION 16,DATE_YEAR
         FONT_SIZE 15,16: FONT_SIZE 16,16
CONTAINER_OPTION 18: PARENT 18,10: TOP 18,0: LEFT 18,LEFT(16)+80: HEIGHT 18,40
                     COLOR 18,230,230,255: CAPTION 18,"  Nb de mois:"
OPTION 19: PARENT 19,18: TOP 19,18: LEFT 19,10: CAPTION 19,"12": MARK_ON 19
OPTION 20: PARENT 20,18: TOP 20,TOP(19): LEFT 20,LEFT(19)+55: CAPTION 20,"6"
OPTION 21: PARENT 21,18: TOP 21,TOP(19): LEFT 21,LEFT(20)+45: CAPTION 21,"3"
           FOR i = 19 TO 21: ON_CLICK i,Modm: NEXT i
CONTAINER_OPTION 25: PARENT 25,10: TOP 25,TOP(18)+40: LEFT 25,LEFT(18): HEIGHT 25,40
                     COLOR 25,230,255,230: CAPTION 25,"   1er mois :"
OPTION 26: PARENT 26,25: TOP 26,18: LEFT 26,0: CAPTION 26,"1": MARK_ON 26
OPTION 27: PARENT 27,25: TOP 27,TOP(26): LEFT 27,LEFT(26)+35: CAPTION 27,"4"
OPTION 28: PARENT 28,25: TOP 28,TOP(27): LEFT 28,LEFT(27)+35: CAPTION 28,"7"
OPTION 29: PARENT 29,25: TOP 29,TOP(28): LEFT 29,LEFT(28)+35: CAPTION 29,"10"
CONTAINER_OPTION 30: PARENT 30,10: TOP 30,TOP(25)+40: LEFT 30,LEFT(25)-20: HEIGHT 30,40
                     COLOR 30,230,255,255: CAPTION 30,"        Orientation:"
OPTION 31: PARENT 31,30: TOP 31,18: LEFT 31,5: CAPTION 31,"Portrait"
OPTION 32: PARENT 32,30: TOP 32,TOP(31): LEFT 32,LEFT(31)+80: CAPTION 32,"Paysage"
           MARK_ON 32: ON_CLICK 31,Modm: ON_CLICK 32,Modm
CHECK 35: PARENT 35,10: TOP 35,TOP(30)+55: LEFT 35,LEFT(25): CAPTION 35,CHR$(189)+" A4->"
          COLOR 35,255,230,230: ON_CLICK 35,Modm
CONTAINER_OPTION 36: PARENT 36,10: TOP 36,TOP(35)-8: LEFT 36,LEFT(35)+85
                     HEIGHT 36,40: COLOR 36,255,230,230
OPTION 37: PARENT 37,36: CAPTION 37,"Haut": MARK_ON 37
OPTION 38: PARENT 38,36:  TOP 38,TOP(37)+18: LEFT 38,LEFT(37): CAPTION 38,"Bas"
BUTTON 40: PARENT 40,10: TOP 40,HEIGHT(10)-63: LEFT 40,40: WIDTH 40,100
           CAPTION 40,"Créer": ON_CLICK 40,Exec
BUTTON 41: PARENT 41,10: TOP 41,TOP(40): WIDTH 41,60: LEFT 41,WIDTH(10)-80
           CAPTION 41,"Quitter": ON_CLICK 41,Qt
HIDE 27: HIDE 28: HIDE 29: HIDE 35: HIDE 36
da = 0: nm = 12: m1 = 1
END
' =============================================================================
Qt:
  TERMINATE
' =============================================================================
Modm:
  i = NUMBER_CLICk
  SELECT i
      CASE 19: nm = 12: HIDE 27: HIDE 28: HIDE 29
      CASE 20: nm = 6: HIDE 27: HIDE 29: SHOW 28
      CASE 21: nm = 3: SHOW 27: SHOW 28: SHOW 29
      CASE 31: MARK_OFF 35: SHOW 35
      CASE 32: HIDE 35: HIDE 36
      CASE 35: IF CHECKED(35) = 1 THEN SHOW 36:ELSE: HIDE 36
  END_SELECT
RETURN
' =============================================================================
Exec:
  HIDE 10
  m1 = 1
  IF nm = 6
      IF CHECKED(28) = 1 THEN m1 = 7
  ELSE
      IF nm = 3
          IF CHECKED(27) = 1 THEN m1 = 4
          IF CHECKED(28) = 1 THEN m1 = 7
          IF CHECKED(29) = 1 THEN m1 = 10
      END_IF
  END_IF
  dm = m1+nm-1: ' dernier mois
  an = POSITION(16)
  wf = 1100: hf = 778: ' A4 paysage implicite
  IF CHECKED(31) = 1
      wf = 778: hf = 1100: ' A4 portrait
      IF CHECKED(35) = 1 THEN hf = 550: ' 1/2 A4 portrait
  END_IF
  Cal_Annu(wf,hf,an,nm,m1)
  wf = 778: hf = 1100: IF CHECKED(32) = 1 THEN wf = 1100: hf = 778
  WIDTH 0,wf+16: HEIGHT 0,hf+34  
  WIDTH 1,wf: HEIGHT 1,hf

  2D_TARGET_IS 1: PRINT_TARGET_IS 1: FONT_SIZE 1,8: 2D_FILL_OFF
  CLIPBOARD_PASTE 2
  SHOW 0
  y = 0: IF CHECKED(35) = 1 AND CHECKED(38) = 1 THEN y = hf/2
  2D_IMAGE_PASTE 2,0,y
  FONT_COLOR 1,0,0,128
  ' Fêtes fixes
  m% = 1: j% = 1: a$ = "J.de.l'An": GOSUB Ajout
  m% = 5: j% = 1: a$ = "F.Travail": GOSUB Ajout
  m% = 5: j% = 8: a$ = "Vict.1945": GOSUB Ajout
  m% = 7: j% = 14: a$ = "Fête Nat.": GOSUB Ajout
  m% = 11: j% = 1: a$ = "Toussaint": GOSUB Ajout
  m% = 12: j% = 25: a$ = "NOËL": GOSUB Ajout
  ' Fêtes mobiles
  QPaques(an)
  Qjm(an,qpa): a$ = "Pâques": GOSUB Ajout
  Qjm(an,qas): a$ = "Ascension": GOSUB Ajout
  Qjm(an,qpe): a$ = "Pentecôte": GOSUB Ajout
  j% = yc(dm,2)-yc(dm,1): ' hauteur case
  a$ = "Cal_Annu.bas": i = TEXT_WIDTH(a$,1)
  PRINT_LOCATE xc(dm,30)-i,yc(dm,30)+2*j%-3: PRINT a$
  FILE_SAVE 1,fimp$
  IF MESSAGE_CONFIRMATION_YES_NO("Imprimer ?") = 1
      j% = 0: IF CHECKED(32) = 1 THEN j% = 1: ' orientation portrait/paysage
      Print_A4(fimp$,j%)
  END_IF
  FILE_DELETE fimp$
  SHOW 10
RETURN
' =============================================================================
Ajout:
  y = 0: IF CHECKED(35) = 1 AND CHECKED(38) = 1 THEN y = 550
  IF w1<70 THEN a$ = LEFT$(a$,4)
  IF m%>=m1 AND m%<=dm
      PRINT_LOCATE xc(m%,j%)+5,y+yc(m%,j%)-1: PRINT a$
  END_IF
RETURN
' =============================================================================
SUB Cal_Annu(wf,hf,an,nbm,m1)
  ' Ébauche calendrier A4 sur une surface de wf x hf pixels, marges comprises
  ' Année an, nbm = nombre de mois: 3, 6 ou 12 mois,
  ' 1er mois m1 = 1 ou 7 (6 mois), = 1,4,7 ou 10 (3 mois)
  ' résultat = image dans le presse-papier
  ' Coordonnées des cases rendues dans xc(m,j) et yc(m,j) (définis dans l'appelant)
  ' et dimensions dans w1 et h1: largeur et hauteur, variables créées si n'existent pas
  ' ***** Exemple: une case = 89 x 23 pixels pour 12 mois sur A4 paysage.
  DIM_LOCAL p,nm$(12),nj$(6),lm(12),x(12),y(32),x0,y0,yb,x1,y1,w,h,i
  DIM_LOCAL mm,jj,jk,jsd,rjs,a$
  p = 500: PICTURE p: HIDE p: WIDTH p,wf: HEIGHT p,hf
                      2D_TARGET_IS p: PRINT_TARGET_IS p: 2D_FILL_OFF
  nm$(1)="JANVIER": nm$(2)="FÉVRIER": nm$(3)="MARS": nm$(4)="AVRIL"
  nm$(5)="MAI": nm$(6)="JUIN": nm$(7)="JUILLET": nm$(8)="AOÙT"
  nm$(9)="SEPTEMBRE": nm$(10)="OCTOBRE": nm$(11)="NOVEMBRE": nm$(12)="DÉCEMBRE"                    
  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
  IF MOD(an,4)=0 AND (MOD(an,100)>0 OR MOD(an,400)=0) THEN lm(2) = 29
  nj$(0)="DI": nj$(1)="Lu": nj$(2)="Ma": nj$(3)="Me": nj$(4)="Je"
  nj$(5)="Ve": nj$(6)="Sa"
  ' Fonction des marges non imprimables de l'imprimante, à ajuster éventuellement:
  x0 = 18: y0 = 29: yb = 16: ' marges gauche, haut et bas (centré H)
  w = wf-2*x0: h = hf-y0-yb
  2D_PEN_WIDTH 2: 2D_RECTANGLE x0,y0,x0+w,y0+h
  IF nbm = 12 THEN m1 = 1: ' 1er mois
  IF VARIABLE("w1") = 0 AND VARIABLE("h1") = 0 THEN DIM w1,h1  
  w1 = w/nbm: h1 = h/32: ' dimensions d'une case (pixels)
  x(0) = x0
  FOR i = 1 TO nbm
      x(i) = x0+(i-1)*w1: 2D_LINE x(i),y0,x(i),y0+h
  NEXT i
  y(0) = y0
  2D_LINE x0,y0+h1,x0+w,y0+h1: 2D_PEN_WIDTH 1
  FOR i = 1 TO 32
      y(i) = y0 + (i-1)*h1: 2D_LINE x0,y(i),x0+w,y(i)
  NEXT i
  FONT_NAME p,"DejaVu Sans Mono": FONT_SIZE p,13
  PRINT_LOCATE w/2-20,y0-19: FONT_COLOR p,180,0,0: FONT_BOLD p: PRINT "- "+STR$(an)+" -": ' Année
  FONT_BOLD_OFF p: FONT_SIZE p,11: FONT_COLOR p,0,0,255
  IF w1 < 70 THEN FONT_SIZE p,9
  FOR i = 1 TO nbm: ' Noms de mois en tête
      mm = i+m1-1: a$ = nm$(mm): jj = TEXT_WIDTH(a$,p): jk = TEXT_HEIGHT(a$,p)
      x1 = x(i): y1 = y(1): 2D_FLOOD x1+2,y1+2,255,255,0: ' fond jaune
      PRINT_LOCATE x(i)+(w1-jj)/2,y(1)+(h1-jk)/2: PRINT a$
  NEXT i
  FONT_COLOR p,0,0,0: FONT_SIZE p,9
  IF w1 < 70 THEN FONT_SIZE p,8  
  FOR i = 1 TO nbm
      x1 = x(i)+4: y1 = y(2)+2
      mm = i+m1-1
      FOR jj = 1 TO lm(mm)
          ' jour semaine du jour jj, mois mm de l'année an -> rjs=0 Dim à 6 Sam
          jsd = an: IF mm<3 THEN jsd = jsd-1
          jsd=INT(23*mm/9)+jj+4+an+INT(jsd/4)-INT(jsd/100)+INT(jsd/400)
          IF mm>=3 THEN jsd = jsd-2
          rjs = jsd-7*INT(jsd/7): a$ = nj$(rjs)+RIGHT$(" "+STR$(jj),2): x1 = x(i)+4
          2D_FLOOD x1+2,y1+2,255,255,255
          IF rjs = 0 THEN FONT_COLOR p,128,0,0: 2D_FLOOD x1+2,y1+2,255,220,229
          PRINT_LOCATE x1,y1: PRINT a$: FONT_COLOR p,0,0,0
          IF VARIABLE("xc") > 0 AND VARIABLE("yc") > 0
              xc(mm,jj) = x1+TEXT_WIDTH(a$,p): yc(mm,jj) = y1: ' coordonnées de la case
          END_IF
          y1 = y1+h1
      NEXT jj
  NEXT i
  CLIPBOARD_COPY p
  2D_TARGET_IS 0: PRINT_TARGET_IS 0: DELETE p
END_SUB
' =============================================================================
SUB QPaques(Annee)
  ' Calcul du jour de Pâques (méthode de Gauss)
  ' Résultat jp et mp: jour et mois de Pâques
  ' Et dans qpa, qas, qpe, quantièmes de pâques, Ascension, Pentecôte
  ' Variables définies dans le progcramme appelant
  DIM_LOCAL R,S,T,B,M,C,N,P,J,jp,mp
  R = Annee-4*INT(Annee/4)
  S = Annee-7*INT(Annee/7)
  T = Annee-19*INT(Annee/19)
  B = 19*T+24
  M = B-30*INT(B/30)
  C = 2*R + 4*S + 6*M + 5
  N = C-7*INT(C/7)
  P = INT(M+N)
  IF P<=9
      J = P+22: M = 3: ' mars
  ELSE
      J = P-9: M = 4: ' avril
  END_IF
  jp = J: mp = M : ' jour et mois de Pâques
  qpa = 31+28: IF M = 4 THEN qpa = qpa+31
  qpa = qpa+J: ' quantième de Pâques
  IF (MOD(Annee,4)=0) AND ((MOD(Annee,100)>0) OR (MOD(Annee,400)=0)) THEN qpa=qpa+1
  qas = qpa + 39: qpe = qpa + 49: ' quantièmes Ascension et Pentecôte  
END_SUB
' =============================================================================
SUB Qjm(Annee,Q)
  ' Mois et jour en fonction du quantième -> m%, j% (définis dans l'appelant)
  DIM_LOCAL qt%,lm%,bi
  bi = 0: IF FRAC(Annee/4) = 0 AND FRAC(Annee/100) <> 0 THEN bi = 1
  IF FRAC(Annee/400) = 0 THEN bi = 1  
  m% = 1: qt% = 31
  IF Q<32
      j% = Q
  ELSE
      WHILE Q > qt%
          m% = m% + 1
          IF INSTR("4,6,9,11",STR$(m%)) > 0
          ' IF m% = 4 OR m% = 6 OR m% = 9 OR m% = 11
              lm% = 30
          ELSE
              IF m% = 2
                  lm% = 28 + bi
              ELSE
                  lm% = 31
              END_IF
          END_IF
          qt% = qt% + lm%
      END_WHILE
      j% = Q - qt% + lm%
  END_IF
END_SUB
' =============================================================================
SUB Print_A4(f$,ori%)
  ' Impression d'une image de page A4, orientation ori%=0 Portrait, =1 Paysage
  ' Dimensions conservées, seules manquent les marges non imprimables.
  ' Surface imprimée = 204 x 290 mm, centrée ~ sur 210x297
  ' ========> mesuré = 203,5 x 288,5 mm
  '   *************************************************************
  '   * Zone pixels imprimable sur une image A4 778 x 1100 pixels *
  '   *        largeur x = 11 à 766, hauteur y = 11 à 1087        *
  '   *************************************************************
  '   (NB valeurs peut-être fonction de l'imprimante, à voir).
  DIM_LOCAL wtp$,ft$,w$,h$,a$
  wtp$ = "C:\UTIL\WinTextPrint.exe": ' module 'Klaus'
  ft$ = "Z:\Balises.txt": ' fichier temporaire de manoeuvre  
  IF ori% = 0
      w$ = "210": h$ = "297": a$ = "<#orientation=Portrait#>"
  ELSE
      w$ = "297": h$ = "210": a$ = "<#orientation=Paysage#>"
  END_IF
  FILE_OPEN_WRITE 1,ft$
    FILE_WRITELN 1,a$+" <#image="+f$+","+STR$(-3)+","+STR$(-3)+","+w$+","+h$+"#>"
  FILE_CLOSE 1
  EXECUTE_WAIT wtp$+"|/file="+ft$  
  FILE_DELETE ft$
END_SUB
' =============================================================================