Lecture et écriture de fichiers BMP 24bit et 1bit

**electroremy** · 24/04/2014, 01h01

Bonsoir,

Je galère depuis plusieurs jours pour un problème très simple à priori : lire une image au format BMP en couleur, et à partir de cela en créer une en noir et blanc (pas en niveau de gris), travailler dessus et ensuite l'enregistrer. Ceci est juste un petit préalable à un programme de traitement d'image sur lequel je travaille

Après deux façons de procéder que j'ai abandonné, j'ai décidé de lire et d'écrire directement les fichiers en binaire, en stockant les données dans des tableaux, sans utiliser aucune fonction graphique. En fait ce n'est pas plus mal car mon programme n'a pas besoin d'afficher les images

Donc après une nouvelle fois de longues recherches et essais, je tombe encore sur un os. Ce code ne fonctionne pas, le fichier resultat est illisible (les logiciels comme paint ou la visionneuse windows me disent que le fichier est corrompu); je ne vois pas où est l'erreur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
Imports System
Imports System.IO
Imports System.Security.Permissions
 
Public Class Form1
    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        'Ici on va lire et écrire directement un fichier BMP sans passer par les fonctions graphiques
        Dim mes As String
 
        Dim FichierImageDepart As String
        Dim FichierImageResultat As String
 
        Dim tmpb As Byte
        Dim tmps As String
        Dim tmpi As UInt16
        Dim tmpl As UInt32
 
        Dim i As Integer
 
        Dim Largeur As UInt32
        Dim Hauteur As UInt32
        Dim nBitsParPixel As UInt16
        Dim tailleImageOctets As UInt32
 
        Dim nOctetsParLigne As UInt32
        Dim nOctetsParLigne2 As UInt32
        Dim x As UInt32
        Dim y As UInt32
 
        FichierImageDepart = My.Application.Info.DirectoryPath + "\ImageALire_GRIS.BMP"
        'FichierImageDepart = My.Application.Info.DirectoryPath + "\ImageALire_GRIS2.BMP"
        FichierImageResultat = My.Application.Info.DirectoryPath + "\ImageResultat4.BMP"
 
        Dim binReader As New BinaryReader(File.Open(FichierImageDepart, FileMode.Open))
        'Lecture de l'entête
        'Lecture des deux octets descripteur de type
        tmps = binReader.ReadChars(2)
        If tmps <> "BM" Then
            MsgBox("Le fichier " + FichierImageDepart + "n'est pas de type BMP")
            Exit Sub
        End If
        'Taille du fichier
        tmpl = binReader.ReadUInt32
        'Reservé
        tmpl = binReader.ReadUInt32
        'Offset de l'image
        tmpl = binReader.ReadUInt32
        'Taille de l'entête image
        tmpl = binReader.ReadUInt32
        'Dimenssions de l'Image
        Largeur = binReader.ReadUInt32
        Hauteur = binReader.ReadUInt32
        'Nombre de plan
        tmpi = binReader.ReadInt16
        'Nombre de bits par pixel
        nBitsParPixel = binReader.ReadInt16
        If nBitsParPixel <> 24 Then
            MsgBox("Le fichier " + FichierImageDepart + "n'est pas en couleurs 24 bits, abandon de la lecture")
            Exit Sub
        End If
        'Methode de compression
        tmpl = binReader.ReadUInt32
        If tmpl <> 0 Then
            MsgBox("Le fichier " + FichierImageDepart + "est compressé, abandon de la lecture")
            Exit Sub
        End If
        'Taille de l'image en octets
        tailleImageOctets = binReader.ReadUInt32
        'Résolution de l'image
        tmpl = binReader.ReadUInt32
        tmpl = binReader.ReadUInt32
        'Couleurs utilisées
        tmpl = binReader.ReadUInt32
        'Couleurs importantes :
        tmpl = binReader.ReadUInt32
        '
        'Lecture de l'image
        Dim dataImage() As Byte = binReader.ReadBytes(tailleImageOctets)
 
        binReader.Close()
 
        mes = "Résolution = " + Format(nBitsParPixel) + " bits/pixel" + vbCrLf
        mes = mes + "Largeur = " + Format(Largeur) + " pixels" + vbCrLf
        mes = mes + "Hauteur = " + Format(Hauteur) + " pixels" + vbCrLf
        mes = mes + "Nb pixels image utile = " + Format(Largeur * Hauteur) + " pixel" + vbCrLf
        mes = mes + "Nb octets image utile = " + Format(Largeur * Hauteur * 3) + " octets" + vbCrLf
        mes = mes + "Taille de l'image = " + Format(tailleImageOctets) + " octets" + vbCrLf
        MsgBox(mes)
 
        nOctetsParLigne = Fix((Largeur * 3 + 3) / 4) * 4
 
        'Génération de la nouvelle image :
        nOctetsParLigne2 = Fix((Largeur + 31) / 32) * 4 'nOctetsParLigne doit être multiple de 4
        MsgBox("nOctetsParLigne = " + Format(nOctetsParLigne2))
        Dim dataImage2(nOctetsParLigne2 * Hauteur) As Byte
 
        'calcul de l'image en N&B à partir de l'image en couleur:
        For y = 0 To Hauteur - 1
            i = 1
            tmpi = 0
            tmpb = 0
            For x = 0 To Largeur - 1
                If i = 256 Then
                    i = 1
                    tmpb = 0
                    dataImage2(tmpi + nOctetsParLigne2 * y) = tmpb
                    tmpi = tmpi + 1
                End If
                'Calcul basique, juste une des trois couleurs RBV
                If dataImage(y * nOctetsParLigne + x * 3) > 128 Then
                    'On allume le pixel 
                    tmpb = tmpb + i
                End If
                i = 2 * i
            Next
            'Le dernier octet :
            dataImage2(tmpi + nOctetsParLigne2 * y) = tmpb
            'Les octets à 0 pour avoir une ligne multiple de 4 octets :
            If tmpi < nOctetsParLigne2 - 1 Then
                For i = tmpi + 1 To nOctetsParLigne2 - 1
                    dataImage2(i + nOctetsParLigne2 * y) = 0
                Next
            End If
        Next
 
        Dim binWriter As New BinaryWriter(File.Open(FichierImageResultat, FileMode.Create))
        'Ecriture de l'entête
        tmpi = &H4D42 : binWriter.Write(tmpi)
        'Taille du fichier
        tmpl = 54 + 1 + nOctetsParLigne2 * Hauteur
        binWriter.Write(tmpl)
        'Reservé
        tmpl = 0 : binWriter.Write(tmpl)
        'Offset de l'image
        tmpl = 54 : binWriter.Write(tmpl)
        'Taille de l'entête image
        tmpl = 40 : binWriter.Write(tmpl)
        'Dimenssions de l'Image
        binWriter.Write(Largeur)
        binWriter.Write(Hauteur)
        'Nombre de plan
        tmpi = 1 : binWriter.Write(tmpi)
        'Nombre de bits par pixel
        tmpi = 1 : binWriter.Write(tmpi)
        'Methode de compression
        tmpl = 0 : binWriter.Write(tmpl)
        'Taille de l'image en octets
        tmpl = nOctetsParLigne2 * Hauteur
        binWriter.Write(tmpl)
        'Résolution de l'image
        tmpl = 3780 : binWriter.Write(tmpl) : binWriter.Write(tmpl)
        'Couleurs utilisées
        tmpl = 0 : binWriter.Write(tmpl)
        'Couleurs importantes :
        tmpl = 0 : binWriter.Write(tmpl)
 
        'Les données
        binWriter.Write(dataImage2)
 
        binWriter.Close()
 
        MsgBox("Traitement terminé")
    End Sub
