Encore un diaporama

SUB Diaporama(rep$)
' Diaporama d'un répertoire d'images donné à vitesse variable, plein écran
DIM_LOCAL nf%,w%,h%,wi%,hi%,i%,j%,p%,ff%,lf%,wf%,mm%,al%,sp%,ni%,f$,a$,d$,q$
DIM_LOCAL bt1%,bt2%,a1%,pau%,id%
IF LABEL("Qdiapo")=0 THEN LABEL Qdiapo
IF LABEL("Qaffim")=0 THEN LABEL Qaffim
IF LABEL("QDimDat")=0 THEN LABEL QDimDat
IF LABEL("Qdiapo")=0 THEN LABEL Qdiapo
IF LABEL("Qactif")=0 THEN LABEL Qactif
q$ = CHR$(34)
nf% = 5000
FORM nf%: BORDER_HIDE nf%: FULL_SPACE nf%
  COLOR nf%,180,255,255: FONT_BOLD nf%: FONT_NAME nf%,"Arial": FONT_SIZE nf%,10
h% = HEIGHT(nf%): w% = 4*h%/3
p%=nf%+1: PICTURE p%: PARENT p%,nf%: WIDTH p%,w%: HEIGHT p%,h%: STRETCH_ON p%
i%=p%+1: BUTTON i%: PARENT i%,nf%: TOP i%,5: LEFT i%,WIDTH(nf%)-90
  CAPTION i%,"Quitter": ON_CLICK i%,Qdiapo
lf% = WIDTH(p%)+5: wf% = WIDTH(nf%)-lf%
i%=i%+1: ALPHA i%: PARENT i%,nf%: TOP i%,30: LEFT i%,lf%+5
  CAPTION i%,"Répertoire des images :"
i%=i%+1: EDIT i%: PARENT i%,nf%: TOP i%,TOP(i%-1)+18: LEFT i%,lf%+5: WIDTH i%,wf%-10
  IF RIGHT$(rep$,1)<>"\" THEN rep$=rep$+"\"
  TEXT i%,rep$
mm%=i%+1: MEMO mm%: HIDE mm%
  EXECUTE_WAIT "cmd.exe /c DIR /B "+q$+rep$+"*.jpg"+q$+" | clip"
  CLEAR mm%: CLIPBOARD_PASTE mm%
i%=mm%+1: ALPHA i%: PARENT i%,nf%: TOP i%,100: LEFT i%,lf%+5
  CAPTION i%,"Délai:              ms."
i%=i%+1: SPIN i%: PARENT i%,nf%: TOP i%,TOP(i%-1)-3: LEFT i%,lf%+45: WIDTH i%,55
  POSITION i%,1500: sp% = i%
i%=sp%+1: BUTTON i%: PARENT i%,nf%: TOP i%,TOP(sp%): LEFT i%,lf%+150
  CAPTION i%,"Précédent": bt1%=i%: ON_CLICK bt1%,Qactif
i%=i%+1: BUTTON i%: PARENT i%,nf%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+80
  CAPTION i%,"Continuer": bt2%=i%: ON_CLICK bt2%,Qactif

a1%=bt2%+1: ALPHA a1%: PARENT a1%,nf%: TOP a1%,185: LEFT a1%,lf%+20: TOP a1%,180
  FONT_SIZE a1%,12
al%=a1%+1: LIST al%: PARENT al%,nf%: TOP al%,200: LEFT al%,lf%+20: WIDTH al%,300
  HEIGHT al%,65: COLOR al%,255,255,0: FONT_SIZE al%,12

pau% = 1: ' affichage 1ère image, puis pause
FOR ni% = 1 TO COUNT(mm%)
    GOSUB Qaffim
    i% = POSITION(sp%): IF i%<1 THEN i% = 1
    PAUSE i%
    IF CLICKED(p%+1) = 1 THEN ff%=1: EXIT_FOR: ' Quitter
    WHILE pau% = 1
        PAUSE 100: IF ff% = 1 THEN EXIT_WHILE
    END_WHILE
    IF ff% = 1 THEN EXIT_FOR
NEXT ni%
WHILE ff% = 0: PAUSE 100: END_WHILE: DELETE nf%: EXIT_SUB
' ..............................................................................
Qdiapo:
ff% = 1
RETURN
' ..............................................................................
Qactif:
i% = NUMBER_CLICK
IF i% = bt1%
    pau% = 1: CAPTION bt2%,"Continuer"
    ni% = ni%-1: IF ni%<1 THEN ni% = 1
    GOSUB Qaffim
