Planche de photos sur A4 (mise à jour)

' ******** PhotA4.bas impression de planches de photos sur feuille A4 ********
DIM w0, h0, t1, l1, w1, h1
DIM xmm, yd, xd, eh, ev, wi, hi, hr, wr, tp%, lp%, ty%, x, y
DIM oo, nc, nr, nbt, ppic, dpic, npic, i%, j%, k%, r%, rota%, tpr%
DIM mg, md, mh, mb, lu, hu, legd
DIM Type, ori(16), col(16), ran(16), ecv(16), ech(16), ww(16), hh(16), mmg(16), mmh(16)
DIM img$(120), ima$(120), wim%(120), him%(120), dt$(120), wir%(120), hir%(120), lgn$(120)
DIM wtp$, iview$, f$, s$, sr$, rep$, fm$, tx$, nimp$
DIM fj$, fr$, fprn$, a$, w%, h%, dat$, nob, tob, hob, lob
DIM Fonte$, szf%
DIM phnd%, chnd%

LABEL Fin, Dimpic, Despic, Dir, Opt, Leg, Prepa, Jpgdim, Retrep
LABEL Sel, Desel, Tousel, Razsel
LABEL Chrep, Prn, Aide

' ************ PATH DES FICHIERS A AJUSTER SELON CONDITIONS LOCALES **************
wtp$ = "C:\Util\WinTextPrint.exe ": ' programme de Klaus
iview$ = "C:\Progra~1\Irfanv~1\i_view32.exe "
fm$ = "Z:\Dir.tmp"
fprn$ = "Z:\Fprn.txt"
' ********************************************************************************
fj$ = fm$
Fonte$ = "Arial": ' Pour l'impression des légendes
szf% = 10: ' taille fonte
rota% = 1: ' rotation implicite des images verticales

EXECUTE "Command.com /c DEL Z:\Z_Image*.jpg"
mg = 2.5: md = 3.5: mh = 3: mb = 10: ' marges non imprimables sur A4 (millimètres)
lu = 210 - mg - md: ' largeur utile sur la page A4, en millimètres
hu = 297 - mh - mb: ' hauteur utile sur la page A4, en millimètres
' En fonction du Type: orientation (0: horizontal, 1: vertical), nb de colonnes,
' nb de rangées, écart vertical, écart horizontal, largeur image, hauteur image.
ori(1) = 1: col(1) = 1: ran(1) = 1: ecv(1) = 4: ech(1) = 8: ww(1) = 204: hh(1) = 272
ori(2) = 0: col(2) = 1: ran(2) = 2: ecv(2) = 4: ech(2) = 8: ww(2) = 180: hh(2) = 135
ori(3) = 1: col(3) = 2: ran(3) = 2: ecv(3) = 4: ech(3) = 8: ww(3) = 100: hh(3) = 133
mmg(1) = 2: mmg(2) = 14: mmg(3) = 1: mmg(4) = 1: mmg(5) = 2: mmg(6) = 1: mmg(7) = 1
mmg(8) = 3: mmg(9) = 3: mmg(10) = 3: mmg(11) = 4
FOR i% = 1 TO 11: mmh(i%) = 0: NEXT i%
oo = 0: nc = 2: nr = 3: ev = 2: eh = 10: GOSUB Dimpic
ori(4) = oo: col(4) = nc: ran(4) = nr: ecv(4) = ev: ech(4) = eh: ww(4) = wi: hh(4) = hi
oo = 1: nc = 3: nr = 3: ev = 4: eh = 10: GOSUB Dimpic
ori(5) = oo: col(5) = nc: ran(5) = nr: ecv(5) = ev: ech(5) = eh: ww(5) = wi: hh(5) = hi
oo = 0: nc = 3: nr = 5: ev = 4: eh = 8: GOSUB Dimpic
ori(6) = oo: col(6) = nc: ran(6) = nr: ecv(6) = ev: ech(6) = eh: ww(6) = wi: hh(6) = hi
oo = 0: nc = 4: nr = 7: ev = 4: eh = 5: GOSUB Dimpic
ori(7) = oo: col(7) = nc: ran(7) = nr: ecv(7) = ev: ech(7) = eh: ww(7) = wi: hh(7) = hi
oo = 0: nc = 5: nr = 9: ev = 4: eh = 4: GOSUB Dimpic
ori(8) = oo: col(8) = nc: ran(8) = nr: ecv(8) = ev: ech(8) = eh: ww(8) = wi: hh(8) = hi
oo = 0: nc = 6: nr = 10: ev = 3: eh = 5: GOSUB Dimpic
ori(9) = oo: col(9) = nc: ran(9) = nr: ecv(9) = ev: ech(9) = eh: ww(9) = wi: hh(9) = hi
oo = 0: nc = 7: nr = 12: ev = 3: eh = 5: GOSUB Dimpic
ori(10) = oo: col(10) = nc: ran(10) = nr: ecv(10) = ev: ech(10) = eh: ww(10) = wi: hh(10) = hi
oo = 0: nc = 8: nr = 14: ev = 3: eh = 4: GOSUB Dimpic
ori(11) = oo: col(11) = nc: ran(11) = nr: ecv(11) = ev: ech(11) = eh: ww(11) = wi: hh(11) = hi

