Un petit calendrier

DIM wc,hc,w1,h1,mg,mh,eh,ev,x,y,x0,y0,x1,y1,m1,j1,wt,i%,j%,k%,a$
DIM lm(12),m$(12),j$(7),an,fig,sz%,st%,iv$,pt$,pc%
LABEL Crea,Imprime
iv$ = "C:\Progra~2\Irfanv~1\i_view64.exe"

m$(1)="Janvier": m$(2)="Février": m$(3)="Mars": m$(4)="Avril": m$(5)="Mai"
m$(6)="Juin": m$(7)="Juillet": m$(8)="Août": m$(9)="Septembre"
m$(10)="Octobre": m$(11)="Novembre": m$(12)="Décembre"
j$(1)="Lu": j$(2)="Ma": j$(3)="Me": j$(4)="Je": j$(5)="Ve": j$(6)="Sa"
j$(7)="Di"
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

BORDER_SMALL 0: COLOR 0,96,180,180: CAPTION 0,"   -   CALENDRIER   -"
PICTURE 1: TOP 1,0: LEFT 1,0: ' 2D_TARGET_IS 1: PRINT_TARGET_IS 1: 2D_FILL_OFF
PANEL 2: HIDE 2: WIDTH 2,WIDTH(0): HEIGHT 2,30: FONT_BOLD 2: FONT_SIZE 2,10: COLOR 2,255,164,164
BUTTON 3: PARENT 3,2: TOP 3,5: LEFT 3,45: CAPTION 3,"Imprimer": ON_CLICK 3,Imprime
ALPHA 4: PARENT 4,2: TOP 4,TOP(3)+4: LEFT 4,LEFT(3)+80: FONT_COLOR 4,0,0,128
  CAPTION 4,"IrfanView:'Fichier','Imprimer',cocher'Impression sans bords'"
FORM 50: FONT_SIZE 50,10: FONT_BOLD 50: BORDER_SMALL 50: COLOR 50,255,190,255
  TOP 50,30: LEFT 50,10: WIDTH 50,260
ALPHA 51: PARENT 51,50: TOP 51,4: LEFT 51,40: CAPTION 51,"Année :"
SPIN 52: PARENT 52,50: TOP 52,TOP(51)-3: LEFT 52,LEFT(51)+50: WIDTH 52,60
  POSITION 52,VAL(RIGHT$(DATE$,4))
' ALPHA 53: PARENT 53,50: TOP 53,TOP(51)+25: CAPTION 53,"Format :"
CONTAINER_OPTION 55: PARENT 55,50: TOP 55,TOP(52)+30: HEIGHT 55,140: WIDTH 55,140
  CAPTION 55,"---- FORMAT : -": COLOR 55,255,255,190
OPTION 56: PARENT 56,55: TOP 56,20: LEFT 56,10: CAPTION 56,"A4 portrait"
OPTION 57: PARENT 57,55: TOP 57,TOP(56)+20: LEFT 57,LEFT(56): CAPTION 57,"A4 /2 paysage"
  WIDTH 57,145
OPTION 58: PARENT 58,55: TOP 58,TOP(57)+55: LEFT 58,LEFT(57): CAPTION 58,"A4 /4 portrait"
  MARK_ON 58
CONTAINER_OPTION 60: PARENT 60,50: TOP 60,TOP(55)+TOP(57)-5: LEFT 60,LEFT(55)+WIDTH(55)-10
  WIDTH 60,80: HEIGHT 60,30: COLOR 60,255,255,190
OPTION 61: PARENT 61,60: LEFT 61,0: CAPTION 61,"Gauche": MARK_ON 61
OPTION 62: PARENT 62,60: LEFT 62,LEFT(61): TOP 62,TOP(61)+16: CAPTION 62,"Droite"
CONTAINER_OPTION 65: PARENT 65,50: TOP 65,TOP(55)+TOP(58)-20: LEFT 65,LEFT(60)
  WIDTH 65,110: HEIGHT 65,65: COLOR 65,255,255,190
OPTION 66: PARENT 66,65: LEFT 66,0: CAPTION 66,"Haut/gauche": MARK_ON 66
OPTION 67: PARENT 67,65: TOP 67,TOP(66)+16: CAPTION 67,"Haut/droite"
OPTION 68: PARENT 68,65: TOP 68,TOP(67)+16: CAPTION 68,"Bas/gauche"
OPTION 69: PARENT 69,65: TOP 69,TOP(68)+16: CAPTION 69,"Bas/droite"
BUTTON 80: PARENT 80,50: TOP 80,HEIGHT(50)-60: LEFT 80,WIDTH(50)/2-40: CAPTION 80,"OK"
  ON_CLICK 80,Crea
