Recuperer les dimensions image jpeg et psd (photoshop) sans ocx sans api

Soyez le premier à donner votre avis sur cette source.

Snippet vu 15 653 fois - Téléchargée 25 fois

Contenu du snippet

Avec ce code , vous pouvez recuperer facilement les dimension Width et Height reels d'une image Jpeg sans passer par un PictureBox ou un StdPicture ou Cdib, meme pas d'api , rien.

Copiez simplement ce ptit bout de code dans un module

Utilisation :

Private Sub Command1_Click()
Dim o As SIZE
Dim ErrorH As Integer
ErrorH = JpgSize("c:\surf41.jpg", o)
If ErrorH = 0 Then
Text1 = o.cx & " x " & o.cy
Else
MsgBox GetErrorString(ErrorH)
End If

End Sub

Source / Exemple :


Option Base 0
Option Explicit

'RogerStudio
'JpgSize
'Fonction qui recupere la dimension d'un image JPG rapidement
'Sans control Picture ou CDib
'Simple ouvertur du fichier , recherche des valeurs dans l'entete.

'Entrée :   Nom et chemin complet du fichier Jpg
'           Dimension de structure SIZE

'Sortie :   NULL si Reussi
'           >0 en cas d'erreur

'Reference Doc : http://www.landscapeimage.com/ThumbHTML/help/exif_file_format.html
'http://www.w3.org/Graphics/JPEG/jfif3.pdf
'Travail perso de recherche sur le format JFIF Version 1.1 et 1.2

Private PHeight As Long, PWidth As Long         'Resultats des recherches
Private Free As Integer                         'numero de fichier libre
Private Temp() As Byte, Temp1() As Byte
Private MarkerLenght As Integer                 'Longeur du markeur
Private IsJpg(1) As Byte                        '2 Premiers octets pour verifier l'entet du Jpg
Private AppMarker(1) As Byte                    'Structure du marker (FFD8 FFD0 FFC0 FFE1 FFE0 .... FFxx)
Private MarkerOffset As Long                    'Offset du marker
Private Mark As Integer

Private Origin As Long      'Pour la boucle Get
Private NotFound As Boolean

Private LngS As String * 4      'Phrase fixe de 4 octets pour la mise en forme Hexa
Private IntS1 As String * 2     ' // de 2 octets
Private IntS2 As String * 2     ' //    //
Private IntS3 As String * 2     ' //    //
Private IntS4 As String * 2     ' //    //

Private X1 As Long              'Boucles

'Psd format
Private LngS1 As String * 8      'Phrase fixe de 8 octets pour la mise en forme Hexa
Private PsdSignature As Long
Private PsdVersionFormat As Integer
Private PsdRows As Long
Private PsdColumns As Long

Public Type SIZE
    cx As Long
    cy As Long
End Type

Public Function PhotoShopFileSize(SzFileName As String, ByRef Dimension As SIZE) As Integer
On Error GoTo Fin
If ExistFile(SzFileName) = False Then PhotoShopFileSize = 1: Exit Function
Free = FreeFile

Open SzFileName For Binary As #Free
Get #Free, , PsdSignature
'Verifie que l'entete est bien "8BPS"
If Hex(PsdSignature) <> "53504238" Then PhotoShopFileSize = 5: Close #Free: Exit Function

Get #Free, , PsdVersionFormat

'Verifie que la version est a 1
If Hex(PsdVersionFormat) <> "100" Then PhotoShopFileSize = 6: Close #Free: Exit Function

'debu a offset 15
Seek #Free, 15
ReDim Temp(3)
Get #Free, , Temp
IntS1 = String(2 - Len(Hex(Temp(0))), "0") & Hex(Temp(0))
IntS2 = String(2 - Len(Hex(Temp(1))), "0") & Hex(Temp(1))
IntS3 = String(2 - Len(Hex(Temp(2))), "0") & Hex(Temp(2))
IntS4 = String(2 - Len(Hex(Temp(3))), "0") & Hex(Temp(3))
LngS1 = IntS1 & IntS2 & IntS3 & IntS4
PHeight = Val("&H" & LngS1)

Get #Free, , Temp
IntS1 = String(2 - Len(Hex(Temp(0))), "0") & Hex(Temp(0))
IntS2 = String(2 - Len(Hex(Temp(1))), "0") & Hex(Temp(1))
IntS3 = String(2 - Len(Hex(Temp(2))), "0") & Hex(Temp(2))
IntS4 = String(2 - Len(Hex(Temp(3))), "0") & Hex(Temp(3))
LngS1 = IntS1 & IntS2 & IntS3 & IntS4
PWidth = Val("&H" & LngS1)

Dimension.cx = PWidth
Dimension.cy = PHeight
PhotoShopFileSize = 0

Fin:
Close #Free
If Err Then PhotoShopFileSize = Err.Number
End Function

Public Function JpgSize(SzFileName As String, ByRef Dimension As SIZE) As Integer
On Error GoTo Fin
'Verifie que le fichier existe
If ExistFile(SzFileName) = False Then JpgSize = 1: Exit Function
    
