Aide-mémoire mensuel

' cal_mois.bas
' Calendrier d'un nombre donné de mois sur A4 portrait ou paysage
LABEL Exec,Feta,Afet,Impr
DIM ppm,x,y,w,h,nc,nr,r
DIM mg,mb,wm%,wj,hj%,an,m,m1,i,j,x1,y1,nm$(12),lm(12),js$(6),a$,aa$
DIM nbm,wp,hp,wt,ht,fz,ori%,fet$(16),rtmp$,i1
DIM jj%,mm%,jp,mp,qpa,qas,qpe,mas,jas,mpe,jpe,jma,joc,xf,yf
rtmp$ = "C:\TEMP\": ' répertoire pour fichiers temporaires
ppm = 1100/297: ' pixels par mm
' NOMS MOIS
DATA "Janvier","Février","Mars","Avril","Mai","Juin","Juillet","Août"
DATA "Septembre","Octobre","Novembre","Décembre"
FOR i = 1 TO 12: READ nm$(i): NEXT i
' LONGUEUR MOIS
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: ' nb de jours par mois
js$(0)="DIM": js$(1)="Lun": js$(2)="Mar": js$(3)="Mer": js$(4)="Jeu"
js$(5)="Ven":js$(6)="Sam"
' FETES FIXES
DATA "0101","Jour de l'An","0105","Fête du Travail","0805","Victoire 1945"
DATA "1407","Fête Nationale","1508","Assomption","0111","Toussaint"
DATA "1111","Armistice 1918","2512","Noël"
FOR i = 1 TO 16: READ fet$(i): NEXT i
' QUANTIEME DE PÂQUES
' Sub QPaques(), Conversion en date: sub Qjm()
'
' marges périphériques non imprimables: H/G/D = 8 pixels, Bas = 31 pixels
BORDER_SMALL 0: WIDTH 0,794: HEIGHT 0,1139:CAPTION 0,"===== PAGE A4 ====="
                FONT_SIZE 0,12
PICTURE 1: WIDTH 1,778: HEIGHT 1,1100: 2D_TARGET_IS 1: PRINT_TARGET_IS 1
FORM 5: BORDER_HIDE 5: TOP 5,TOP(0)+100: LEFT 5,LEFT(0)+100: WIDTH 5,220: HEIGHT 5,200
        COLOR 5,240,255,255: FONT_SIZE 5,12: FONT_COLOR 5,0,0,200
ALPHA 6: PARENT 6,5: TOP 6,15: LEFT 6,40: CAPTION 6,"  Année:"
SPIN 7: PARENT 7,5: LEFT 7,LEFT(6)+65: TOP 7,TOP(6)-3: WIDTH 7,60: POSITION 7,DATE_YEAR
ALPHA 8: PARENT 8,5: TOP 8,TOP(6)+30: LEFT 8,5
        CAPTION 8,"Mois par"+CHR$(10)+"  page :"
SPIN 9: PARENT 9,5: TOP 9,TOP(8)+8: LEFT 9,LEFT(8)+65: WIDTH 9,45: ' nb de mois
        MIN 9,1: MAX 9,12: POSITION 9,12: ' ON_CHANGE 9,Vmois
ALPHA 10: PARENT 10,5: TOP 10,TOP(8): LEFT 10,LEFT(9)+WIDTH(9)+10
          CAPTION 10," 1er"+CHR$(10)+"mois:"
SPIN 11: PARENT 11,5: TOP 11,TOP(9): LEFT 11,LEFT(10)+45: WIDTH 11,45
        MIN 11,1: MAX 11,12: POSITION 11,1
CONTAINER_OPTION 12: PARENT 12,5: TOP 12,TOP(11)+35: LEFT 12,20: HEIGHT 12,45
          CAPTION 12,"Orientation:"
OPTION 13: PARENT 13,12: TOP 13,20: LEFT 13,20: CAPTION 13,"Portrait"
OPTION 14: PARENT 14,12: TOP 14,TOP(13): LEFT 14,105: CAPTION 14,"Paysage"
          MARK_ON 14
CHECK 15: PARENT 15,5: TOP 15,TOP(12)+HEIGHT(12)+5: LEFT 15,40: WIDTH 15,150
          CAPTION 15,"Affichage des fêtes": FONT_ITALIC 15: MARK_ON 15       