h0 = SCREEN_Y - 30
w0 = h0
WIDTH 0, w0: HEIGHT 0, h0
CAPTION 0, "    IMPRESSION DE PLANCHES DE PHOTOS SUR A4"
COLOR 0, 255,255,220
h1 = h0-70: w1 = h1*210/297: t1 = 20: l1 = w0-w1-40
PICTURE 99: TOP 99, t1+10: LEFT 99, l1+10: WIDTH 99, w1: HEIGHT 99, h1
COLOR 99, 160,160,160
PICTURE 100: TOP 100, t1: LEFT 100, l1: WIDTH 100, w1: HEIGHT 100, h1
2D_TARGET_IS 100: 2D_PEN_COLOR 160,160,160: 2D_RECTANGLE 0, 0, w1, h1
xmm = w1/210: ' 1 mm = xmm pixels

ppic = 101: dpic = ppic - 1
rep$ = ""

' Choix du format (rangées, colonnes)
CONTAINER_OPTION 10: TOP 10, 5: LEFT 10, 10: WIDTH 10, 160: HEIGHT 10, 220
FONT_BOLD 10: FONT_SIZE 10, 12
CAPTION 10, " FORMAT: "
i% = 11: tp% = 20
FOR i% = 11 TO 21
    OPTION i%: PARENT i%, 10: TOP i%, tp%: LEFT i%, 20
    SELECT i%
        CASE 11: a$ = " 1"
        CASE 12: a$ = " 1  x  2"
        CASE 13: a$ = " 2  x  2"
        CASE 14: a$ = " 2  x  3"
        CASE 15: a$ = " 3  x  3"
        CASE 16: a$ = " 3  x  5"
        CASE 17: a$ = " 4  x  7"
        CASE 18: a$ = " 5  x  9"
        CASE 19: a$ = " 6  x  10"
        CASE 20: a$ = " 7  x  12"
        CASE 21: a$ = " 8  x  14"
    END_SELECT
    CAPTION i%, a$: ON_CLICK i%, Opt
    tp% = tp% + 18
NEXT i%

