Nouveau défi pour les spécialistes

rem ' Routine de calcul des dimensions d'une image jgg ou bmp - Rout-format-imag
  dim HA% , LA% : rem HAuteur et LArgeur de la photo
  dim PB% : rem Plan B pour les jpg anormaux
  label clic : rem Redirection de l`on-click

rem form0
  width 0,999
  caption 0,"Calcul des dimensions d'une image"

alpha 10 : rem Affichage des dimensions de la photo
  left 10,5
  top 10,5

button 20 : rem Bouton de choix de la photo à mesurer
  left 20,10
  top 20,40
  caption 20,"Choisir"
  on_click 20,clic

end : ' =======================================================================

clic: : rem Redirection de l`on-click =========================================
  choisir()
return

sub choisir() : rem Choisir la photo à mesurer ================================
  dim_local np$ : rem Nom de la Photo
  open_dialog 99
      np$=file_name$(99)
  delete 99
  LA%=0
  HA%=0
  if lower$(right$(np$,4))=".bmp"
      format_bmp(np$)
  end_if
  PB%=0
  if lower$(right$(np$,4))=".jpg"
      format_jpg(np$)
  end_if
  if PB%=1
      format_pb(np$)
  end_if
  caption 0,np$
  caption 10,"L="+str$(LA%)+" x "+"H="+str$(HA%)+" - Plan "+chr$(65+PB%)+right$(np$,4)
end_sub

sub format_bmp(npf1$) : rem Calcul des dimensions d`une photo bmp
  dim_local va1% , vb1% , vc1% , vd1% : rem Variables à utilisation multiple
  rem npf1$ : Nom de la Photo pour le Format BMP
  npf1$=lower$(npf1$)
  if right$(npf1$,4)=".bmp"
      filebin_open_read 1,npf1$
        filebin_position 1,18
        filebin_read 1,va1%
        filebin_read 1,vb1%
        filebin_position 1,22
        filebin_read 1,vc1%
        filebin_read 1,vd1%
      filebin_close 1
      LA%=256*vb1%+va1%
      HA%=256*vd1%+vc1%
  end_if
end_sub

sub format_jpg(npf2$) : rem Calcul des dimensions d`une photo jpg normale
  dim_local vh2% , vi2% , vj2% : rem Variables à utilisation multiple
  dim_local va2% : rem Variables à utilisation multiple
  dim_local vta2% : rem Taille du fichier
  dim_local voc2%(10) : rem Les 10 premiers octets du fichier
  rem npf2$ : Nom de la Photo pour le Format JPG formule 2 (normale)
  npf2$=lower$(npf2$)
  if right$(npf2$,4)=".jpg"
      filebin_open_read 1,npf2$
        vta2%=filebin_size(1)
        filebin_read 1,voc2%(1)
        filebin_read 1,voc2%(2)
        if voc2%(1)=255 and voc2%(2)=216
            repeat
              repeat
                  vh2%=vi2%+2+vj2%
                  if vh2%>=vta2%
                    PB%=1
                    filebin_close 1
                    exit_sub
                  end_if
                  filebin_position 1,vh2%
                  for va2%=1 to 4
                    filebin_read 1,voc2%(va2%)
                  next va2%
                  if voc2%(1)<>255
                    PB%=1
                    filebin_close 1
                    exit_sub
                  end_if
                  vj2%=256*voc2%(3)+voc2%(4)
                  vi2%=filebin_pos(1)-4
              until voc2%(2)=192 or voc2%(2)=194
              for va2%=1 to 5
                  filebin_read 1,voc2%(va2%)
              next va2%
            until voc2%(1)=8
            HA%=256*voc2%(2)+voc2%(3)
            LA%=256*voc2%(4)+voc2%(5)
        else
            PB%=1
        end_if
      filebin_close 1
  end_if
end_sub
                   