End Class

j'ai passer les fichiers à la loupe dans un éditeur hexadécimal et pareil, je ne comprends pas où est le problème, les entêtes sont correctes, les données au bon endroit et de bonne longueur :

Nom : hexa.jpg
Affichages : 1408
Taille : 419,0 Ko

Nom : hexa.jpg
Affichages : 1408
Taille : 419,0 Ko

NB : le fait que les données n'aient pas la bonne valeur est encore un autre problème mais pour le moment ce qui est important est de pouvoir générer un BMP valide, histoire de ne plus travailler en aveugle...

merci

A+

**electroremy** · 24/04/2014, 01h56

Pour le format 1bit, il semblerai qu'il faille une palette

j'ai réussi à obtenir un fichier correct (non corrompu), mais l'image est entièrement noire... c'est déjà un soucis en moins

voici le code modifié

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
Imports System
Imports System.IO
Imports System.Security.Permissions
 
    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        'Ici on va lire et écrire directement un fichier BMP sans passer par les fonctions graphiques
        Dim mes As String
 
        Dim FichierImageDepart As String
        Dim FichierImageResultat As String
 
        Dim tmpb As Byte
        Dim tmps As String
        Dim tmpi As UInt16
        Dim tmpl As UInt32
 
        Dim i As Integer
 
        Dim Largeur As UInt32
        Dim Hauteur As UInt32
        Dim nBitsParPixel As UInt16
        Dim tailleImageOctets As UInt32
 
        Dim nOctetsParLigne As UInt32
        Dim nOctetsParLigne2 As UInt32
        Dim x As UInt32
        Dim y As UInt32
 
        FichierImageDepart = My.Application.Info.DirectoryPath + "\ImageALire_GRIS.BMP"
        'FichierImageDepart = My.Application.Info.DirectoryPath + "\ImageALire_GRIS2.BMP"
        FichierImageResultat = My.Application.Info.DirectoryPath + "\ImageResultat4.BMP"
 
        Dim binReader As New BinaryReader(File.Open(FichierImageDepart, FileMode.Open))
        'Lecture de l'entête
        'Lecture des deux octets descripteur de type
        tmps = binReader.ReadChars(2)
        If tmps <> "BM" Then
            MsgBox("Le fichier " + FichierImageDepart + "n'est pas de type BMP")
            Exit Sub
        End If
        'Taille du fichier
        tmpl = binReader.ReadUInt32
        'Reservé
        tmpl = binReader.ReadUInt32
        'Offset de l'image
        tmpl = binReader.ReadUInt32
        'Taille de l'entête image
        tmpl = binReader.ReadUInt32
        'Dimenssions de l'Image
        Largeur = binReader.ReadUInt32
        Hauteur = binReader.ReadUInt32
        'Nombre de plan
        tmpi = binReader.ReadInt16
        'Nombre de bits par pixel
        nBitsParPixel = binReader.ReadInt16
        If nBitsParPixel <> 24 Then
            MsgBox("Le fichier " + FichierImageDepart + "n'est pas en couleurs 24 bits, abandon de la lecture")
            Exit Sub
        End If
        'Methode de compression
        tmpl = binReader.ReadUInt32
        If tmpl <> 0 Then
            MsgBox("Le fichier " + FichierImageDepart + "est compressé, abandon de la lecture")
            Exit Sub
        End If
        'Taille de l'image en octets
        tailleImageOctets = binReader.ReadUInt32
        'Résolution de l'image
        tmpl = binReader.ReadUInt32
        tmpl = binReader.ReadUInt32
        'Couleurs utilisées
        tmpl = binReader.ReadUInt32
        'Couleurs importantes :
        tmpl = binReader.ReadUInt32
        '
        'Lecture de l'image
        Dim dataImage() As Byte = binReader.ReadBytes(tailleImageOctets)
 
        binReader.Close()
 
        mes = "Résolution = " + Format(nBitsParPixel) + " bits/pixel" + vbCrLf
        mes = mes + "Largeur = " + Format(Largeur) + " pixels" + vbCrLf
        mes = mes + "Hauteur = " + Format(Hauteur) + " pixels" + vbCrLf
        mes = mes + "Nb pixels image utile = " + Format(Largeur * Hauteur) + " pixel" + vbCrLf
        mes = mes + "Nb octets image utile = " + Format(Largeur * Hauteur * 3) + " octets" + vbCrLf
        mes = mes + "Taille de l'image = " + Format(tailleImageOctets) + " octets" + vbCrLf
        MsgBox(mes)
 
        nOctetsParLigne = Fix((Largeur * 3 + 3) / 4) * 4
 
        'Génération de la nouvelle image :
        nOctetsParLigne2 = Fix((Largeur + 31) / 32) * 4 'nOctetsParLigne doit être multiple de 4
        MsgBox("nOctetsParLigne = " + Format(nOctetsParLigne2))
        Dim dataImage2(nOctetsParLigne2 * Hauteur) As Byte
 
        'calcul de l'image en N&B à partir de l'image en couleur:
        For y = 0 To Hauteur - 1
            i = 1
            tmpi = 0
            tmpb = 0
            For x = 0 To Largeur - 1
                If i = 256 Then
                    i = 1
                    tmpb = 0
                    dataImage2(tmpi + nOctetsParLigne2 * y) = tmpb
                    tmpi = tmpi + 1
                End If
                'Calcul basique, juste une des trois couleurs RBV
                If dataImage(y * nOctetsParLigne + x * 3) > 128 Then
                    'On allume le pixel 
                    tmpb = tmpb + i
                End If
                i = 2 * i
            Next
            'Le dernier octet :
            dataImage2(tmpi + nOctetsParLigne2 * y) = tmpb
            'Les octets à 0 pour avoir une ligne multiple de 4 octets :
            If tmpi < nOctetsParLigne2 - 1 Then
                For i = tmpi + 1 To nOctetsParLigne2 - 1
                    dataImage2(i + nOctetsParLigne2 * y) = 0
                Next
            End If
        Next
 
        Dim binWriter As New BinaryWriter(File.Open(FichierImageResultat, FileMode.Create))
        'Ecriture de l'entête
        tmpi = &H4D42 : binWriter.Write(tmpi)
        'Taille du fichier
        tmpl = 54 + 1 + 8 + nOctetsParLigne2 * Hauteur
        binWriter.Write(tmpl)
        'Reservé
        tmpl = 0 : binWriter.Write(tmpl)
        'Offset de l'image
        tmpl = 54 + 8 : binWriter.Write(tmpl)
        'Taille de l'entête image
        tmpl = 40 : binWriter.Write(tmpl)
        'Dimenssions de l'Image
        binWriter.Write(Largeur)
        binWriter.Write(Hauteur)
        'Nombre de plan
        tmpi = 1 : binWriter.Write(tmpi)
        'Nombre de bits par pixel
        tmpi = 1 : binWriter.Write(tmpi)
        'Methode de compression
        tmpl = 0 : binWriter.Write(tmpl)
        'Taille de l'image en octets
        tmpl = nOctetsParLigne2 * Hauteur
        binWriter.Write(tmpl)
        'Résolution de l'image
        tmpl = 3780 : binWriter.Write(tmpl) : binWriter.Write(tmpl)
        'Couleurs utilisées
        tmpl = 2 : binWriter.Write(tmpl)
        'Couleurs importantes :
        tmpl = 0 : binWriter.Write(tmpl)
 
        'palette :
        'couleur 0
        tmpb = 0 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
        'couleur 1
        tmpb = 255 : binWriter.Write(tmpb)
        tmpb = 255 : binWriter.Write(tmpb)
        tmpb = 255 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
 
 
        'Les données
        binWriter.Write(dataImage2)
 
        binWriter.Close()
 
        MsgBox("Traitement terminé")
    End Sub