BUTTON 18: PARENT 18,5: TOP 18,HEIGHT(5)-30: LEFT 18,40: WIDTH 18,50: CAPTION 18,"OK"
          ON_CLICK 18,Exec
BUTTON 19: PARENT 19,5: TOP 19,TOP(18): LEFT 19,WIDTH(5)-100
          CAPTION 19,"Imprimer": ON_CLICK 19,Impr
mg = 10: mb = 25: ' marges gauche/droite/haut et marge bas
END
' =============================================================================
Exec:
ori% = 0: IF CHECKED(14) = 1 THEN ori% = 1
SELECT ori%
    CASE 0: WIDTH 0,794: HEIGHT 0,1139: wp = 778: hp = 1100
            wt = wp-2*mg: ht = hp-mg-mb
    CASE 1: WIDTH 0,1139: HEIGHT 0,794: wp = 1100: hp = 778
            wt = wp-mg-mb: ht = hp-6*mg
END_SELECT
WIDTH 1,wp: HEIGHT 1,hp
2D_TARGET_IS 1: CLS: FONT_SIZE 1,12
2D_FILL_OFF
an = POSITION(7): lm(2) = 28: IF Bisex(an) = 1 THEN lm(2) = 29: ' bissextile
' 2D_RECTANGLE mg,mg,mg+wt,mg+ht: ' cadre externe
nbm = POSITION(9): ' nombre de mois
wm% = wt/nbm: ' largeur 1 mois
fz = 12
wj = 50: IF nbm > 8 THEN wj = 30: fz = 8
FONT_SIZE 1,fz
hj% = ht/32
an = POSITION(7): ' année
m1 = POSITION(11): ' 1er mois
GOSUB Feta:  ' jour et mois de Pâques, Ascension, Pentecôte
FOR i = 0 TO nbm-1
    m = m1+i
    IF m > 12
        m = 1: m1 = m-i: an = an+1: lm(2) = 28
        IF Bisex(an) = 1 THEN lm(2) = 29: ' bissextile
        GOSUB Feta
    END_IF
    x1 = mg+i*wm%: y1 = mg
    2D_RECTANGLE x1,y1,x1+wm%,y1+hj%: ' en-tête colonne = nom mois
    2D_FLOOD x1+5,y1+5,255,255,128: FONT_SIZE 1,fz
    a$ = nm$(m)+" "+STR$(an): j = TEXT_WIDTH(a$,1): x = x1+(wm%-j)/2
    PRINT_LOCATE x,y1+2: PRINT a$
    y = y1+hj%: FONT_SIZE 1,fz-2
    FOR j = 1 TO lm(m)
        2D_FILL_OFF
        2D_RECTANGLE x1,y,x1+wm%,y+hj%+1
        JourSem(an,m,j)
        IF rs_js% = 0 THEN 2D_FLOOD x1+5,y+5,255,220,220
        PRINT_LOCATE x1+3,y+3: PRINT js$(rs_js%)+" "+STR$(j)
        IF CHECKED(15) = 1 THEN GOSUB Afet
        y = y+hj%
    NEXT j
    2D_LINE x1+wj,y1+hj%,x1+wj,y
NEXT i
2D_FILL_OFF 
FONT_SIZE 1,8: FONT_ITALIC 1: PRINT_LOCATE x1+wm%-65,y+1: PRINT "cal_mois.bas"
FONT_ITALIC_OFF 1
RETURN
' =============================================================================
Feta:
  ' jour et mois de Pâques, Ascension, Pentecôte
  QPaques(an): ' -> jp,mp jour mois Pâques
  Qjm(an,qas): mas = mm%: jas = jj%: ' mois jour Ascension
  Qjm(an,qpe): mpe = mm%: jpe = jj%: ' mois jour Pentecôte
  '
  Ete_Hiver2(an): a$ = CLIPBOARD_STRING_PASTE$
  jma = VAL(LEFT$(a$,2)): joc = VAL(MID$(a$,4,2)): ' chgt heure 
