Dimensions d'une image

Version imprimable

20/04/2011, 09h41
Souleyre

Dimensions d'une image

Bonjour à tous,
Soit une image en .tif, j'ai cru comprendre qu'aux emplacements 19 et 31 on pouvait prélever les dimensions (width& et height&) de l'image en question.
Serait-il possible de faire la même chose avec une image .jpg?
20/04/2011, 09h52
OhMonBato

C'est possible sûrement, facile j'en doute car il me semble que le format JPG n'est pas très standardisé la dessus (mais je ne suis pas sûr de moi).
Le plus simple me semble d'utiliser une PictureBox avec AutoSize à True, ScaleMode à Pixels. Tu charges l'image de ton choix, tu n'as plus qu'à lire ScaleWidth et ScaleHeight. Si tu as mis Visible à False pour ta PictureBox c'est parfaitement transparent pour l'utilisateur.
20/04/2011, 09h56
Souleyre

Bonjour Omonbato,
Ta solution est excellente mais mon problème est que j'ai des centaines d'images à traiter et donc le temps de calcul serait prohibitif.
20/04/2011, 10h26
OhMonBato

Faudrait essayer déjà pour voir (je ne connais pas la taille de tes fichiers JPG) mais sinon tu trouveras des codes en recherchant sur Google ("VB6 JPG size" ou "VB6 dimension JPG"). D'après ce que j'y ai trouvé, il existe bien plusieurs "formats" JPG.

Salut

A essayer

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Private Sub Command2_Click()
'necessite d'activer reference Microsoft Shell Controls and Automation
Dim objShell As Shell
Dim objFolder As Folder
Dim strFileName As FolderItem
 
 
Dim Chemin As String, Fichier As String
Dim InfoSrecup As String
Dim Largeur As Integer, Hauteur As Integer
Dim TblValeur() As String
 
'Chemin = "F:\PersoFrancis" 'adapter le chemin
'Fichier = "DVP2.bmp" 'adapter le fichier
'Fichier = "FondAlsace.jpg" 'adapter le fichier
Chemin = "F:\PersoFrancis\Des Gifs Animés" 'adapter le chemin
Fichier = "ClusesEnviron3.gif" 'adapter le fichier
 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(Chemin)
Set strFileName = objFolder.Items.Item(Fichier)
If objFolder.GetDetailsOf(strFileName, 31) <> "" Then
    InfoSrecup = Trim$(objFolder.GetDetailsOf(strFileName, 31))
End If
Set objShell = Nothing: Set objFolder = Nothing: Set strFileName = Nothing
 
'--------------- indispensable sous Seven -----------------
'         InfoSrecup = ?481 x 266?
If Asc(Left(InfoSrecup, 1)) = 63 Then
    InfoSrecup = Right(InfoSrecup, Len(InfoSrecup) - 1)
'         InfoSrecup   = 481 x 266?
End If
If Asc(Right(InfoSrecup, 1)) = 63 Then
    InfoSrecup = Left(InfoSrecup, Len(InfoSrecup) - 1)
'         InfoSrecup = 481 x 266
End If
'------------- fin indispensable sous Seven ---------------
 
InfoSrecup = Replace(InfoSrecup, " ", "")
'         InfoSrecup = 481x266
TblValeur = Split(InfoSrecup, "x")
Largeur = TblValeur(0)
Hauteur = TblValeur(1)
MsgBox "Largeur: " & Largeur & vbCrLf & "Hauteur: " & Hauteur
End Sub

C'est un code qui date et qui posait problème sous Seven, j'utilise maintenant GDIPLUS.DLL, mais je viens de le retravailler un peu pour toi, et cela fonctionne correctement.

un code retrouvé dans mes archives, téléchargé y'a ... ouh... Merci à son auteur s'il se reconnait

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub
 
Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub
 