End Class

**electroremy** · 24/04/2014, 02h05

Et voilà, c'est à moitié résolu, il reste à optimiser le code

et surtout, le code ne fonctionne pas s'il faut lire une image dont la largeur est non multiple de 4; par ex pour une image de 500 x 150 pixel ça marche, mais pas pour une image de 499 x 150 pixels. En fait le msgbox me donne une taille d'image en octets de 0... bizarre...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
Imports System
Imports System.IO
Imports System.Security.Permissions
 
Public Class Form1
 
    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        'Ici on va lire et écrire directement un fichier BMP sans passer par les fonctions graphiques
        Dim mes As String
 
        Dim FichierImageDepart As String
        Dim FichierImageResultat As String
 
        Dim tmpb As Byte
        Dim tmps As String
        Dim tmpi As UInt16
        Dim tmpl As UInt32
 
        Dim i As Integer
 
        Dim Largeur As UInt32
        Dim Hauteur As UInt32
        Dim nBitsParPixel As UInt16
        Dim tailleImageOctets As UInt32
 
        Dim nOctetsParLigne As UInt32
        Dim nOctetsParLigne2 As UInt32
        Dim x As UInt32
        Dim y As UInt32
 
        FichierImageDepart = My.Application.Info.DirectoryPath + "\ImageALire_GRIS.BMP"
        'FichierImageDepart = My.Application.Info.DirectoryPath + "\ImageALire_GRIS2.BMP"
        FichierImageResultat = My.Application.Info.DirectoryPath + "\ImageResultat4.BMP"
 
        Dim binReader As New BinaryReader(File.Open(FichierImageDepart, FileMode.Open))
        'Lecture de l'entête
        'Lecture des deux octets descripteur de type
        tmps = binReader.ReadChars(2)
        If tmps <> "BM" Then
            MsgBox("Le fichier " + FichierImageDepart + "n'est pas de type BMP")
            Exit Sub
        End If
        'Taille du fichier
        tmpl = binReader.ReadUInt32
        'Reservé
        tmpl = binReader.ReadUInt32
        'Offset de l'image
        tmpl = binReader.ReadUInt32
        'Taille de l'entête image
        tmpl = binReader.ReadUInt32
        'Dimenssions de l'Image
        Largeur = binReader.ReadUInt32
        Hauteur = binReader.ReadUInt32
        'Nombre de plan
        tmpi = binReader.ReadInt16
        'Nombre de bits par pixel
        nBitsParPixel = binReader.ReadInt16
        If nBitsParPixel <> 24 Then
            MsgBox("Le fichier " + FichierImageDepart + "n'est pas en couleurs 24 bits, abandon de la lecture")
            Exit Sub
        End If
        'Methode de compression
        tmpl = binReader.ReadUInt32
        If tmpl <> 0 Then
            MsgBox("Le fichier " + FichierImageDepart + "est compressé, abandon de la lecture")
            Exit Sub
        End If
        'Taille de l'image en octets
        tailleImageOctets = binReader.ReadUInt32
        'Résolution de l'image
        tmpl = binReader.ReadUInt32
        tmpl = binReader.ReadUInt32
        'Couleurs utilisées
        tmpl = binReader.ReadUInt32
        'Couleurs importantes :
        tmpl = binReader.ReadUInt32
        '
        'Lecture de l'image
        Dim dataImage() As Byte = binReader.ReadBytes(tailleImageOctets)
 
        binReader.Close()
 
        mes = "Résolution = " + Format(nBitsParPixel) + " bits/pixel" + vbCrLf
        mes = mes + "Largeur = " + Format(Largeur) + " pixels" + vbCrLf
        mes = mes + "Hauteur = " + Format(Hauteur) + " pixels" + vbCrLf
        mes = mes + "Nb pixels image utile = " + Format(Largeur * Hauteur) + " pixel" + vbCrLf
        mes = mes + "Nb octets image utile = " + Format(Largeur * Hauteur * 3) + " octets" + vbCrLf
        mes = mes + "Taille de l'image = " + Format(tailleImageOctets) + " octets" + vbCrLf
        MsgBox(mes)
 
        nOctetsParLigne = Fix((Largeur * 3 + 3) / 4) * 4
 
        'Génération de la nouvelle image :
        nOctetsParLigne2 = Fix((Largeur + 31) / 32) * 4 'nOctetsParLigne doit être multiple de 4
        MsgBox("nOctetsParLigne = " + Format(nOctetsParLigne2))
        Dim dataImage2(nOctetsParLigne2 * Hauteur) As Byte
 
        For y = 0 To Hauteur - 1
            i = 128
            tmpi = 0
            tmpb = 0
            For x = 0 To Largeur - 1
                'Calcul basique, juste une des trois couleurs RBV
                If dataImage(y * nOctetsParLigne + x * 3 + 1) > 128 Then
                    'On allume le pixel 
                    tmpb = tmpb + i
                End If
                If i = 1 Then
                    dataImage2(tmpi + nOctetsParLigne2 * y) = tmpb
                    i = 256
                    tmpb = 0
                    tmpi = tmpi + 1
                End If
                i = i / 2
            Next
            'Le dernier octet :
            dataImage2(tmpi + nOctetsParLigne2 * y) = tmpb
            'Les octets à 0 pour avoir une ligne multiple de 4 octets :
            If tmpi < nOctetsParLigne2 - 1 Then
                For i = tmpi + 1 To nOctetsParLigne2 - 1
                    dataImage2(i + nOctetsParLigne2 * y) = 0
                Next
            End If
        Next
 
        Dim binWriter As New BinaryWriter(File.Open(FichierImageResultat, FileMode.Create))
        'Ecriture de l'entête
        tmpi = &H4D42 : binWriter.Write(tmpi)
        'Taille du fichier
        tmpl = 54 + 1 + 8 + nOctetsParLigne2 * Hauteur
        binWriter.Write(tmpl)
        'Reservé
        tmpl = 0 : binWriter.Write(tmpl)
        'Offset de l'image
        tmpl = 54 + 8 : binWriter.Write(tmpl)
        'Taille de l'entête image
        tmpl = 40 : binWriter.Write(tmpl)
        'Dimenssions de l'Image
        binWriter.Write(Largeur)
        binWriter.Write(Hauteur)
        'Nombre de plan
        tmpi = 1 : binWriter.Write(tmpi)
        'Nombre de bits par pixel
        tmpi = 1 : binWriter.Write(tmpi)
        'Methode de compression
        tmpl = 0 : binWriter.Write(tmpl)
        'Taille de l'image en octets
        tmpl = nOctetsParLigne2 * Hauteur
        binWriter.Write(tmpl)
        'Résolution de l'image
        tmpl = 3780 : binWriter.Write(tmpl) : binWriter.Write(tmpl)
        'Couleurs utilisées
        tmpl = 2 : binWriter.Write(tmpl)
        'Couleurs importantes :
        tmpl = 0 : binWriter.Write(tmpl)
 
        'palette :
        'couleur 0
        tmpb = 0 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
        'couleur 1
        tmpb = 255 : binWriter.Write(tmpb)
        tmpb = 255 : binWriter.Write(tmpb)
        tmpb = 255 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
 
 
        'Les données
        binWriter.Write(dataImage2)
 
        binWriter.Close()
 
        MsgBox("Traitement terminé")
    End Sub