ELSE
    IF pau% = 1
        pau% = 0: CAPTION bt2%,"Pause"
    ELSE
        pau% = 1: CAPTION bt2%,"Continuer"
    END_IF
END_IF
RETURN
' ..............................................................................
Qaffim:
f$ = rep$+ITEM_READ$(mm%,ni%): GOSUB QDimDat: ' -> wi%, hi%, d$
WIDTH p%,h%*wi%/hi%
FILE_LOAD p%,f$
CLEAR al%: ITEM_ADD al%,ITEM_READ$(mm%,ni%): ITEM_ADD al%,STR$(wi%)+" x "+STR$(hi%)
IF d$<>"" THEN ITEM_ADD al%,MID$(d$,9,2)+"/"+MID$(d$,6,2)+"/"+LEFT$(d$,4)+" à"+MID$(d$,11,6)
CAPTION a1%, "  Image:  "+STR$(ni%)+" / "+STR$(COUNT(mm%))
RETURN
' ..............................................................................
QDimDat:
' dimensions et date/heure de prise de vue de l'image f$
FILEBIN_OPEN_READ 9, f$: FILEBIN_HEXA_READ 9,2000,a$: FILEBIN_CLOSE 9
i% = INSTR(a$, "02A004")
IF i% > 0: ' infos Exif
    wi% = HEX(MID$(a$,i%+16,2))+256*HEX(MID$(a$,i%+18,2))
    i% = INSTR(a$, "03A004")
    IF i% > 0 THEN hi% = HEX(MID$(a$,i%+16,2))+256*HEX(MID$(a$,i%+18,2))
ELSE
    ' si pas d'exifs
    i% = INSTR(a$,"FFC00011"): IF i% = 0 THEN i% = INSTR(a$, "FFC20011")
    IF i%>0 THEN hi%=HEX(MID$(a$,i%+10,4)): wi%=HEX(MID$(a$,i%+14,4))
END_IF
d$ = ""
i% = INSTR(a$, "30313030")
IF i% > 0
    a$ = MID$(a$,i%,500): i% = INSTR(a$,"3230"): ' recherche à partir de l'an 2000
    IF i%>0
        a$ = MID$(a$,i%,38)
        FOR i% = 1 TO 37 STEP 2: d$=d$+CHR$(HEX(MID$(a$,i%,2))): NEXT i%
    END_IF
END_IF
IF d$ = ""
    EXECUTE_WAIT "cmd.exe /c DIR "+q$+f$+q$+" | clip"
    d$ = CLIPBOARD_STRING_PASTE$: i% = INSTR(d$,"/")
    d$ = MID$(d$,i%-2,17): ' date du fichier
    d$ = MID$(d$,7,4)+":"+MID$(d$,4,2)+":"+LEFT$(d$,2)+MID$(d$,12,6)
END_IF
RETURN
END_SUB

SUB Planche(rep$,x%,y%,wi%,nc%)
' Planches d'images successives du répertoire rep$, affiché en x%,y%,
' largeur des images wi%, affichage sur nc% colonnes (ajustage automatique)
' Cliquer une image pour l'agrandir, puis sur 'OK' pour revenir à la planche.
IF DIR_EXISTS(rep$) = 0 THEN EXIT_SUB
IF LABEL("Qdiap") = 0 THEN LABEL Qdiap
IF LABEL("Afdiap") = 0 THEN LABEL Afdiap
IF LABEL("Pl_vim") = 0 THEN LABEL Pl_vim
IF LABEL("Pl_svim") = 0 THEN LABEL Pl_svim
DIM_LOCAL nf%,mm%,nr%,a$,d$,r$,q$,w%,h%,bt%,eh%,ev%,hi%,i%,j%,p%,pp%,dp%,qp%,iy%,pi%
q$ = CHR$(34)
hi% = wi%*3/4
eh% = 5: ev% = 15: qp% = 0
i% = nc%*(wi%+eh%)+eh%+16: ' largeur totale
WHILE i%>SCREEN_X: nc% = nc%-1: i% = nc%*(wi%+eh%)+eh%+16: END_WHILE
nf% = 700
FORM nf%: TOP nf%,y%: LEFT nf%,x%: WIDTH nf%,i%: HEIGHT nf%,SCREEN_Y-50
  BORDER_SMALL nf%: ON_CLOSE nf%,Qdiap