Private Sub File1_Click()
    Dim hauteur As Variant
    Dim largeur As Variant
    Dim image As String
    Dim a0 As Byte
    Dim a1 As Byte
    Dim a10 As Long
    Dim FF As Integer
 
    If File1.ListCount > 0 Then
 
        For i = 0 To File1.ListCount - 1
            If File1.Selected(i) Then
                If Right(File1.Path, 1) <> "\" Then
                    image = File1.Path & "\" & File1.List(i)
                Else
                    image = File1.Path & File1.List(i)
                End If
            End If
        Next i
    End If
 
 
    ' ouverture du fichier
    ' c'est 5 car dans mon autre source 1 et 2 était pris
    FF = FreeFile
    Open image For Binary As #FF Len = 1024
 
    ' les markers sont de type FFXX suivi de 2 octets, sa taille
    ' on trouve normalement
    ' en 1 : FFD0 le SOI marker, sa taille est donc en octet 3
    ' en 2 FFE0 (jfif marker)
    ' ensuite FFDB(quantizise)/FFEC(?)/FFEE(commentaire)
    ' enfin le FFCx (avec x=0,1,2,3,5,6,7,9,a,b,d,e,f) les autes sont pas bons
    ' c'est le début de l'image, ke x, c'est le début de codage
    ' puis FFC4 (table de huffman) et le FFDA (start of scan)
    ' et à la fin FFD9 : fin d'image
    ' le nombre de marker est variable, donc il faut chercher
    Get #FF, 1, a0
    Get #FF, 2, a1
    ' vérification de l'entête, le jpg c'est FFD8
    If (a0 = &HFF And a1 = &HD8) Then
        a10 = 3
        For i = 1 To 10
            ' a10 pointe sur l'entête du marker
            ' la boucle limitée à 10 recherches permet que ça plante pas sur 'EOF' dès qu'un fichier est pas bon
            Get #FF, a10, a0
            Get #FF, a10 + 1, a1
            If (a1 = 192 Or a1 = 193 Or a1 = 194 Or a1 = 195 Or a1 = 197 Or a1 = 198 Or a1 = 199 Or a1 = 201 Or a1 = 202 Or a1 = 203 Or a1 = 205 Or a1 = 206 Or a1 = 207) Then
                ' par exemple FF C0 00 11 08 05 E0 03 E8
                ' FF C0 : début de frame
                ' 00 11 : la taille de ce marker (17 octets), a10 pointe sur 00
                ' 08 : P (sample precision = 8 quasi toujours)
                ' 05 E0 : Y (hauteur)
                ' 03 E8 : X (largeur)
                Get #FF, a10 + 5, a0
                Get #FF, a10 + 6, a1
                ' a10 et hauteur sont de long, a1 et a2 des bytes
                ' le & permet de pas générer d'erreur en dessus de 32736
                ' le calcul se fait en long comme ça au lieu de interger par défaut
                hauteur = 256& * a0 + a1
                Get #FF, a10 + 7, a0
                Get #FF, a10 + 8, a1
                largeur = 256& * a0 + a1
                i = 20
                'MsgBox ("H=" + Str(hauteur) + "- L=" + Str(largeur))
            End If
            Get #FF, a10 + 2, a0
            Get #FF, a10 + 3, a1
            ' a10 : ancien offset
            ' a0*256+a1 : offset du à la taille du marker
            ' et le 2, c'est l'offset pour la taille de l'entête du marker FFXX
            a10 = 2& + a10 + a0 * 256& + a1
        Next i
        Label1 = "H=" + Str(hauteur) + " - L=" + Str(largeur)
    Else
        Label1 = "En tête non standard" + Str(a0) + Str(a1)
    End If
    Close #FF
    ' si i= 11, pas de frame valide trouvée
    ' si i=21, frame valide touvée
 
    If (i = 11) Then
        Label1 = "pas de frame valable trouvée ou plus de 10 marker"
    End If
End Sub

20/04/2011, 21h25
Souleyre

Francis, merci pour ton code. En fait, c'est celui que j'utilisais jusqu'à présent mais je me vois obligé de l'abandonner à cause des difficultés liées à la distribution (Error 430!)

Thierry, ton code fonctionne à merveille et je t'en remercie.

Maintenant j'ai un nouveau problème, l'affirmation que je faisais dans mon premier message quant à la position des octets largeur et hauteur des fichiers tif se révèle fausse ou du moins pas universelle pour tous les fichiers tif. Je cherche donc une routine analogue à celle de Thierry mais adaptée aux tif.

Francis, tu évoques la piste du GDI+, pourrais-tu m'en dire plus?
21/04/2011, 11h36
DarkVader

GDI+ :
voir GdipLoadImageFromFile+GdipGetImageDimension
21/04/2011, 18h40
Souleyre

Finalement, la solution des fonctions GDI+ est la plus satisfaisante car la plus universelle.
Un grand merci à tous ceux qui en participant à cette discussion m'ont mis sur la voie.