RETURN
' =============================================================================
Afet:
  xf = x1+wj+3: yf = y+3: aa$ = ""
  ' Fêtes mobiles
  IF m = mp AND j = jp THEN PRINT_LOCATE xf,yf: aa$ = "Pâques "     
  IF m = mas AND j = jas THEN PRINT_LOCATE xf,yf: aa$ = "Ascension "
  IF m = mpe AND j = jpe THEN PRINT_LOCATE xf,yf: aa$ = "Pentecôte "
  IF m = 3 AND j = jma THEN aa$ = aa$+"(H=H+1)"
  IF m = 10 AND j = joc THEN aa$ = aa$+"(H=H-1)"
  IF aa$ <> "" THEN PRINT_LOCATE xf,yf: PRINT aa$
  ' Fêtes fixes
  FOR i1 = 1 TO 15 STEP 2
      a$ = fet$(i1): jj% = VAL(LEFT$(a$,2)): mm% = VAL(MID$(a$,3,2))
      IF j = jj% AND m = mm%
          PRINT_LOCATE xf,yf: PRINT fet$(i1+1): EXIT_FOR
      END_IF
  NEXT i1
RETURN
' =============================================================================
SUB Ete_Hiver2(annee)
' Jour de Mars (heure d'été) et Octobre (heure d'hiver) de l'année donnée
' (c'est le dernier dimanche du mois donné, été: +1/heure, hiver -1/heure)
' Résultat dans le clipboard, forme "xx,yy" = jour de mars,jour d'octobre
  DIM_LOCAL mo,jo,ah,bh,sh,aa$
  mo = 3-2: ' Mars-2
  sh = INT(annee/100): ah = annee-sh*100
  bh = INT(2.6*mo-.19)+31+ah+INT(ah/4)+INT(sh/4)-sh*2
  jo = 31-INT((bh/7-INT(bh/7))*7+.1): aa$ = STR$(jo)
  mo = 10-2: ' Octobre-2
  sh = INT(annee/100): ah = annee-sh*100
  bh = INT(2.6*mo-.19)+31+ah+INT(ah/4)+INT(sh/4)-sh*2
  jo = 31-INT((bh/7-INT(bh/7))*7+.1): aa$ = aa$+","+STR$(jo)
  CLIPBOARD_STRING_COPY aa$
END_SUB
' =============================================================================
Impr:
  IF DIR_EXISTS(rtmp$) = 0 THEN DIR_MAKE rtmp$
  FILE_SAVE 1,rtmp$+"Img.bmp": ' enregistrement pour impression
  A4_Print(rtmp$+"Img.bmp",ori%)
RETURN
' =============================================================================
FNC Bisex(An)
  ' Renvoie 1 si l'année est bissextile (0 sinon)
  RESULT 0
  IF (MOD(An,4)=0) AND ((MOD(An,100)>0) OR (MOD(An,400)=0)) THEN RESULT 1