' Choix de la légende éventuelle
CONTAINER_OPTION 30: TOP 30, 100: LEFT 30, 180: WIDTH 30, 160: HEIGHT 30, 100
FONT_BOLD 30: FONT_SIZE 30, 12
CAPTION 30, " LÉGENDES "
OPTION 31: PARENT 31, 30: TOP 31, 20: LEFT 31, 10: CAPTION 31, "Aucune"
OPTION 32: PARENT 32, 30: TOP 32, 40: LEFT 32, 10: CAPTION 32, "Nom"
OPTION 33: PARENT 33, 30: TOP 33, 60: LEFT 33, 10: CAPTION 33, "Nom + Date"
OPTION 34: PARENT 34, 30: TOP 34, 80: LEFT 34, 10: CAPTION 34, "Nom + Dimensions"
legd = 3: MARK_ON legd+30
FOR i% = 31 TO 34: ON_CLICK i%, Leg: NEXT i%
ALPHA 36: TOP 36,200: LEFT 36,180: FONT_SIZE 36, 10: CAPTION 36, "Police: " + Fonte$
ALPHA 37: TOP 37,216: LEFT 37,180: FONT_SIZE 37, 10: CAPTION 37, "Taille: " + STR$(szf%)
CHECK 38: TOP 38, 230: LEFT 38, 30: WIDTH 38, 300
FONT_BOLD 38: FONT_SIZE 38, 10: CAPTION 38, "Pivoter les images si  H > L"
MARK_ON 38

BUTTON 3: TOP 3, 40: LEFT 3, 180: WIDTH 3, 160
CAPTION 3, "Imprimer": ON_CLICK 3, Prn
BUTTON 4: TOP 4, 10: LEFT 4, 180: WIDTH 4, 80
CAPTION 4, "Aide": ON_CLICK 4, Aide
BUTTON 5: TOP 5, 10: LEFT 5, 260: WIDTH 5, 80
CAPTION 5, "Quitter": ON_CLICK 5, Fin
BUTTON 6: TOP 6, 70: LEFT 6, 180: WIDTH 6, 160
CAPTION 6, "Aperçu": ON_CLICK 6, Prepa
FOR i% = 3 TO 6: FONT_BOLD i%: FONT_SIZE i%, 12: NEXT i%


tpr% = 255: BUTTON 40: TOP 40, tpr%: LEFT 40, 10: HEIGHT 40, 25: WIDTH 40, 330
FONT_BOLD 40: FONT_SIZE 40, 12
CAPTION 40, "RÉPERTOIRE": ON_CLICK 40, Chrep

LIST 41: TOP 41, tpr%+45: LEFT 41, 10: WIDTH 41, 160: HEIGHT 41, h0-tpr%-100
FONT_NAME 41, "Arial": FONT_SIZE 41, 10
ON_CLICK 41, Sel

LIST 42: TOP 42, tpr%+45: LEFT 42, 180: WIDTH 42, 160: HEIGHT 42, h0-tpr%-100
FONT_NAME 42, "Arial": FONT_SIZE 42, 10
ON_CLICK 42, Desel
ALPHA 43: TOP 43, tpr%+25: LEFT 43, 200: WIDTH 43, 160
FONT_BOLD 43: FONT_SIZE 43, 12: CAPTION 43, "Sélect:  0"
ALPHA 45: TOP 45, tpr%+25: LEFT 45, 30: WIDTH 45, 160
FONT_BOLD 45: FONT_SIZE 45, 12: CAPTION 45, "Total: 0"
BUTTON 7: TOP 7, tpr%+27: LEFT 7, 130: WIDTH 7, 40: HEIGHT 7, 17
CAPTION 7, "TOUT": ON_CLICK 7, Tousel
BUTTON 8: TOP 8, tpr%+27: LEFT 8, 300: WIDTH 8, 40: HEIGHT 8, 17
CAPTION 8, "RAZ": ON_CLICK 8, Razsel

ALPHA 50: TOP 50, 0: LEFT 50, l1+w1/4
FONT_BOLD 50: FONT_SIZE 50, 12: CAPTION 50, "IMPRESSION D'UNE PLANCHE DE PHOTOS SUR A4"
Type = 3: MARK_ON Type+10

GOSUB Despic
END

Fin:
TERMINATE

' ============================== SOUS-PROGRAMMES ===============================
Chrep:
' Choix du répertoire des images
OPEN_DIALOG 98
f$ = FILE_NAME$(98)
IF f$ = "_" THEN GOTO Retrep
FOR i% = LEN(f$) TO 1 STEP -1
    IF MID$(f$, i%, 1) = "" THEN EXIT_FOR