Free = FreeFile
Open SzFileName For Binary As #Free
    Get #Free, , IsJpg     'FFD8 = Fichier Jpg
    If Hex(IsJpg(0)) <> "FF" And Hex(IsJpg(1)) <> "D8" Then JpgSize = 2: GoTo Fin
    
    'LE fichier est bien un Jpg
    'On recupere le premier marker
    Get #Free, , AppMarker        'Marker  FFE0 ou FFE1    'Les autres fichiers ne sont pas geré pour le moment
    'Le marker est suivi de sa longeur 2octets
    ReDim Temp(1)
    Get #Free, , Temp
    MarkerLenght = ("&H" & Hex(Temp(0)) & Hex(Temp(1)))
    MarkerOffset = 5        'C'est obligatoirement le premier marker
    
    'A quel genre de jpg a t'on affaire ? avec Exif ou sans Exif ?
    'FFE0 Sans exif , entete simple JFIF
    'FFE1 Avec exif, entete Exif
    
    If Hex(AppMarker(1)) = "E0" Then    'JFIF
        'Fichier Jfif
        'verifie que c'est bien un Jfif, Recupere les 5 prochain bytes
        'ca doit etre 4A 46 49 46 00
        '              J  F  I  F  0
        
        ReDim Temp(4)
        Get #Free, , Temp
        If Hex(Temp(0)) <> "4A" Then JpgSize = 3: GoTo Fin
        If Hex(Temp(1)) <> "46" Then JpgSize = 3: GoTo Fin
        If Hex(Temp(2)) <> "49" Then JpgSize = 3: GoTo Fin
        If Hex(Temp(3)) <> "46" Then JpgSize = 3: GoTo Fin
        If Hex(Temp(4)) <> "0" Then JpgSize = 3: GoTo Fin
    
        ReDim Temp(1)
        ReDim Temp1(1)
        NotFound = True
        'a l 'offset "MArkerLenght" , on doit avoir un FF xx  puis FFxx ....
        'Rechercher le marker FFC0
        Do
            Seek #Free, MarkerLenght + MarkerOffset
            'Offset en cours =MarkerLenght + MarkerOffset
            Get #Free, , Temp      'recupere le marker
            MarkerOffset = Seek(1)
            Get #Free, , Temp1         'recupere la taille du marker
            MarkerLenght = ("&H" & Hex(Temp1(0)) & Hex(Temp1(1)))
            If Hex(Temp(0)) = "FF" And Hex(Temp(1)) = "C0" Then NotFound = False
            
        Loop While NotFound
        'Marker FFC0 trouvé ! cool
        
        ReDim Temp(0)
        Get #Free, , Temp  'je ne sais pas a quoi correspond ce byte , c'est souvent 8 !
                        'mais bon passons
        ReDim Temp(1)
        'Ici on recupere la hauteur
        Get #Free, , Temp
        IntS1 = String(2 - Len(Hex(Temp(0))), "0") & Hex(Temp(0))
        IntS2 = String(2 - Len(Hex(Temp(1))), "0") & Hex(Temp(1))
        LngS = IntS1 & IntS2
        PHeight = Val("&H" & LngS)
        'et ici la longeur
        Get #Free, , Temp
        IntS1 = String(2 - Len(Hex(Temp(0))), "0") & Hex(Temp(0))
        IntS2 = String(2 - Len(Hex(Temp(1))), "0") & Hex(Temp(1))
        LngS = IntS1 & IntS2
        PWidth = Val("&H" & LngS)
        JpgSize = 0
        'Fichier JFIF normal terminé
        'Retourne 0 (pas d'erreur)
        'Et les valeurs dans la streucture
        Dimension.cx = PWidth
        Dimension.cy = PHeight
        
        
    ElseIf Hex(AppMarker(1)) = "E1" Then 'Exif
        'Exif presents , il faut chercher dans les marques exif ,
        'car au markeur FFC0 , c'est la dimension de la miniaturre . et non de l'image
        'Le numero de case est : A002 pour la longuer
        'Le numero de case est : A003 pour la hauteur
        
        
'****************
'Codage Motorola ou Intel ?
'**************
'Recherche du marker "Exif"
ReDim Temp(5)
Origin = 0
NotFound = True
Do
    Origin = Origin + 1
    Get #1, Origin, Temp
    If Temp(0) = 69 And Temp(1) = 120 And Temp(2) = 105 And Temp(3) = 102 And Temp(4) = 0 And Temp(5) = 0 Then NotFound = False