End Class

**clementmarcotte** · 24/04/2014, 02h17

http://www.codeproject.com/Articles/...-using-Libtiff

http://www.codeproject.com/Articles/...ide-to-Bitmaps

http://www.codeproject.com/Articles/...gick-in-VB-NET

**electroremy** · 24/04/2014, 18h29

Envoyé par clementmarcotte

http://www.codeproject.com/Articles/...ide-to-Bitmaps

=> je l'avais trouvé hier soir ce site en cherchant... il y a plus d'infos sur le format BMP dans la version anglaise de Wikipédia (la version française est beaucoup plus succinte)

Envoyé par clementmarcotte

http://www.codeproject.com/Articles/...-using-Libtiff

=> ça n'a rien à voir avec mon pb, et c'est du C pas du VB

Envoyé par clementmarcotte

http://www.codeproject.com/Articles/...gick-in-VB-NET

=> Ceci a l'air très intéressant, merci

, je vais voir cela en détail ce soir (à noter que je souhaite, dans l'idéal, ne pas dépendre d'une DLL)

A+ merci !

**electroremy** · 24/04/2014, 22h30

Avant de commencer, après pas mal de recherches, la meilleur information sur le format bitmap que j'ai trouvé est sur le wikipedia anglais

http://en.wikipedia.org/wiki/BMP_file_format

Attention : d'autres sites sont incomplets ou pire donnent des informations fausses...

Alors j'ai découvert un truc bizarre : pour les fichiers BMP dont la taille selon X (width) n'est pas multiple de 4, la taille de l'image "Image Size" dans le "DIB header" est nulle !

du coup, pour la lecture, il faut calculer cette taille

voici le code modifié :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
Imports System
Imports System.IO
Imports System.Security.Permissions
 
    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        'Ici on va lire et écrire directement un fichier BMP sans passer par les fonctions graphiques
        Dim mes As String
 
        Dim FichierImageDepart As String
        Dim FichierImageResultat As String
 
        Dim tmpb As Byte
        Dim tmps As String
        Dim tmpi As UInt16
        Dim tmpl As UInt32
 
        Dim i As Integer
 
        Dim Largeur As UInt32
        Dim Hauteur As UInt32
        Dim nBitsParPixel As UInt16
        Dim tailleImageOctets As UInt32
 
        Dim nOctetsParLigne As UInt32
        Dim nOctetsParLigne2 As UInt32
        Dim x As UInt32
        Dim y As UInt32
 
        'FichierImageDepart = My.Application.Info.DirectoryPath + "\ImageALire_GRIS.BMP"
        FichierImageDepart = My.Application.Info.DirectoryPath + "\ImageALire_GRIS2.BMP"
        FichierImageResultat = My.Application.Info.DirectoryPath + "\ImageResultat4.BMP"
 
        Dim binReader As New BinaryReader(File.Open(FichierImageDepart, FileMode.Open))
        'Lecture de l'entête
        'Lecture des deux octets descripteur de type
        tmps = binReader.ReadChars(2)
        If tmps <> "BM" Then
            MsgBox("Le fichier " + FichierImageDepart + "n'est pas de type BMP")
            Exit Sub
        End If
        'Taille du fichier
        tmpl = binReader.ReadUInt32
        'Reservé
        tmpl = binReader.ReadUInt32
        'Offset de l'image
        tmpl = binReader.ReadUInt32
        'Taille de l'entête image
        tmpl = binReader.ReadUInt32
        'Dimenssions de l'Image
        Largeur = binReader.ReadUInt32
        Hauteur = binReader.ReadUInt32
        'Nombre de plan
        tmpi = binReader.ReadInt16
        'Nombre de bits par pixel
        nBitsParPixel = binReader.ReadInt16
        If nBitsParPixel <> 24 Then
            MsgBox("Le fichier " + FichierImageDepart + "n'est pas en couleurs 24 bits, abandon de la lecture")
            Exit Sub
        End If
        'Methode de compression
        tmpl = binReader.ReadUInt32
        If tmpl <> 0 Then
            MsgBox("Le fichier " + FichierImageDepart + "est compressé, abandon de la lecture")
            Exit Sub
        End If
        'Taille de l'image en octets
        tailleImageOctets = binReader.ReadUInt32
        'Résolution de l'image
        tmpl = binReader.ReadUInt32
        tmpl = binReader.ReadUInt32
        'Couleurs utilisées
        tmpl = binReader.ReadUInt32
        'Couleurs importantes :
        tmpl = binReader.ReadUInt32
        '
        'Lecture de l'image
 
        'Donc la on recalcule la taille de l'image :
        nOctetsParLigne = Fix((Largeur * 3 + 3) / 4) * 4
        tailleImageOctets = nOctetsParLigne * Hauteur
 
        Dim dataImage() As Byte = binReader.ReadBytes(tailleImageOctets)
 
        binReader.Close()
 
        mes = "Résolution = " + Format(nBitsParPixel) + " bits/pixel" + vbCrLf
        mes = mes + "Largeur = " + Format(Largeur) + " pixels" + vbCrLf
        mes = mes + "Hauteur = " + Format(Hauteur) + " pixels" + vbCrLf
        mes = mes + "Nb pixels image utile = " + Format(Largeur * Hauteur) + " pixel" + vbCrLf
        mes = mes + "Nb octets image utile = " + Format(Largeur * Hauteur * 3) + " octets" + vbCrLf
        mes = mes + "Taille de l'image = " + Format(tailleImageOctets) + " octets" + vbCrLf
        MsgBox(mes)
 
 
 
        'Génération de la nouvelle image :
        nOctetsParLigne2 = Fix((Largeur + 31) / 32) * 4 'nOctetsParLigne doit être multiple de 4
        MsgBox("nOctetsParLigne = " + Format(nOctetsParLigne2))
        Dim dataImage2(nOctetsParLigne2 * Hauteur) As Byte
 
        For y = 0 To Hauteur - 1
            i = 128
            tmpi = 0
            tmpb = 0
            For x = 0 To Largeur - 1
                'Calcul basique, juste une des trois couleurs RBV
                If dataImage(y * nOctetsParLigne + x * 3 + 1) > 128 Then
                    'On allume le pixel 
                    tmpb = tmpb + i
                End If
                If i = 1 Then
                    dataImage2(tmpi + nOctetsParLigne2 * y) = tmpb
                    i = 256
                    tmpb = 0
                    tmpi = tmpi + 1
                End If
                i = i / 2
            Next
            'Le dernier octet :
            dataImage2(tmpi + nOctetsParLigne2 * y) = tmpb
            'Les octets à 0 pour avoir une ligne multiple de 4 octets :
            If tmpi < nOctetsParLigne2 - 1 Then
                For i = tmpi + 1 To nOctetsParLigne2 - 1
                    dataImage2(i + nOctetsParLigne2 * y) = 0
                Next
            End If
        Next
 
        Dim binWriter As New BinaryWriter(File.Open(FichierImageResultat, FileMode.Create))
        'Ecriture de l'entête
        tmpi = &H4D42 : binWriter.Write(tmpi)
        'Taille du fichier
        tmpl = 54 + 1 + 8 + nOctetsParLigne2 * Hauteur
        binWriter.Write(tmpl)
        'Reservé
        tmpl = 0 : binWriter.Write(tmpl)
        'Offset de l'image
        tmpl = 54 + 8 : binWriter.Write(tmpl)
        'Taille de l'entête image
        tmpl = 40 : binWriter.Write(tmpl)
        'Dimenssions de l'Image
        binWriter.Write(Largeur)
        binWriter.Write(Hauteur)
        'Nombre de plan
        tmpi = 1 : binWriter.Write(tmpi)
        'Nombre de bits par pixel
        tmpi = 1 : binWriter.Write(tmpi)
        'Methode de compression
        tmpl = 0 : binWriter.Write(tmpl)
        'Taille de l'image en octets
        tmpl = nOctetsParLigne2 * Hauteur
        binWriter.Write(tmpl)
        'Résolution de l'image
        tmpl = 3780 : binWriter.Write(tmpl) : binWriter.Write(tmpl)
        'Couleurs utilisées
        tmpl = 2 : binWriter.Write(tmpl)
        'Couleurs importantes :
        tmpl = 0 : binWriter.Write(tmpl)
 
        'palette :
        'couleur 0
        tmpb = 0 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
        'couleur 1
        tmpb = 255 : binWriter.Write(tmpb)
        tmpb = 255 : binWriter.Write(tmpb)
        tmpb = 255 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
 
 
        'Les données
        binWriter.Write(dataImage2)
 
        binWriter.Close()
 
        MsgBox("Traitement terminé")
    End Sub