NEXT i%
rep$ = LEFT$(f$, i%)
CAPTION 40, "Rép: " + rep$
GOSUB Dir
FILE_LOAD 41, fm$: FILE_DELETE fm$
CAPTION 45, "Total: " + STR$(COUNT(41))
IF COUNT(42) > 0
    CLEAR 42: nsel% = 0
END_IF
Retrep:
DELETE 98
RETURN

Prn:
' Création du fichier d'impression, et lancement de WinTextPrint
IF rep$ = "" OR img$(1) = "" THEN RETURN: ' pas d'images choisies
r% = MESSAGE_CONFIRMATION_YES_NO("Prêt pour impression")
IF r% = 2 THEN RETURN
FILE_OPEN_WRITE 1, Fprn$
FILE_WRITELN 1, "<#font=" + Fonte$ + "#><#fontsize=" + STR$(szf%) + "#>"
FOR j% = 1 TO nr
    tp% = (j%-1) * (hi+eh)
    FOR i% = 1 TO nc
        lp% = (i%-1) * (wi + ev)
        k% = (j%-1)*nc + i%
        IF k% > COUNT(42) THEN EXIT_FOR
        a$ = "<#image=" + ima$(k%) + "," + STR$(lp%) + "," + STR$(tp%)
        a$ = a$ + "," + STR$(wir%(k%)) + "," + STR$(hir%(k%)) + "#>"
        FILE_WRITELN 1, a$
        IF legd > 1
            a$ = "<#posabs=" + STR$(lp%) + "," + STR$(tp% + hir%(k%)) + "#>"
            a$ = a$ + lgn$(k%)
            FILE_WRITELN 1, a$
        END_IF
    NEXT i%
NEXT j%
FILE_CLOSE 1
a$ = "/file=" + fprn$
a$ = a$ + " /noshow": ' mode silencieux
EXECUTE wtp$ + a$
RETURN

Dimpic:
' dimensions de chaque vignette
wi = INT((lu + ev*(1-nc))/nc)
IF oo = 0
    hi = INT(3*wi/4): ' images horizontales sur la page
ELSE
    hi = INT(4*wi/3): ' images verticales sur la page
END_IF
RETURN

DesPic:
' Affichage des images dans chaque vignette
nc = col(Type): nr = ran(Type): ev = ecv(Type): eh = ech(Type)
wi = ww(Type): hi = hh(Type): nbt = nc*nr
yd = t1 + xmm*(mh+mmh(Type)): xd = l1 + xmm*(mg+mmg(Type))
IF (dpic-ppic) >= 0
    FOR i% = ppic to dpic: DELETE i%: NEXT i%
END_IF
2D_CLEAR: 2D_FILL_COLOR 255, 255, 255: 2D_RECTANGLE 0, 0, w1, h1
npic = ppic
FOR j% = 1 TO nr
    tp% = yd + (j%-1)*(xmm*hi + xmm*eh)
    FOR i% = 1 TO nc
        lp% = xd + (i%-1)*(xmm*wi + xmm*ev)
        PICTURE npic: TOP npic, tp%: LEFT npic, lp%
        WIDTH npic, xmm*wi: HEIGHT npic, xmm*hi
        COLOR npic, 200, 255, 255
        dpic = npic: npic = npic + 1
    NEXT i%
NEXT j%
RETURN

Dir:
' Liste des images du répertoire choisi dans fm$
sr$ = DIR_CURRENT$
DIR_CHANGE rep$
FILE_OPEN_WRITE 1, fm$
f$ = FILE_FIND_FIRST$
WHILE f$ <> "_"
    s$ = UPPER$(RIGHT$(f$, 4))
    IF s$ = ".JPG" OR s$ = ".BMP" THEN FILE_WRITELN 1, f$
    f$ = FILE_FIND_NEXT$
END_WHILE
FILE_FIND_CLOSE
FILE_CLOSE 1
DIR_CHANGE sr$
RETURN