Loop While NotFound
Origin = Origin + 6
ReDim Temp(1)
Get #1, Origin, Temp
Debug.Print Temp(0)
Debug.Print Temp(1)
Codage = None
If Temp(0) = 77 And Temp(1) = 77 Then Codage = Motorola
If Temp(0) = 73 And Temp(1) = 73 Then Codage = Intel
If Codage = None Then JpgSize = 5: GoTo Fin

        
        Dim Marke As Integer
        If Codage = Intel Then Marke = &HA002
        If Codage = Motorola Then Marke = &H2A0
        Origin = 1
        NotFound = True
        Do
            'Recherche du premier marker : a002
            Get #1, Origin, Mark
            Origin = Origin + 1
            DoEvents
            If Mark = Marke Then NotFound = False
        Loop While NotFound
        'Premier marker A002 Trouvé
        
    If Codage = Intel Then
        Origin = Origin + 7
        '4 Derniers octets de la structure de 12
        Get #1, Origin, PWidth
        Origin = Origin + 4
    ElseIf Codage = Motorola Then
         Origin = Origin + 7
         ReDim Temp(1)
         Get #1, Origin, Temp
         
        IntS1 = String(2 - Len(Hex(Temp(0))), "0") & Hex(Temp(0))
        IntS2 = String(2 - Len(Hex(Temp(1))), "0") & Hex(Temp(1))
        LngS = IntS1 & IntS2
        PWidth = Val("&H" & LngS)
        Origin = Origin + 4
    End If
        
        'on recomence pour Le deuxieme
        If Codage = Intel Then Marke = &HA003
        If Codage = Motorola Then Marke = &H3A0
        Get #1, Origin, Mark
        If Mark = Marke Then
            For X1 = 1 To 3
            Get #1, , Mark
            Next X1
            
        If Codage = Intel Then
        Origin = Origin + 8
        '4 Derniers octets de la structure de 12
        Get #1, Origin, PHeight
    ElseIf Codage = Motorola Then
         Origin = Origin + 8
         ReDim Temp(1)
         Get #1, Origin, Temp
         
        IntS1 = String(2 - Len(Hex(Temp(0))), "0") & Hex(Temp(0))
        IntS2 = String(2 - Len(Hex(Temp(1))), "0") & Hex(Temp(1))
        LngS = IntS1 & IntS2
        PHeight = Val("&H" & LngS)
    End If
            
        
        
        Else
            JpgSize = 4: GoTo Fin
        End If
        JpgSize = 0
        'Fichier exif  terminé
        'Retourne 0 (pas d'erreur)
        'Et les valeurs dans la streucture
        Dimension.cx = PWidth
        Dimension.cy = PHeight
        
    End If

Fin:
Close #Free
If Err Then JpgSize = Err.Number
End Function

Private Function ExistFile(ByVal sSpec As String) As Boolean
    On Error Resume Next
    Call FileLen(sSpec)
    ExistFile = (Err = 0)
End Function

Public Function GetErrorString(Index As Integer) As String
Select Case Index

    Case 1: GetErrorString = "Le fichier specifié n'existe pas"
    Case 2: GetErrorString = "Le fichier specifié n'est pas un JPG"
    Case 3: GetErrorString = "LE fichier est bien un Jpg mais contient une mauvaise entete !"
    Case 4: GetErrorString = "Marqueur mal placé , non trouvé , peut etre encodage MM"

End Select
End Function

'Erreur
'1 : Le fichier n'existe pas
'2 : Le fichier n'est pas un JPG
'3 : Fichier Jpg mais mauvaise entete !
'4 : Marqueur mal placé , non trouvé , peut etre encodage MM

Conclusion :


j'ai testé sur des jpg provenant d'un apareil canon eos 350, donc avec EXIF
et sur des vielles photo jpg JFIF ver 1.1 et 1.2.

A voir également

Ajouter un commentaire Commentaires
Messages postés
172
Date d'inscription
mercredi 29 janvier 2003
Statut
Membre
Dernière intervention
24 février 2008

je vais essayer de regarder mon "vieu code" avec tes photos , je ne te garanti rien , mais je vais tenter de me replonger ladedans .... je te tien au courant pour les photos que tu m'a envoyé
Messages postés
15
Date d'inscription
lundi 15 février 2010
Statut
Membre
Dernière intervention
18 septembre 2011

Très bien bien ce programme mais j'ai rencontré un "os" pour les fichiers JPG encodés Motorala : Je trouve bien les deux balises "O2A0" et "03A0" mais à l'offset +8 derrière ces balises, il y a tout sauf quelque chose qui puisse ressembler aux dimensions de l'image !!!!

A l'aide !!!!!
Messages postés
1
Date d'inscription
mercredi 31 octobre 2007
Statut
Membre
Dernière intervention
14 octobre 2009

super source.
J'ai juste trouvé un tout ptit bug : il faut modifier le Seek(1) en Seek(Free)
Messages postés
172
Date d'inscription
mercredi 29 janvier 2003
Statut
Membre
Dernière intervention
24 février 2008

pour le vb net , je ne peut pas t'aider , je n'ai pas vb net et je n'ai absolument rien compris a VB net.
Messages postés
383
Date d'inscription
samedi 29 janvier 2005
Statut
Membre
Dernière intervention
1 décembre 2008

comment faire la meme chose mais en vb.net ?
Afficher les 19 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.