Recuperer les dimensions image jpeg et psd (photoshop) sans ocx sans api
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
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.
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
- Recuperer les dimensions image jpeg et psd (photoshop) sans ocx sans api
- Vectoriser une image photoshop ✓ - Forum Graphisme/design
- Inverser une image photoshop - Forum Graphisme/design
- Inverser noir et blanc photoshop - Forum Visual Basic
- Negatif photoshop - Conseils pratiques -Graphisme
- Inverser les couleurs d'une image 16x16 ✓ - Forum Visual Basic 6
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.