End Class

et voilà cela fonctionne

j’espère que cette lecture et écriture de BMP sans fonction graphique ni DLL pourra aider d'autres gens

cela suffit pour mon application; si j'ai le temps, je ferais une classe permettant de lire les différents formats de bitmap (1, 2, 4, 8, 16, 24 bits)

A+

**electroremy** · 27/04/2014, 18h55

Voici une classe permettant de :
- lire des fichiers BMP au format 1 bit, 4 bits, 8 bits et 24 bits (lecture optimisée)
- convertir les données en noir et blanc (1 bit) (conversion optimisée)
- écrire les données sous forme de fichier BMP au format 1 bit
- de créer à partir des données un System.Drawing.Bitmap au format 1 bit ou 24 bits pour l'utiliser ensuite dans VB.NET (24 bits permettant de dessiner avec un objet Graphics)
- de récupérer les données à partir d'un System.Drawing.Bitmap

L'intérêt de cette classe est de pouvoir manipuler le bitmap sous forme d'un tableau de bytes, avec une vitesse d’exécution optimale

Vous pouvez facilement modifier la classe pour d'autres fonctionnalités

Je vais me servir de cette classe pour pouvoir faire de la détection de contour en vue d'usiner une image

Voici donc la classe :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
Imports System
Imports System.IO
 