sub format_pb(npf3$) : rem Plan B : Calcul dimensions d`une jpg anormale ======
  dim_local va3% , vb3% , vc3% , vd3% : rem Variables à utilisation multiple
  rem npf3$ : Nom de la Photo pour le Format JPG formule 3 (anormale)
  npf3$=lower$(npf3$)
  picture 199 : rem Affichage provisoire de la photo
      hide 199
      file_load 199,npf3$
      file_save 199,"C:\Provy.bmp"
  delete 199
  filebin_open_read 1,"C:\Provy.bmp"
      filebin_position 1,18
      filebin_read 1,va3%
      filebin_read 1,vb3%
      filebin_position 1,22
      filebin_read 1,vc3%
      filebin_read 1,vd3%
  filebin_close 1
  file_delete "C:\Provy.bmp"
  LA%=256*vb3%+va3%
  HA%=256*vd3%+vc3%
end_sub

SUB DimJpg(f$)
  ' dimensions d'un jpg -> w, h : frame FF C0
  ' (frames: FF tt 00 yy xx ...
  '  tt = type de frame, xx+256*yy taille du contenu (+2 = taille totale)
  DIM_LOCAL sz,t,x,v%(10)
  FILEBIN_OPEN_READ 9,f$: sz = FILEBIN_SIZE(9): x = 2
  WHILE x < sz
    FILEBIN_POSITION 9,x: FILEBIN_BLOCK_READ 9,10,v%(0)
    t = v%(1): ' type de frame (FF xx)
    IF t=192 OR t=193 OR t=194 OR t=195: ' C0, C1, C2, C3 frame dimensions
        h = v%(6)+256*v%(5): w = v%(8)+256*v%(7)
        EXIT_WHILE
    END_IF
    x = x+v%(3)+256*v%(2)+2: ' frame suivant
  END_WHILE
  FILEBIN_CLOSE 9
END_SUB

SUB DimJpgBmp(f$)
  ' Dimensions d'une image Bmp ou Jpg -> w,h, définis dans l'appelant
  DIM_LOCAL p,fp$
  p = 900: fp$ = "C:\Tmp.bmp"
  IF FILE_EXTRACT_EXTENSION$(UPPER$(f$)) <> ".BMP"
      PICTURE p: HIDE p: FILE_LOAD p,f$: FILE_SAVE p,fp$: DELETE p: f$ = fp$
  END_IF
  FILEBIN_OPEN_READ 1,f$
      FILEBIN_POSITION 1,18: w = FILEBIN_READ(1)+256*FILEBIN_READ(1)
      FILEBIN_POSITION 1,22: h = FILEBIN_READ(1)+256*FILEBIN_READ(1)
  FILEBIN_CLOSE 1: IF FILE_EXISTS(fp$) = 1 THEN FILE_DELETE fp$
END_SUB

SUB JpgDate(f$)

Pour ce qui est de la rotation des images jpg (ou autres) de 90° ou 180°, j'ai bien une sub, mais il y a reformatage,
et s'il s'agit de photo on perd les exifs et ça devient une image jpg lambda, sans les infos photo.
Il y a peut-être moyen de pivoter une photo avec ses exifs, mais je ne connais pas (c'est peut-être une info
contenue dans les exifs ?).
La méthode photo pivotée -> jpg ordinaire (c'est un script vbs):
[code]SUB ImgRot90(f$,RL$,fr$)
  ' Rotation d'une image f$ de 90° à gauche (RL$="L") ou à droite (RL$="R")
  ' ou à 180° (RL$ = "RL"). (angles intermédiaires inadmis).
  ' Résultat dans le fichier fr$ (-> NOTA: doit être de même type que f$)
  ' NB: si photo, perte des Exifs.
  DIM_LOCAL scr$,arg$,r$,q$: q$ = CHR$(34)
  r$ = "270": IF UPPER$(RL$)="R" THEN r$ = "90"
  IF UPPER$(RL$)="RL" THEN r$ = "180"
  IF FILE_EXISTS(fr$) = 1 THEN FILE_DELETE fr$: ' sinon, erreur
  scr$ = "C:\Temp\Vbscript.vbs"
  FILE_OPEN_WRITE 9,scr$
  FILE_WRITELN 9,"Dim Img 'As ImageFile"
  FILE_WRITELN 9,"Dim IP 'As ImageProcess"
  FILE_WRITELN 9,"Set Img = CreateObject("+q$+"WIA.ImageFile"+q$+")"
  FILE_WRITELN 9,"Set IP = CreateObject("+q$+"WIA.ImageProcess"+q$+")"
  FILE_WRITELN 9,"Img.LoadFile "+q$+f$+q$
  FILE_WRITELN 9,"IP.Filters.Add IP.FilterInfos("+q$+"RotateFlip"+q$+").FilterID"
  FILE_WRITELN 9,"IP.Filters(1).Properties("+q$+"RotationAngle"+q$+") = "+r$
  FILE_WRITELN 9,"Set Img = IP.Apply(Img)"
  FILE_WRITELN 9,"Img.SaveFile "+q$+fr$+q$
  FILE_WRITELN 9,"WScript.Quit(0)"
  FILE_CLOSE 9
  EXECUTE_WAIT "Wscript.exe|" + scr$: ' Exécution du script
  FILE_DELETE scr$
END_SUB[/code]
  ' Date/Heure de prise de vue Exif de l'image Jpg f$ -> dat$ (aaaa:mm:jj hh:mm)
  DIM_LOCAL a$,k
  IF VARIABLE("dat$")=0 THEN DIM dat$
  EXECUTE_WAIT "cmd.exe|/c C:\UTIL\jhead.exe "+f$+" |clip"
  a$ = CLIPBOARD_STRING_PASTE$: k = INSTR(a$,"Date/Time")
  dat$ = MID$(a$,k+15,16)
END_SUB

SUB Datexif(f$)
  ' Date/heure de prise de vue exifs (jpg), résultat dans dat$ (pré-défini)
  ' format dat$ rendu = "AAAA:MM:JJ HH:MM:SS"
  DIM_LOCAL k,id,vhx$: dat$ = "non trouvé !"
  FILEBIN_OPEN_READ 1,f$: FILEBIN_HEXA_READ 1,2000,vhx$: FILEBIN_CLOSE 1
  id = INSTR(vhx$, "0CA4030001"): IF id<1 THEN id = INSTR(vhx$, "0AA4030001")
  IF id<1 THEN id = INSTR(vhx$, "06A4030001")
  IF id > 0
      dat$ = ""
      FOR k = 0 TO 37 STEP 2
          dat$=dat$+CHR$(HEX(MID$(vhx$,k+id+64,2)))
      NEXT k
  END_IF
END_SUB

SUB ImgRot90(f$,RL$,fr$)
  ' Rotation d'une image f$ de 90° à gauche (RL$="L") ou à droite (RL$="R")
  ' ou à 180° (RL$ = "RL"). (angles intermédiaires inadmis).
  ' Résultat dans le fichier fr$ (-> NOTA: doit être de même type que f$)
  ' NB: si photo, perte des Exifs.
  DIM_LOCAL scr$,arg$,r$,q$: q$ = CHR$(34)
  r$ = "270": IF UPPER$(RL$)="R" THEN r$ = "90"
  IF UPPER$(RL$)="RL" THEN r$ = "180"
  IF FILE_EXISTS(fr$) = 1 THEN FILE_DELETE fr$: ' sinon, erreur
  scr$ = "C:\Temp\Vbscript.vbs"
  FILE_OPEN_WRITE 9,scr$
  FILE_WRITELN 9,"Dim Img 'As ImageFile"
  FILE_WRITELN 9,"Dim IP 'As ImageProcess"
  FILE_WRITELN 9,"Set Img = CreateObject("+q$+"WIA.ImageFile"+q$+")"
  FILE_WRITELN 9,"Set IP = CreateObject("+q$+"WIA.ImageProcess"+q$+")"
  FILE_WRITELN 9,"Img.LoadFile "+q$+f$+q$
  FILE_WRITELN 9,"IP.Filters.Add IP.FilterInfos("+q$+"RotateFlip"+q$+").FilterID"
  FILE_WRITELN 9,"IP.Filters(1).Properties("+q$+"RotationAngle"+q$+") = "+r$
  FILE_WRITELN 9,"Set Img = IP.Apply(Img)"
  FILE_WRITELN 9,"Img.SaveFile "+q$+fr$+q$
  FILE_WRITELN 9,"WScript.Quit(0)"
  FILE_CLOSE 9
  EXECUTE_WAIT "Wscript.exe|" + scr$: ' Exécution du script
  FILE_DELETE scr$
END_SUB

SUB Rot_Image(f$,fr$,LR$)
  ' Rotation de l'image f$, résultat fr$ (ou clipboard si fr$ = "")
  ' LR$ = "L": 90° gauche, ="R": 90° droite, ="LL": 180°
  DIM_LOCAL iv$,a$,b$
  iv$ = "C:\Progra~2\Irfanv~1\i_view64.exe": ' <- CHEMIN À ADAPTER !
  a$ = "/rotate_l": IF LR$ = "R" THEN b$ = "/rotate_r"
  IF LR$ = "LL" THEN a$ = "/rotate_l /rotate_l": ' 180°
  b$ = "/convert="+fr$: IF fr$ = "" THEN b$ = "/clipcopy /killmesoftly"
  EXECUTE_WAIT iv$+"|"+f$+" "+a$+" "+b$
END_SUB

SUB JpgDate(f$)
  ' Date/Heure de prise de vue Exif de l'image Jpg f$ -> dat$ (aaaa:mm:jj hh:mm)
  DIM_LOCAL a$,k
  IF VARIABLE("dat$")=0 THEN DIM dat$
  EXECUTE_WAIT "cmd.exe|/c C:\UTIL\jhead.exe "+f$+" |clip"
  a$ = CLIPBOARD_STRING_PASTE$: k = INSTR(a$,"Date/Time")
  dat$ = MID$(a$,k+15,16)
END_SUB

SUB Exifs(f$)
  ' Données Exifs de base f$ -> clipboard
  EXECUTE_WAIT "cmd.exe|/c C:\UTIL\jhead.exe "+f$+" |clip"
END_SUB

SUB Datexif(f$)
  ' Date/heure de prise de vue exifs (jpg), résultat dans dat$ (pré-défini)
  ' format dat$ rendu = "AAAA:MM:JJ HH:MM:SS"
  DIM_LOCAL k,id,vhx$: dat$ = "non trouvé !"
  FILEBIN_OPEN_READ 1,f$: FILEBIN_HEXA_READ 1,2000,vhx$: FILEBIN_CLOSE 1
  id = INSTR(vhx$, "0CA4030001"): IF id<1 THEN id = INSTR(vhx$, "0AA4030001")
  IF id<1 THEN id = INSTR(vhx$, "06A4030001")
  IF id > 0
      dat$ = ""
      FOR k = 0 TO 37 STEP 2
          dat$=dat$+CHR$(HEX(MID$(vhx$,k+id+64,2)))
      NEXT k
  END_IF
END_SUB

DIM f$,fr$
f$ = "F:\Reduc\P1040037.JPG": ' exemple
fr$ = "Z:\Infos.txt": ' résultat, toutes les infos y compris exifs
ExifInfos(f$,fr$)
Supzero_Fic(fr$,fr$)
PRINT "Terminé !"
END

SUB ExifInfos(f$,fr$)
  ' Infos exifs d'un fichier image photo, résultat dans le fichier texte fr$
  DIM_LOCAL iv$
  iv$ = "C:\Progra~2\IrfanV~1\i_view64.exe": ' chemin IrfanView, à adapter !
  EXECUTE_WAIT iv$+"|"+f$+" /info="+fr$+" /fullinfo /killmesoftly"
END_SUB

SUB Supzero_Fic(f$,fr$)
  ' Suppression des caractères '0' dans un fichier texte f$ -> fr$
  DIM_LOCAL sz%,i%,a$
  FILEBIN_OPEN_READ 1,f$: sz% = FILEBIN_SIZE(1): DIM_LOCAL v%(sz%)
  FILEBIN_BLOCK_READ 1,sz%,v%(0): FILEBIN_CLOSE 1
  a$=""
  FOR i% = 4 TO sz%-1: ' sauf en-tête 'FF FE 3B 00'
      IF v%(i%)<>0 THEN a$=a$+CHR$(v%(i%))
  NEXT i%: FREE v%
  FILE_OPEN_WRITE 1,fr$: FILE_WRITELN 1,a$: FILE_CLOSE 1
END_SUB

' Chercher la date d'une photo jpg avec KGF.dll

dim V4M$ , RES% , pic$(5) , a%
pic$(1)="IMG_1795.JPG"
pic$(2)="IMG_1797.JPG"
pic$(3)="IMG_1799.JPG"
pic$(4)="IMG_1804.JPG"
pic$(5)="IMG_1812.JPG"
dll_on KGF.dll"

picture 40 : stretch_on 40 : hide 40
grid 2

for a% = 1 to 5
   V4M$=pic$(a%)
   file_load 40,V4M$
   test("DateTimeOriginal")
next a%  
  
dll_off

end

sub test(t$)
  dim_local s$
  s$ = string$(255," ")
  RES% = dll_call3("GetExifInfoFromJPG",adr(V4M$),adr(t$),adr(s$))
  grid_write 2,a%+1,2,left$(trim$(s$),4)
end_sub

dim a$ , dat$
a$="C:\Users\admin\Pictures\IMG_1795.JPG"
Datexif(a$)
caption 0,dat$
end
SUB Datexif(f$)
  ' Date/heure de prise de vue exifs (jpg), résultat dans dat$ (pré-défini)
  ' format dat$ rendu = "AAAA:MM:JJ HH:MM:SS"
  DIM_LOCAL k,id,vhx$: dat$ = "non trouvé !"
  FILEBIN_OPEN_READ 1,f$: FILEBIN_HEXA_READ 1,2000,vhx$: FILEBIN_CLOSE 1
  id = INSTR(vhx$, "0CA4030001"): IF id<1 THEN id = INSTR(vhx$, "0AA4030001")
  IF id<1 THEN id = INSTR(vhx$, "06A4030001")
  IF id > 0
      dat$ = ""
      FOR k = 0 TO 37 STEP 2
          dat$=dat$+CHR$(HEX(MID$(vhx$,k+id+64,2)))
      NEXT k
  END_IF
END_SUB

SUB Datexif(f$)
  ' Date/heure de prise de vue exifs (jpg), résultat dans dat$ (pré-défini)
  ' format dat$ = "AAAA:MM:JJ HH:MM:SS"
  DIM_LOCAL k,id,vhx$: dat$ = "non trouvé !"
  FILEBIN_OPEN_READ 1,f$: FILEBIN_HEXA_READ 1,2000,vhx$: FILEBIN_CLOSE 1
  id = INSTR(vhx$, "0CA4030001"): IF id<1 THEN id = INSTR(vhx$, "0AA4030001")
  IF id<1 THEN id = INSTR(vhx$, "06A4030001")
  IF id > 0
      dat$ = "": id = INSTR_POS(vhx$,"3A",id): id = id-8
      FOR k = 0 TO 37 STEP 2
          dat$=dat$+CHR$(HEX(MID$(vhx$,k+id,2)))
      NEXT k
  END_IF
END_SUB

SUB JpgDate(f$)
  ' Date/Heure de prise de vue Exif de l'image Jpg f$ -> dat$ (aaaa:mm:jj hh:mm)
  DIM_LOCAL a$,k
  IF VARIABLE("dat$")=0 THEN DIM dat$
  EXECUTE_WAIT "cmd.exe|/c C:\UTIL\jhead.exe "+f$+" |clip"
  a$ = CLIPBOARD_STRING_PASTE$: k = INSTR(a$,"Date/Time")
  dat$ = MID$(a$,k+15,16)
END_SUB

SUB InfosExif(f$,info$)
  ' Infos exif de f$, type d'info = info$, résultat dans clipboard)
  ' Type d'info: ex info$="DateTimeOriginal", "ImageWidth", "ImageHeight" etc.
  DIM_LOCAL s$,r%
  DLL_ON "C:\PANORAMIC\KGF\KGF.dll": ' à ajuster
  s$ = STRING$(255," ")
  r% = DLL_CALL3("GetExifInfoFromJPG",ADR(f$),ADR(info$),ADR(s$))
  DLL_OFF
  CLIPBOARD_STRING_COPY TRIM$(s$)
END_SUB

SUB DateurPV(rep$,obj)
  ' Date/Heure de prise de vue Exif des images jpg (photos) du répertoire rep$
  ' Résultats dans l'objet de n° obj (LIST, MEMO, etc) sous la forme d'une liste,
  ' chaque élément = "AAAA:MM:JJ HH:MM:SS Nom du fichier"
  ' (la liste résultat est triée par ordre chronologique croissant).
  DIM_LOCAL f$,ft$,a$,info$,i,k,r%,s$
  info$ = "DateTimeOriginal": ' info cherchée
  LIST 900: HIDE 900
  EXECUTE_WAIT "cmd.exe|/c DIR /B "+r$+"*.JPG |clip": CLIPBOARD_PASTE 900
  DLL_ON "C:\PANORAMIC\KGF\KGF.dll": ' chemin à ajuster
  FOR i = 1 TO COUNT(900)
      f$ = ITEM_READ$(900,i): ft$ = rep$+f$
      s$ = STRING$(255," ")
      r% = DLL_CALL3("GetExifInfoFromJPG",ADR(ft$),ADR(info$),ADR(s$))       
      ITEM_ADD obj,TRIM$(s$)+" "+f$
  NEXT i
  DLL_OFF: DELETE 900
  SORT obj: ' tri du résultat par ordre chronologique croissant
END_SUB

DIM f$: f$ = "C:\GRAPH\JPG\JJN4.jpg"
PRINT DateExif$(f$)
END

FNC DateExif$(f$)
  ' Date/heure de prise de vue, recherche de deux dates successives
  ' (prise de vue et enregistrement, identiques)
  DIM_LOCAL a$,b$,k
  FILEBIN_OPEN_READ 1,f$: a$ = FILEBIN_HEXA_READ$(1,2000): FILEBIN_CLOSE 1
  k = INSTR(a$,"3A"): ' séparateur ':'
  WHILE k > 0
    IF MID$(a$,k+40,2) = "3A" THEN EXIT_WHILE: ' ok, 2 dates successives
    k = INSTR_POS(a$,"3A",k+40)
  END_WHILE
  IF k = 0
    RESULT "Non trouvé"
  ELSEhttps://2img.net/i/fa/i/smiles/icon_rendeer.png
    a$ = MID$(a$,k-8,38): b$ = ""
    FOR k = 1 TO 37 STEP 2: b$ = b$+CHR$(HEX(MID$(a$,k,2))): NEXT k
    RESULT b$: ' format AAAA:MM:JJ HH:MM:SS
  END_IF
END_FNC