nr% = INT((HEIGHT(nf%)-30)/(hi%+ev%)): ' nb de rangées maxi
mm%=nf%+1: MEMO mm%: PARENT mm%,nf%: WIDTH mm%,500: HIDE mm%
IF RIGHT$(rep$,1)<>"" THEN rep$ = rep$+""
EXECUTE_WAIT "cmd.exe /c DIR /B "+q$+rep$+"*.jpg"+q$+" | clip"
CLEAR mm%: CLIPBOARD_PASTE mm%
CAPTION nf%," Répertoire:  "+rep$+"  ( "+STR$(COUNT(mm%))+" images )."
pp% = mm%+1: p% = pp%
y% = 0: x% = eh%
FOR j% = 1 TO nr%
    FOR i% = 1 TO nc%
        PICTURE p%: PARENT p%,nf%: TOP p%,y%: LEFT p%,x%: WIDTH p%,wi%: HEIGHT p%,hi%
          STRETCH_ON p%: dp% = p%: COLOR p%,180,255,255: ON_CLICK p%,Pl_vim
        ALPHA p%+1: PARENT p%+1,nf%: TOP p%+1,y%+hi%: LEFT p%+1,x%:WIDTH p%+1,wi%
        FONT_NAME p%+1,"Consolas": FONT_SIZE p%+1,7
        p% = p%+2: x%=x%+wi%+eh%
    NEXT i%
    y% = y%+hi%+ev%: x% = eh%
NEXT j%
i% = dp%+2
BUTTON i%: PARENT i%,nf%: TOP i%,HEIGHT(nf%)-60: LEFT i%,WIDTH(nf%)/2-120
  CAPTION i%,"Précédent": FONT_BOLD i%: ON_CLICK i%,Afdiap: bt% = i%
i%=i%+1: BUTTON i%: PARENT i%,nf%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+80
  CAPTION i%,"Suivant": FONT_BOLD i%: ON_CLICK i%,Afdiap
i%=i%+1: BUTTON i%: PARENT i%,nf%: TOP i%,TOP(i%-1): LEFT i%,LEFT(i%-1)+80
  CAPTION i%,"Quitter": FONT_BOLD i%: ON_CLICK i%,Qdiap
i%=i%+1: PICTURE i%: PARENT i%,nf%: HIDE i%: WIDTH i%,wi%: HEIGHT i%,hi%
  COLOR i%,180,255,255: CLIPBOARD_COPY i%: ' pour nettoyage
' affichage d'une image agrandie :
pi%=i%+1: PICTURE pi%: PARENT pi%,nf%: TOP pi%,hi%/2: LEFT pi%,WIDTH(nf%)/6
  WIDTH pi%,2*WIDTH(nf%)/3: HEIGHT pi%,3*WIDTH(pi%)/4: HIDE pi%: STRETCH_ON pi%
i%=pi%+1: ALPHA i%: PARENT i%,nf%: HIDE i%: TOP i%,TOP(pi%)+HEIGHT(pi%)-15
  LEFT i%,LEFT(pi%)+2: COLOR i%,255,255,0: FONT_BOLD i%
i%=i%+1: BUTTON i%: PARENT i%,nf%: HIDE i%: TOP i%,TOP(pi%)+HEIGHT(pi%)-18
  WIDTH i%,40: HEIGHT i%,18: LEFT i%,LEFT(pi%)+WIDTH(pi%)-43: CAPTION i%,"OK"
  FONT_BOLD i%: ON_CLICK i%,Pl_svim
'
iy% = 1: ' init, planche 1
GOSUB Afdiap
WHILE qp% = 0: PAUSE 300: END_WHILE: DELETE nf%: EXIT_SUB: ' attente Quit
' ..............................................................................
Afdiap:
SHOW bt%+1
IF CLICKED(bt%) = 1
    IF iy% = 1+nc%*nr% THEN RETURN: ' 1ère page déjà affichée
    iy%=iy%-2*nc%*nr%: IF iy%<1 THEN iy% = 1
END_IF
FOR i% = pp% TO dp% STEP 2: CLIPBOARD_PASTE i%: CAPTION i%+1,"": NEXT i%: ' Raz
p% = pp%: j% = 0
FOR i% = iy% TO iy%+nc%*nr%-1
    IF qp% = 1 THEN RETURN
    IF i% > COUNT(mm%) THEN HIDE bt%+1: EXIT_FOR
    a$ = ITEM_READ$(mm%,i%): FILE_LOAD p%,rep$+a$: CAPTION p%+1,a$
    display
    p% = p%+2