Public Class BMP1BIT
    Protected Largeur As UInt32
    Protected Hauteur As UInt32
    Protected nOctetsParLigne As UInt32
    Public Donnees() As Byte
 
    Public Sub New()
 
    End Sub
 
    Public Sub New(Fichier As String)
        Call Lire(Fichier)
    End Sub
 
    Public Sub New(GDI_Bitmap As Bitmap)
        Call SetFromSystemDrawingBitmap(GDI_Bitmap)
    End Sub
 
    Public Sub New(LargeurX As UInt32, HauteurY As UInt32, Optional FondsBlanc As Boolean = True)
        Dim i As ULong
        Dim l As ULong
        Dim b As Byte
        Largeur = LargeurX
        Hauteur = HauteurY
        nOctetsParLigne = Fix((Largeur + 31) / 32) * 4 'nOctetsParLigne doit être multiple de 4
        l = nOctetsParLigne * Hauteur
        ReDim Donnees(l)
        If FondsBlanc Then
            b = 255
        Else
            b = 0
        End If
        For i = 0 To l - 1
            Donnees(i) = b
        Next
    End Sub
 
    Public Function Lire(Fichier As String, Optional AfficheInfo As Boolean = False) As Boolean
 
        Dim PixelArray_Offset As UInt32
        Dim Header_Size As UInt32
        Dim dummy() As Byte
 
        Dim tmpb As Byte
        Dim tmps As String
        Dim tmpi As UInt16
        Dim tmpl As UInt32
 
        Dim i As Integer
 
        Dim nBitsParPixel As UInt16
        Dim tailleImageOctets As UInt32
 
        Dim nOctetsParLigne2 As UInt32
        Dim x As UInt32
        Dim y As UInt32
 
        Dim R As Byte
        Dim V As Byte
        Dim B As Byte
 
        Dim DecY As UInt32
 
        Dim Debut As DateTime
        Dim duree As TimeSpan
 
        If AfficheInfo Then Debut = DateTime.Now
 
        'LECTURE DE L'ENTETE DU FICHIER D'ENTREE ************************************************************************
 
        Dim binReader As New BinaryReader(File.Open(Fichier, FileMode.Open))
        'Lecture de l'entête
        'Lecture des deux octets descripteur de type
        tmps = binReader.ReadChars(2)
        If tmps <> "BM" Then
            MsgBox("Le fichier " + Fichier + "n'est pas de type BMP")
            Lire = False
            Exit Function
        End If
        'Taille du fichier
        tmpl = binReader.ReadUInt32
        'Reservé
        tmpl = binReader.ReadUInt32
        'Offset de l'image
        PixelArray_Offset = binReader.ReadUInt32
        'Taille de l'entête image
        Header_Size = binReader.ReadUInt32
        'Dimenssions de l'Image
        Largeur = binReader.ReadUInt32
        Hauteur = binReader.ReadUInt32
        'Nombre de plan
        tmpi = binReader.ReadInt16
        'Nombre de bits par pixel
        nBitsParPixel = binReader.ReadInt16
        'Methode de compression
        tmpl = binReader.ReadUInt32
        If tmpl <> 0 Then
            MsgBox("Le fichier " + Fichier + "est compressé, abandon de la lecture")
            Lire = False
            Exit Function
        End If
        'Taille de l'image en octets
        tailleImageOctets = binReader.ReadUInt32
        'Résolution de l'image
        tmpl = binReader.ReadUInt32
        tmpl = binReader.ReadUInt32
        'Couleurs utilisées
        tmpl = binReader.ReadUInt32
        'Couleurs importantes :
        tmpl = binReader.ReadUInt32
 
        nOctetsParLigne = Fix((Largeur + 31) / 32) * 4 'nOctetsParLigne doit être multiple de 4
 
        Select Case nBitsParPixel
            Case 1
                Dim CoulPalette0 As UInt16
                Dim CoulPalette1 As UInt16
                Dim CoulInverse As Boolean
                Dim l As ULong
                Dim j As ULong
 
                'On passe les données du header que l'on utilise pas :
                dummy = binReader.ReadBytes(Header_Size - 40)
 
                'Lecture de la palette et conversion en noir et blanc :
                CoulPalette0 = 0
                CoulPalette0 = 0.3 * binReader.ReadByte                 'B
                CoulPalette0 = CoulPalette0 + 0.59 * binReader.ReadByte 'V
                CoulPalette0 = CoulPalette0 + 0.11 * binReader.ReadByte 'R 
                tmpb = binReader.ReadByte
                CoulPalette1 = 0
                CoulPalette1 = 0.3 * binReader.ReadByte                 'B
                CoulPalette1 = CoulPalette0 + 0.59 * binReader.ReadByte 'V
                CoulPalette1 = CoulPalette0 + 0.11 * binReader.ReadByte 'R 
                tmpb = binReader.ReadByte
                CoulInverse = CoulPalette0 > CoulPalette1
                'CoulInverse = Not CoulInverse 'Test
 
                'On passe les données entre le header et les données images que l'on utilise pas :
                dummy = binReader.ReadBytes(PixelArray_Offset - 62 - (Header_Size - 40))
 
                'Lecture des données image :
                l = nOctetsParLigne * Hauteur
                Donnees = binReader.ReadBytes(l)
 
                If CoulInverse Then
                    If AfficheInfo Then MsgBox("Les couleurs noir et blanc sont inversées dans la palette")
                    For j = 0 To l - 1
                        Donnees(j) = Not Donnees(j)
                    Next
                End If
 
            Case 4  'Image en 16 couleurs
 
                Dim CoulPaletteBlanc(16) As Boolean
                Dim CoulPalette As UInt16
                Dim nCBlanc As Integer
                Dim nCNoir As Integer
 
                'On passe les données du header que l'on utilise pas :
                dummy = binReader.ReadBytes(Header_Size - 40)
 
                'Lecture de la palette et conversion en noir et blanc :
                nCBlanc = 0
                nCNoir = 0
                For i = 0 To 15
                    CoulPalette = 0
                    CoulPalette = 0.3 * binReader.ReadByte                'B
                    CoulPalette = CoulPalette + 0.59 * binReader.ReadByte 'V
                    CoulPalette = CoulPalette + 0.11 * binReader.ReadByte 'R 
                    tmpb = binReader.ReadByte
                    'CoulPaletteBlanc(i) = CoulPalette > 127
                    If CoulPalette > 127 Then
                        CoulPaletteBlanc(i) = True
                        nCBlanc = nCBlanc + 1
                    Else
                        CoulPaletteBlanc(i) = False
                        nCNoir = nCNoir + 1
                    End If
                Next
 
                If nCBlanc = 0 Then
                    MsgBox("La palette du fichier " + Fichier + " ne contient que des couleurs correspondant à du noir, abandon de la lecture")
                    Lire = False
                    Exit Function
                End If
                If nCNoir = 0 Then
                    MsgBox("La palette du fichier " + Fichier + " ne contient que des couleurs correspondant à du blanc, abandon de la lecture")
                    Lire = False
                    Exit Function
                End If
 
                'On passe les données entre le header et les données images que l'on utilise pas :
                dummy = binReader.ReadBytes(PixelArray_Offset - 118 - (Header_Size - 40))
 
                'Lecture des données image :
 
                nOctetsParLigne2 = Fix((Largeur * 4 + 31) / 32) * 4 'nOctetsParLigne doit être multiple de 4
                ReDim Donnees(nOctetsParLigne * Hauteur)
                For y = 0 To Hauteur - 1
                    i = 128
                    tmpi = 0
                    tmpb = 0
                    DecY = nOctetsParLigne * y
                    For x = 0 To Largeur - 1
                        If (x Mod 2) = 0 Then
                            'x pair
                            B = binReader.ReadByte
                            R = B >> 4
                        Else
                            'x impair
                            R = B - (R << 4)
                        End If
 
                        If CoulPaletteBlanc(R) Then
                            tmpb = tmpb + i
                        End If
                        If i = 1 Then
                            Donnees(tmpi + DecY) = tmpb
                            i = 256
                            tmpb = 0
                            tmpi = tmpi + 1
                        End If
                        i = i >> 1 'équivalent à i = i / 2
                    Next
                    'Le dernier octet :
                    Donnees(tmpi + nOctetsParLigne * y) = tmpb
                    'Les octets à 0 pour avoir une ligne multiple de 4 octets :
                    For i = tmpi + 1 To nOctetsParLigne - 1
                        Donnees(i + DecY) = 0
                    Next
                    'Lecture des octets de remplissage :
                    For i = Largeur * 3 + 1 To nOctetsParLigne2
                        tmpb = binReader.ReadByte
                    Next
                Next
 
            Case 8 'Image en 256 couleurs (pas forcément niveaux de gris)
                Dim CoulPaletteBlanc(256) As Boolean
                Dim CoulPalette As UInt16
                Dim nCBlanc As Integer
                Dim nCNoir As Integer
 
                'On passe les données du header que l'on utilise pas :
                dummy = binReader.ReadBytes(Header_Size - 40)
 
                'Lecture de la palette et conversion en noir et blanc :
                nCBlanc = 0
                nCNoir = 0
                For i = 0 To 255
                    CoulPalette = 0
                    CoulPalette = 0.3 * binReader.ReadByte                'B
                    CoulPalette = CoulPalette + 0.59 * binReader.ReadByte 'V
                    CoulPalette = CoulPalette + 0.11 * binReader.ReadByte 'R 
                    tmpb = binReader.ReadByte
                    'CoulPaletteBlanc(i) = CoulPalette > 127
                    If CoulPalette > 127 Then
                        CoulPaletteBlanc(i) = True
                        nCBlanc = nCBlanc + 1
                    Else
                        CoulPaletteBlanc(i) = False
                        nCNoir = nCNoir + 1
                    End If
                Next
 
                If nCBlanc = 0 Then
                    MsgBox("La palette du fichier " + Fichier + " ne contient que des couleurs correspondant à du noir, abandon de la lecture")
                    Lire = False
                    Exit Function
                End If
                If nCNoir = 0 Then
                    MsgBox("La palette du fichier " + Fichier + " ne contient que des couleurs correspondant à du blanc, abandon de la lecture")
                    Lire = False
                    Exit Function
                End If
 
                'On passe les données entre le header et les données images que l'on utilise pas :
                dummy = binReader.ReadBytes(PixelArray_Offset - 1078 - (Header_Size - 40))
 
                'Lecture des données image :
 
                nOctetsParLigne2 = Fix((Largeur + 1) / 4) * 4
                ReDim Donnees(nOctetsParLigne * Hauteur)
                For y = 0 To Hauteur - 1
                    i = 128
                    tmpi = 0
                    tmpb = 0
                    DecY = nOctetsParLigne * y
                    For x = 0 To Largeur - 1
                        If CoulPaletteBlanc(binReader.ReadByte) Then
                            tmpb = tmpb + i
                        End If
                        If i = 1 Then
                            Donnees(tmpi + DecY) = tmpb
                            i = 256
                            tmpb = 0
                            tmpi = tmpi + 1
                        End If
                        i = i >> 1 'équivalent à i = i / 2
                    Next
                    'Le dernier octet :
                    Donnees(tmpi + nOctetsParLigne * y) = tmpb
                    'Les octets à 0 pour avoir une ligne multiple de 4 octets :
                    For i = tmpi + 1 To nOctetsParLigne - 1
                        Donnees(i + DecY) = 0
                    Next
                    'Lecture des octets de remplissage :
                    For i = Largeur * 3 + 1 To nOctetsParLigne2
                        tmpb = binReader.ReadByte
                    Next
                Next
 
            Case 24 'Image en couleurs vraies 
                Dim tabBleu(256) As Integer
                Dim tabVert(256) As Integer
                Dim tabRouge(256) As Integer
 
                'Tableaux de pré-calcul pour la conversion en niveau de gris préalable à la conversion en noir et blanc :
                For y = 0 To 255
                    tabBleu(y) = 76 * y
                    tabVert(y) = 151 * y
                    tabRouge(y) = 28 * y
                Next
 
                'Lecture des données image et conversion en noir et blanc :
 
                'On passe les données du header que l'on utilise pas :
                dummy = binReader.ReadBytes(Header_Size - 40)
                'On passe les données entre le header et les données images que l'on utilise pas :
                dummy = binReader.ReadBytes(PixelArray_Offset - 54 - (Header_Size - 40))
 
                nOctetsParLigne2 = Fix((Largeur * 3 + 3) / 4) * 4
                ReDim Donnees(nOctetsParLigne * Hauteur)
                For y = 0 To Hauteur - 1
                    i = 128
                    tmpi = 0
                    tmpb = 0
                    DecY = nOctetsParLigne * y
                    For x = 0 To Largeur - 1
                        B = binReader.ReadByte
                        V = binReader.ReadByte
                        R = binReader.ReadByte
                        'If CByte(0.3 * B + 0.59 * V + 0.11 * R) > 127 Then 'On allume le pixel 'On allume le pixel 
                        If (tabBleu(B) + tabVert(V) + tabRouge(R)) >> 8 > 127 Then
                            tmpb = tmpb + i
                        End If
                        If i = 1 Then
                            Donnees(tmpi + DecY) = tmpb
                            i = 256
                            tmpb = 0
                            tmpi = tmpi + 1
                        End If
                        i = i >> 1 'équivalent à i = i / 2
                    Next
                    'Le dernier octet :
                    Donnees(tmpi + nOctetsParLigne * y) = tmpb
                    'Les octets à 0 pour avoir une ligne multiple de 4 octets :
                    For i = tmpi + 1 To nOctetsParLigne - 1
                        Donnees(i + DecY) = 0
                    Next
                    'Lecture des octets de remplissage :
                    For i = Largeur * 3 + 1 To nOctetsParLigne2
                        tmpb = binReader.ReadByte
                    Next
                Next
            Case Else
                MsgBox("Le fichier " + Fichier + "a un codage de couleurs sur " + Format(nBitsParPixel) + " bits non pris en charge, abandon de la lecture")
                Lire = False
                Exit Function
 
        End Select
 
        binReader.Close()
 
        If AfficheInfo Then
            duree = DateTime.Now - Debut
            MsgBox("Traitement terminé - durée = " + duree.ToString)
        End If
 
        Lire = True
    End Function
 
    Public Function Ecrire(Fichier As String) As Boolean
        'ECRITURE DE L'ENTETE DU FICHIER DE SORTIE *********************************************************************
        Dim tmpb As Byte
        Dim tmpi As UInt16
        Dim tmpl As UInt32
 
        Dim binWriter As New BinaryWriter(File.Open(Fichier, FileMode.Create))
 
        'Ecriture de l'entête
        tmpi = &H4D42 : binWriter.Write(tmpi)
        'Taille du fichier
        tmpl = 54 + 1 + 8 + nOctetsParLigne * Hauteur
        binWriter.Write(tmpl)
        'Reservé
        tmpl = 0 : binWriter.Write(tmpl)
        'Offset de l'image
        tmpl = 54 + 8 : binWriter.Write(tmpl)
        'Taille de l'entête image
        tmpl = 40 : binWriter.Write(tmpl)
        'Dimenssions de l'Image
        binWriter.Write(Largeur)
        binWriter.Write(Hauteur)
        'Nombre de plan
        tmpi = 1 : binWriter.Write(tmpi)
        'Nombre de bits par pixel
        tmpi = 1 : binWriter.Write(tmpi)
        'Methode de compression
        tmpl = 0 : binWriter.Write(tmpl)
        'Taille de l'image en octets
        tmpl = nOctetsParLigne * Hauteur
        binWriter.Write(tmpl)
        'Résolution de l'image
        tmpl = 3780 : binWriter.Write(tmpl) : binWriter.Write(tmpl)
        'Couleurs utilisées
        tmpl = 2 : binWriter.Write(tmpl)
        'Couleurs importantes :
        tmpl = 0 : binWriter.Write(tmpl)
        'palette :
        'couleur 0
        tmpb = 0 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
        'couleur 1
        tmpb = 255 : binWriter.Write(tmpb)
        tmpb = 255 : binWriter.Write(tmpb)
        tmpb = 255 : binWriter.Write(tmpb)
        tmpb = 0 : binWriter.Write(tmpb)
        'ECRITURE DES DONNEES DE L'IMAGE DU FICHIER DE SORTIE ------------------------------------------------------------
        binWriter.Write(Donnees)
        binWriter.Close()
        Ecrire = True
    End Function
 
    Public Function GetSystemDrawingBitmap1Bit(Optional AfficheInfo As Boolean = False) As Bitmap
        'Ici, on va créer un objet System.Drawing.Imaging.Bitmap à partir des données de la classe
        Dim bitmap1Bit_data As System.Drawing.Imaging.BitmapData
        Dim y As UInt32
 
        Dim Debut As DateTime
        Dim duree As TimeSpan
        If AfficheInfo Then Debut = DateTime.Now
 
        GetSystemDrawingBitmap1Bit = New Bitmap(Largeur, Hauteur, System.Drawing.Imaging.PixelFormat.Format1bppIndexed)
        bitmap1Bit_data = GetSystemDrawingBitmap1Bit.LockBits(New Rectangle(0, 0, Largeur, Hauteur), System.Drawing.Imaging.ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format1bppIndexed)
 
        'Avec ce code, l'image est inversée comme dans un mirroir en Y :
        'System.Runtime.InteropServices.Marshal.Copy(Donnees, 0, bitmap1Bit_data.Scan0, Donnees.Length)
        'Nouveau code :
        For y = 0 To Hauteur - 1
            'System.Runtime.InteropServices.Marshal.Copy(Donnees, y * nOctetsParLigne, bitmap1Bit_data.Scan0 + y * nOctetsParLigne, nOctetsParLigne)
            System.Runtime.InteropServices.Marshal.Copy(Donnees, Donnees.Length - (y + 1) * nOctetsParLigne - 1, bitmap1Bit_data.Scan0 + y * nOctetsParLigne, nOctetsParLigne)
        Next y
 
        GetSystemDrawingBitmap1Bit.UnlockBits(bitmap1Bit_data)
 
        If AfficheInfo Then
            duree = DateTime.Now - Debut
            MsgBox("Traitement terminé - durée = " + duree.ToString)
        End If
    End Function
 
    Public Function GetSystemDrawingBitmap24Bits(Optional AfficheInfo As Boolean = False) As Bitmap
        GetSystemDrawingBitmap24Bits = GetSystemDrawingBitmap1Bit(AfficheInfo).Clone(New Rectangle(0, 0, Largeur, Hauteur), Imaging.PixelFormat.Format24bppRgb)
    End Function
 
    Public Function SetFromSystemDrawingBitmap(GDI_Bitmap As Bitmap, Optional AfficheInfo As Boolean = False) As Boolean
        Dim GDI_Bitmap1bit As Bitmap
        'Ici, on va récupérer les données d'un objet System.Drawing.Imaging.Bitmap
        Largeur = GDI_Bitmap.Width
        Hauteur = GDI_Bitmap.Height
        If GDI_Bitmap.PixelFormat = Imaging.PixelFormat.Format1bppIndexed Then
            GDI_Bitmap1bit = GDI_Bitmap
        Else
            If AfficheInfo Then MsgBox("Le bitamp a été convertit en 1 bit")
            GDI_Bitmap1bit = GDI_Bitmap.Clone(New Rectangle(0, 0, Largeur, Hauteur), Imaging.PixelFormat.Format1bppIndexed)
        End If
 
        Dim bitmap1Bit_data As System.Drawing.Imaging.BitmapData
        Dim y As UInt32
 
        Dim Debut As DateTime
        Dim duree As TimeSpan
        If AfficheInfo Then Debut = DateTime.Now
 
        nOctetsParLigne = Fix((Largeur + 31) / 32) * 4 'nOctetsParLigne doit être multiple de 4
        ReDim Donnees(nOctetsParLigne * Hauteur)
 
        bitmap1Bit_data = GDI_Bitmap1bit.LockBits(New Rectangle(0, 0, Largeur, Hauteur), System.Drawing.Imaging.ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format1bppIndexed)
 
        For y = 0 To Hauteur - 1
            System.Runtime.InteropServices.Marshal.Copy(bitmap1Bit_data.Scan0 + y * nOctetsParLigne, Donnees, Donnees.Length - (y + 1) * nOctetsParLigne - 1, nOctetsParLigne)
        Next y
 
        GDI_Bitmap1bit.UnlockBits(bitmap1Bit_data)
 
        If AfficheInfo Then
            duree = DateTime.Now - Debut
            MsgBox("Traitement terminé - durée = " + duree.ToString)
        End If
 
        SetFromSystemDrawingBitmap = True
    End Function
 