Opt:
' Clic sur une option de format (colonnes x rangées)
FOR i% = 11 TO 20
    IF CLICKED(i%) = 1 THEN EXIT_FOR
NEXT i%
Type = i% - 10
szf% = 10
IF Type > 5
    szf% = 8
    IF Type > 8
        szf% = 6
    END_IF
END_IF
CAPTION 37, "Taille: " + STR$(szf%)
GOSUB Despic
RETURN

Leg:
' Clic sur une option de légende
FOR i% = 31 TO 34
    IF CLICKED(i%) = 1 THEN EXIT_FOR
NEXT i%
legd = i% - 30: GOSUB Despic
RETURN

Sel:
x = ITEM_INDEX(41)
ITEM_ADD 42, ITEM_READ$(41, x)
CAPTION 43, "Sélect:  " + STR$(COUNT(42))
RETURN

Desel:
x = ITEM_INDEX(42)
ITEM_DELETE 42, x
CAPTION 43, "Sélect:  " + STR$(COUNT(42))
RETURN

Tousel:
CLEAR 42
IF COUNT(41) > 0
    FOR i% = 1 TO COUNT(41)
        ITEM_ADD 42, ITEM_READ$(41, i%)
    NEXT i%
END_IF
RETURN

Razsel:
CLEAR 42
RETURN

Prepa:
' Préparation des images à partir du fichier image cliqué et suivants
IF COUNT(42) = 0 THEN RETURN: ' pas de sélections
GOSUB Despic
rota% = 0: IF CHECKED(38) = 1 THEN rota% = 1
PRINT_TARGET_IS 0: FONT_NAME 0, Fonte$: FONT_SIZE 0, szf%
FOR i% = 1 TO nc*nr
    IF i% > COUNT(42) THEN EXIT_FOR
    s$ = ITEM_READ$(42, i%)
    f$ = rep$ + s$
    img$(i%) = f$
    GOSUB Jpgdim
    wim%(i%) = w%: him%(i%) = h%: dt$(i%) = dat$
    ima$(i%) = f$: wr = w%: hr = h%
    wir%(i%) = wi: hir%(i%) = hi
    IF rota% = 1
        IF (w% > h% AND ori(Type) = 1) OR (w% <= h% AND ori(Type) = 0)
            fr$ = "Z:\Z_Image"+STR$(i%)+".jpg"
            EXECUTE_WAIT iview$ + f$ + " /rotate_l /convert=" + fr$
            ima$(i%) = fr$
            k% = w%: w% = h%: h% = k%
        END_IF
    END_IF
    nob = ppic + i% - 1
    wr = wi: hr = hi
    IF (w%/h%) > (wi/hi)
        hr = wi*h%/w%: HEIGHT nob, xmm*hr
    ELSE
        IF (w%/h%) < (wi/hi)
            wr = hi*w%/h%: WIDTH nob, xmm*wr
        END_IF
    END_IF
    IF wr <> wi OR hr <> hi THEN wir%(i%) = wr: hir%(i%) = hr
    FILE_LOAD nob, ima$(i%): STRETCH_ON nob
    tob = TOP(nob): lob = LEFT(nob): hob = HEIGHT(nob)
    lgn$(i%) = ""
    IF legd > 1
        tx$ = s$
        IF legd = 3
            tx$ = s$ + " " + dat$
        ELSE
            IF legd = 4
                tx$ = s$ + " ("+STR$(wim%(i%))+"x"+STR$(him%(i%))+")"
            END_IF
        END_IF
        lgn$(i%) = tx$
        PRINT_LOCATE lob, tob+hob: PRINT tx$
    end_if
NEXT i%
RETURN

Jpgdim:
' caractéristiques du fichier jpg f$: w%, h%, dat$ (appel fonction d'IrfanView)
EXECUTE_WAIT iview$ + f$ + " /info=" + fj$
FILE_OPEN_READ 80, fj$
REPEAT
    FILE_READLN 80, a$