NEXT i%
IF j% = 0 THEN iy% = iy%+nc%*nr%
RETURN
' ..............................................................................
Pl_vim:
i% = NUMBER_CLICK: a$ = CAPTION$(i%+1): FILE_LOAD pi%,rep$+a$
FILEBIN_OPEN_READ 9,rep$+a$: FILEBIN_HEXA_READ 9,2000,r$: FILEBIN_CLOSE 9
i% = INSTR(r$, "02A004")
IF i% > 0: ' infos Exif
    w% = HEX(MID$(r$,i%+16,2))+256*HEX(MID$(r$,i%+18,2))
    i% = INSTR(r$, "03A004")
    IF i% > 0 THEN h% = HEX(MID$(r$,i%+16,2))+256*HEX(MID$(r$,i%+18,2))
ELSE
    ' si pas d'exifs
    i% = INSTR(r$,"FFC00011"): IF i% = 0 THEN i% = INSTR(r$, "FFC20011")
    IF i%>0 THEN h%=HEX(MID$(r$,i%+10,4)): w%=HEX(MID$(r$,i%+14,4))
END_IF
d$ = ""
i% = INSTR(r$, "30313030")
IF i% > 0
    r$ = MID$(r$,i%,500): i% = INSTR(r$,"3230")
    IF i% > 0
        r$ = MID$(r$,i%,38)
        d$ = "": FOR i% = 1 TO 37 STEP 2: d$=d$+CHR$(HEX(MID$(r$,i%,2))): NEXT i%
    END_IF
END_IF
IF d$ = ""
    EXECUTE_WAIT "cmd.exe /c DIR "+q$+rep$+a$+q$+" | clip"
    d$ = CLIPBOARD_STRING_PASTE$: i% = INSTR(d$,"/")
    d$ = MID$(d$,i%-2,17): ' date du fichier
END_IF
CAPTION pi%+1," "+a$+"  ("+STR$(w%)+"x"+STR$(h%)+")  "+d$+" "
SHOW pi%: SHOW pi%+1: SHOW pi%+2
RETURN
' ..............................................................................
Pl_svim:
HIDE pi%: HIDE pi%+1: HIDE pi%+2
RETURN
' ..............................................................................
Qdiap:
qp% = 1
RETURN
END_SUB

rem ============================================================================
rem Renommer tous les fichiers d un dossier dont les noms comportent des espaces
rem en les remplaçant par le caractère de soulignement _ (underscore)
rem Par exemple  :
rem Le fichier   : "Mon fichier test.bas"
rem sera renommé :  "Mon_fichier_test.bas"
rem ============================================================================
' Pour tester :
' créer un dossier de travail sur le bureau : "Mon Dossier" par exemple
' y copier quelques fichiers (pour servir de test) dont les noms comportent des espaces
' Par exemple :
' "Mon fichier avec espace.txt"
' "Mon second fichier 1 2 3 .bas"
' Appeler la sub : Renomme_Fichiers("C:\Users\acer\Desktop\Mon Dossier")
' Vos fichiers devront être renommés en :
' "Mon_fichier_avec_espace.txt"
' "Mon_second_fichier_1_2_3.bas
rem ============================================================================
rem NB : Ce script renomme seulement les fichiers, pas les dossiers !
rem ============================================================================

Renomme_Fichiers("C:\Users\acer\Desktop\Nouveau dossier") : ' Adapter le chemin

end
rem ============================================================================
' Script pour remplacer les espaces dans les noms des fichiers par le caractère
' de soulignement _ (underscore)
SUB Renomme_Fichiers(dossier$)
    dim_local src$,q$
    if dir_exists("C:\temp") = 0 then dir_make "C:\temp"
    if dir_exists(dossier$) = 0
       message "Le dossier : " + dossier$ + " n'existe pas !" + chr$(13) + "Veuillez vérifier son chemin"
       exit_sub
    end_if
    src$ = "C:\temp\rename.bat" : q$ = chr$(34)
    FILE_OPEN_WRITE 9999,src$
    FILE_WRITELN 9999,"@echo off"
    FILE_WRITELN 9999,"setlocal enabledelayedexpansion"
    FILE_WRITELN 9999,"for /r " +q$ + dossier$ + q$ + " %%a in (*.*) do ("
    FILE_WRITELN 9999,"set "+q$+"path=%%~nxa"+q$
    FILE_WRITELN 9999,"set "+q$+"path=!path: =_!"+q$
    FILE_WRITELN 9999,"move /y "+q$+"%%~a"+q$+" "+q$+"%%~dpa!path!"+q$
    FILE_WRITELN 9999,")"
    FILE_CLOSE 9999
    EXECUTE_WAIT src$
    FILE_DELETE src$
END_SUB
rem ============================================================================