End Class

Et un exemple d'utilisation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Class Form1
    Private Sub Button7_Click(sender As System.Object, e As System.EventArgs) Handles Button7.Click
        Dim bm As BMP1BIT
        Dim gbm As Bitmap
        Dim g As Graphics
 
        bm = New BMP1BIT()
 
        'If bm.Lire(My.Application.Info.DirectoryPath + "\chaudiere_v10_1Bits.bmp", True) Then
        '    bm.Ecrire(My.Application.Info.DirectoryPath + "\chaudiere_v10_Resultat_1Bits.bmp")
        'End If
        'If bm.Lire(My.Application.Info.DirectoryPath + "\chaudiere_v10_4Bits.bmp", True) Then
        '    bm.Ecrire(My.Application.Info.DirectoryPath + "\chaudiere_v10_Resultat_4Bits.bmp")
        'End If
        'If bm.Lire(My.Application.Info.DirectoryPath + "\chaudiere_v10_8Bits.bmp", True) Then
        '    bm.Ecrire(My.Application.Info.DirectoryPath + "\chaudiere_v10_Resultat_8Bits.bmp")
        'End If
 
        'Lecture d'un bitmap, stockage en noir et blanc :
        If bm.Lire(My.Application.Info.DirectoryPath + "\chaudiere_v10_24Bits.bmp", True) Then
 
            Call bm.Ecrire(My.Application.Info.DirectoryPath + "\chaudiere_v10_Resultat_24Bits.bmp")
 
            gbm = bm.GetSystemDrawingBitmap1Bit(True)
 
            gbm.Save(My.Application.Info.DirectoryPath + "\chaudiere_v10_graphics0.bmp")
 
            'Remarque : pour dessiner, il faut utiliser un bitmap 24bits
 
            gbm = bm.GetSystemDrawingBitmap24Bits(True)
 
            gbm.Save(My.Application.Info.DirectoryPath + "\chaudiere_v10_graphics1.bmp")
 
            g = Graphics.FromImage(gbm)
            'g.FillRectangle(Brushes.Black, 100, 400, 500, 600)
            g.DrawRectangle(Pens.Black, 100, 400, 500, 600)
 
            gbm.Save(My.Application.Info.DirectoryPath + "\chaudiere_v10_graphics2.bmp")
 
            bm.SetFromSystemDrawingBitmap(gbm, True)
 
            bm.Ecrire(My.Application.Info.DirectoryPath + "\chaudiere_v10_graphics3.bmp")
 
        End If
 
    End Sub
End Class

Des explications détaillées sur le format BMP sont ici : http://en.wikipedia.org/wiki/BMP_file_format; à retenir :
- dans les fichiers BMP l'axe Y est inversé (le pixel 0;0 est en bas à gauche, alors que sur un écran il est en haut à gauche)
- chaque ligne du fichier, correspondant à une ligne x=0...largeur-1, doit avoir une longueur multiples de 4 octets
- palette obligatoire si les couleurs sont codées sur 8 bits ou moins; il faut une palette même si l'image est sur 1 bit (noir et blanc)
- conversion en niveau de gris : ne faites pas la moyenne des composantes R, V et B mais utilisez la formule Gris = 0.3 * B + 0.59 * V + 0.11 * R
- pour optimiser le temps de calcul, utiliser des tableaux de pré-calcul, éviter de mettre des multiplications et des divisions dans les boucles; utiliser des décalages à droit et à gauche au lieu de multiplier ou diviser par un multiple de 2

A+

Lecture et écriture de fichiers BMP 24bit et 1bit

VB.NET

Discussions similaires

Partager

Partager