END_FNC
' =============================================================================
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)
  ' 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
  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 -> mm%, jj% (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
  mm% = 1: qt% = 31
  IF Q<32
      jj% = Q
  ELSE
      WHILE Q > qt%
          mm% = mm% + 1
          IF INSTR("4,6,9,11",STR$(mm%)) > 0
              lm% = 30
          ELSE
              IF mm% = 2
                  lm% = 28 + bi
              ELSE
                  lm% = 31
              END_IF
          END_IF
          qt% = qt% + lm%
      END_WHILE
      jj% = Q - qt% + lm%
  END_IF
END_SUB
' =============================================================================
FNC ChoixImprimante$()
  DIM_LOCAL res%, nom$
  nom$ = string$(255," ")
  res% = DLL_call2("SelectWindowsPrinter",adr(nom$),len(nom$))
  nom$ = trim$(nom$)
  result nom$
END_FNC
' =============================================================================
SUB A4_Print(f$,ori%)
  ' Impression sur feuille A4 de l'image f$
  ' ori% = 0: portrait, =1: paysage
  DIM_LOCAL prn$,phnd%,chnd%,i%,j%,px,mg%,mh%,xi%,yi%,x,y,w,h,wi%,hi%
'  prn$ = "": ' impression sur l'imprimante implicite
  w = 210: h = 297: IF ori% = 1 THEN w = 297: h = 210: ' dimensions A4 en mm
  DLL_ON "KGF.dll" : ' "C:\PANORAMIC\KGF\KGF.dll": ' A AJUSTER !
  prn$ = ChoixImprimante$()
  i% = DLL_CALL4("PrinterManager",10,ADR(phnd%),ADR(chnd%),ADR(prn$)): ' init
  i% = DLL_CALL4("PrinterManager",4,ADR(phnd%),ADR(chnd%),ori%): ' orientation
  i% = DLL_CALL4("PrinterManager",1,ADR(phnd%),ADR(chnd%),0): ' init
  px = 7013/297: ' pixels par mm à l'impression (def. imprimante = 4962x7013 pixels)
  xi% = 0: yi% = 0: wi% = w*px: hi% = h*px: ' mm->pixels (valeurs entières exigées)
  mg% = 75: mh% = 75: xi% = xi%-mg%: yi% = yi%-mh%: ' compense décalage marges non imprimables
  j% = -2: i% = DLL_CALL6("PrinterFunction",6,ADR(phnd%),ADR(chnd%),0,j%,1)
  i% = DLL_CALL6("PrinterFunction",4,ADR(phnd%),ADR(chnd%),0,xi%,yi%): ' positionnement
  i% = DLL_CALL6("PrinterFunction",7,ADR(phnd%),ADR(chnd%),ADR(f$),wi%,hi%)
  i% = DLL_CALL4("PrinterManager",3,ADR(phnd%),ADR(chnd%),0): ' Lancement impression
  DLL_OFF
END_SUB
' =============================================================================

rtmp$ = "C:\TEMP\": ' répertoire pour fichiers temporaires

FNC ChoixImprimante$()
  DIM_LOCAL res%, nom$
  nom$ = string$(255," ")
  res% = DLL_call2("SelectWindowsPrinter",adr(nom$),len(nom$))
  nom$ = trim$(nom$)
  result nom$
END_FNC

' =============================================================================
FNC ChoixImprimante$()
  DIM_LOCAL res%, nom$
  nom$ = string$(255," ")
  res% = DLL_call2("SelectWindowsPrinter",adr(nom$),len(nom$))
  nom$ = trim$(nom$)
  result nom$
END_FNC
' =============================================================================
SUB A4_Print(f$,ori%)
  ' Impression sur feuille A4 de l'image f$
  ' ori% = 0: portrait, =1: paysage
  DIM_LOCAL prn$,phnd%,chnd%,i%,j%,px,mg%,mh%,xi%,yi%,x,y,w,h,wi%,hi%
'  prn$ = "": ' impression sur l'imprimante implicite
  w = 210: h = 297: IF ori% = 1 THEN w = 297: h = 210: ' dimensions A4 en mm
  DLL_ON "KGF.dll" : ' "C:\PANORAMIC\KGF\KGF.dll": ' A AJUSTER !
  prn$ = ChoixImprimante$()
  i% = DLL_CALL4("PrinterManager",10,ADR(phnd%),ADR(chnd%),ADR(prn$)): ' init
  i% = DLL_CALL4("PrinterManager",4,ADR(phnd%),ADR(chnd%),ori%): ' orientation
  i% = DLL_CALL4("PrinterManager",1,ADR(phnd%),ADR(chnd%),0): ' init
  px = 7013/297: ' pixels par mm à l'impression (def. imprimante = 4962x7013 pixels)
  xi% = 0: yi% = 0: wi% = w*px: hi% = h*px: ' mm->pixels (valeurs entières exigées)
  mg% = 75: mh% = 75: xi% = xi%-mg%: yi% = yi%-mh%: ' compense décalage marges non imprimables
  j% = -2: i% = DLL_CALL6("PrinterFunction",6,ADR(phnd%),ADR(chnd%),0,j%,1)
  i% = DLL_CALL6("PrinterFunction",4,ADR(phnd%),ADR(chnd%),0,xi%,yi%): ' positionnement
  i% = DLL_CALL6("PrinterFunction",7,ADR(phnd%),ADR(chnd%),ADR(f$),wi%,hi%)
message "i%="+str$(i%)+"  "+f$ 
  i% = DLL_CALL4("PrinterManager",3,ADR(phnd%),ADR(chnd%),0): ' Lancement impression
  DLL_OFF
END_SUB
' =============================================================================