PICTURE 100: HIDE 100: pc% = 100
END
' ==============================================================================
Crea:
  HIDE 50
  an = POSITION(52): ' Année
  lm(2) = 28: Bisex(an): IF bsx% = 1 THEN lm(2) = 29
  IF CHECKED(56) = 1 THEN fig = 1
  IF CHECKED(57) = 1 THEN fig = 2
  IF CHECKED(58) = 1 THEN fig = 3
  HEIGHT 0,SCREEN_Y-25: COLOR 0,0,128,128: j% = HEIGHT_CLIENT(0)
  IF fig = 1 OR fig = 3
      HEIGHT 1,1100: IF HEIGHT(1)>j% THEN HEIGHT 1,j%-20
      WIDTH 1,HEIGHT(1)*210/297: WIDTH 0,WIDTH(1)+20
      WIDTH pc%,778: HEIGHT pc%,1100
  ELSE
      HEIGHT 1,778: IF HEIGHT(1)>j% THEN HEIGHT 1,j%
      WIDTH 1,HEIGHT(1)*297/210: WIDTH 0,WIDTH(1)+20
      WIDTH pc%,1100: HEIGHT pc%,778
  END_IF
  STRETCH_ON 1
  2D_TARGET_IS pc%: CLS: 2D_PEN_COLOR 128,128,128: 2D_PEN_DOT
  x0 = 0: y0 = 0
  SELECT fig
      CASE 1: ' A4 plein format
              sz% = 14: st% = 18
              mg = 20: mh = 40: eh = 20: ev = 15: wc = 51: hc = 20
      CASE 2: ' 1/2 A4 (paysage)
              2D_LINE 550,0,550,778
              sz% = 10: st% = 16
              mg = 18: mh = 40: eh = 14: ev = 8: wc = 36: hc = 14
              IF CHECKED(62) = 1 THEN x0 = 550: y0 = 0: ' partie droite
      CASE 3: ' 1/4 A4 (portrait)
              2D_LINE 389,0,389,1100: 2D_LINE 0,550,778,550
              sz% = 7: st% = 12
              mg = 18: mh = 26: eh = 18: ev = 6: wc = 24: hc = 10
              IF CHECKED(67) = 1 THEN x0 = 389: y0 = 0: ' coin supérieur droit
              IF CHECKED(68) = 1 THEN x0 = 0: y0 = 550: ' coin inférieur gauche
              IF CHECKED(69) = 1 THEN x0 = 389: y0 = 550: ' coin inférieur droit
  END_SELECT
  w1 = wc*7: h1 = hc*8
  2D_FILL_OFF: 2D_PEN_SOLID: 2D_pen_width 2
  PRINT_TARGET_IS pc%: FONT_SIZE pc%,sz%: FONT_BOLD pc%
  m1 = 1: y = y0+mh
  FOR i% = 1 TO 6
    x = x0+mg
    FOR j% = 1 TO 2
        2D_RECTANGLE x,y,x+w1,y+h1
        FONT_COLOR pc%,0,0,255
        a$ = m$(m1): wt = TEXT_WIDTH(a$,pc%)
        PRINT_LOCATE x+(w1-wt)/2,y: PRINT a$: ' mois
        FONT_COLOR pc%,0,96,0
        FOR k% = 0 TO 6: ' jour semaine
            a$ = j$(k%+1): wt = TEXT_WIDTH(a$,pc%)
            PRINT_LOCATE x+k%*wc+(wc-wt)/2,y+hc: PRINT a$
        NEXT k%
        FONT_COLOR pc%,0,0,0
        y1 = y+2*hc
        FOR k% = 1 TO lm(m1): ' jour mois
            Joursem(an,m1,k%): j_s% = j_s%-1
            a$ = STR$(k%): wt = TEXT_WIDTH(a$,pc%)
            x1 = x+wc*j_s%
            PRINT_LOCATE x1+(wc-wt)/2,y1: PRINT a$
            IF j_s% = 6 THEN y1 = y1+hc
        NEXT k%
        2D_RECTANGLE x,y,x+w1,y+h1    
        m1 = m1+1
        x = x+w1+eh
    NEXT j%
    y = y+h1+ev
  NEXT i%
  FONT_SIZE pc%,st%: FONT_BOLD pc%: FONT_COLOR pc%,255,0,0
  a$ = STR$(an): i% = TEXT_WIDTH(a$,pc%): j% = TEXT_HEIGHT(a$,pc%)
  PRINT_LOCATE x0+mg+w1+eh/2-i%/2,y0+mh-j%: PRINT STR$(an): ' année
  clipboard_copy pc%: clipboard_paste 1
  TOP 2,HEIGHT(0)-65: LEFT 2,(WIDTH(0)-WIDTH(2))/2
  IF TOP(2) > (SCREEN_Y-90) THEN TOP 2,SCREEN_Y-90
  SHOW 2
RETURN
' ==============================================================================
Imprime:
  ' impression avec IrfanView
  CLIPBOARD_COPY pc%
  EXECUTE_WAIT iv$+"|/clippaste"
RETURN  
  ' impression avec MsPaint:
  file_save 1,"Z:\Cal.bmp"
  pt$ = "HP Photosmart B109a-m (Copie 1)"
  EXECUTE_WAIT "C:\Windows\system32\mspaint.exe|/pt Z:\Cal.bmp "+chr$(34)+pt$+chr$(34)
  ' -> impression image réduite (dimensions x 0,88 ...)
RETURN
' ==============================================================================
SUB Joursem(Annee,Mois,Jour)
  ' Jour de la semaine d'une date donnée (1= Lundi à 7= Dimanche) -> j_s%
  DIM_LOCAL jd
  IF VARIABLE("j_s%") = 0 THEN DIM j_s%
  jd = Annee
  IF Mois<3 THEN jd = jd-1
  jd = INT(23*Mois/9)+Jour+4+Annee+INT(jd/4)-INT(jd/100)+INT(jd/400)
  IF Mois>=3 THEN jd = jd-2
  j_s% = jd-7*INT(jd/7): IF j_s% = 0 THEN j_s% = 7
END_SUB
' ==============================================================================
SUB Bisex(Annee)
    IF VARIABLE("bsx%") = 0 THEN DIM bsx%
    bsx% = 0
    IF (FRAC(Annee/4)=0 AND FRAC(Annee/100)>0) OR FRAC(Annee/400)=0 THEN bsx% = 1
END_SUB
' ==============================================================================