UNTIL LEFT$(a$, 16) = "Image dimensions"
a$ = MID$(a$, 20, LEN(a$)-19)
k% = INSTR(a$, " "): w% = VAL(LEFT$(a$, k%-1))
a$ = MID$(a$, k% + 3, LEN(a$) - k% - 2)
k% = INSTR(a$, " ") : h% = VAL(LEFT$(a$, k%-1))
REPEAT
    FILE_READLN 80, a$
UNTIL LEFT$(a$, 9) = "File date"
dat$ = MID$(a$, 18, 10): dat$ = dat$ + MID$(a$, 30, 6)
FILE_CLOSE 80: FILE_DELETE fj$
RETURN

Aide:
a$ = CHR$(9) + "** IMPRESSION D'UNE PLANCHE DE PHOTOS SUR UNE PAGE A4 **"
a$ = a$ + CHR$(10)+CHR$(10)
a$ = a$ + "- Choisir le format d'impression (nombre d'images sur la page):"
a$ = a$ + CHR$(10) + CHR$(9)+"Cliquer l'option choisie (de 1 à 112 images par page)."
a$ = a$ + CHR$(10)+CHR$(10)
a$ = a$ + "- Choisir le répertoire contenant les images à imprimer:"
a$ = a$ + CHR$(10) + CHR$(9)+"- Cliquer sur [RÉPERTOIRE], parcourir les répertoires, et cliquer sur une image"
a$ = a$ + CHR$(10) + CHR$(9)+"  quelconque du répertoire."
a$ = a$ + CHR$(10)+CHR$(10)
a$ = a$ + "- Choisir les images à imprimer:"
a$ = a$ + CHR$(10) + CHR$(9)+"- Cliquer successivement dans la liste affichée à gauche sur le nom"
a$ = a$ + CHR$(10) + CHR$(9)+"  des images à imprimer."
a$ = a$ + CHR$(10) + CHR$(9)+"  (on peut mettre plusieurs exemplaires de la même image)"
a$ = a$ + CHR$(10) + CHR$(9)+"  ou cliquer sur [TOUT]: sélection de toutes les images."
a$ = a$ + CHR$(10) + CHR$(9)+"  Cliquer sur un nom à droite pour le supprimer de la liste de sélection,"
a$ = a$ + CHR$(10) + CHR$(9)+"  ou cliquer sur le bouton [RAZ] pour supprimer toute la sélection."

a$ = a$ + CHR$(10) + CHR$(9)+"  Les photos seront affichées (et imprimées) dans l'ordre de leur sélection,"
a$ = a$ + CHR$(10) + CHR$(9)+"  dans la limite de la contenance de la page choisie."
a$ = a$ + CHR$(10) + CHR$(10)
a$ = a$ + "- Choisir le type de légende éventuel de chaque image."
a$ = a$ + CHR$(10) + CHR$(9) + " (la police et la taille des caractères sont prédéfinis)."
a$ = a$ + CHR$(10)+CHR$(10)
a$ = a$ + "- Choisir s'il faut pivoter les images plus hautes que larges (pour découpage"
a$ = a$ + CHR$(10) + CHR$(9)+"  ultérieur éventuel), ou les présenter telles quelles."
a$ = a$ + CHR$(10) + CHR$(10)
a$ = a$ + "- [Aperçu]:  image de la page A4 avec les images choisies, telle qu'elle sera imprimée"

a$ = a$ + CHR$(10)+CHR$(10)
a$ = a$ + CHR$(9) + "(*** on peut modifier les options avant impression ***)."
a$ = a$ + CHR$(10) + CHR$(10)
a$ = a$ + "- Imprimer: cliquer sur le bouton [Imprimer]:"
a$ = a$ + CHR$(10) + CHR$(9) + "Confirmer l'impression, puis"
a$ = a$ + CHR$(10) + CHR$(9) + CHR$(9) + " -> impression sur l'imprimante implicite Windows."
MESSAGE a$
RETURN