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
| Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
Dim FichierImageDepart As String
Dim bm As Bitmap
Dim bm2 As Bitmap
Dim bmpDataOld As System.Drawing.Imaging.BitmapData
Dim width As Integer
Dim height As Integer
Dim g As Graphics 'Variable temporaire
Dim FichierImageEtape1 As String
Dim FichierImageResultat As String
Dim bitmap1Bit As Bitmap 'Image finale
Dim bmpDataNew As System.Drawing.Imaging.BitmapData
'tables de precalcul des multiplications pour le calcul du niveau de gris
Dim tabBleu(256) As Integer
Dim tabVert(256) As Integer
Dim tabRouge(256) As Integer
'le pattern à appliquer (il était à l'origine destiné à des niveaux de gris de 64)
Dim pattern() As Byte = {0, 32, 8, 40, 34, 2, 10, 42 _
, 0, 32, 8, 40, 34, 2, 10, 42 _
, 48, 16, 56, 24, 50, 18, 58, 26 _
, 12, 44, 4, 36, 14, 46, 6, 38 _
, 60, 28, 52, 20, 62, 30, 54, 22 _
, 3, 35, 11, 43, 1, 33, 9, 41 _
, 51, 19, 59, 27, 49, 17, 57, 25 _
, 15, 47, 7, 39, 13, 45, 5, 37 _
, 63, 31, 55, 23, 61, 29, 53, 21}
Dim pix, locOld, locNew, x, y As Integer
Dim newpix As Byte
'Les fichiers :
FichierImageDepart = My.Application.Info.DirectoryPath + "\ImageALire_GRIS.BMP"
FichierImageEtape1 = My.Application.Info.DirectoryPath + "\ImageEtape1.BMP"
FichierImageResultat = My.Application.Info.DirectoryPath + "\ImageResultat.BMP"
'Chargement de l'image de départ :
bm2 = New Bitmap(FichierImageDepart)
width = bm2.Width
height = bm2.Height
If bm2.PixelFormat <> System.Drawing.Imaging.PixelFormat.Format32bppArgb Then
bm = New Bitmap(width, height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
g = Graphics.FromImage(bm)
g.DrawImage(bm2, 0, 0, width, height)
Else
bm = bm2
End If
bm2.Dispose()
MsgBox(bm.PixelFormat.ToString) 'C'est OK
Call SauverImage(bm, FichierImageEtape1) 'L'image est OK
bitmap1Bit = New Bitmap(width, height, System.Drawing.Imaging.PixelFormat.Format1bppIndexed)
bmpDataOld = bm.LockBits(New Rectangle(0, 0, width, height), System.Drawing.Imaging.ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
bmpDataNew = bitmap1Bit.LockBits(New Rectangle(0, 0, width, height), System.Drawing.Imaging.ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format1bppIndexed)
Dim oldPixel(width * height * 4 - 1) As Byte
System.Runtime.InteropServices.Marshal.Copy(bmpDataOld.Scan0, oldPixel, 0, oldPixel.Length)
Dim newPixel(bmpDataNew.Stride * height - 1) As Byte
'Pas necessaire de recuperer les donnees de l'image vierge par un Marshal.Copy
'tables de precalcul des multiplications pour le calcul de localisation des pixels de l'ancienne image et de la nouvelle.
Dim multiOld(height) As Integer
Dim multiNew(height) As Integer
For y = 0 To height - 1
multiOld(y) = width * y
multiNew(y) = bmpDataNew.Stride * y
Next
'Initialisation
For y = 0 To 255
tabBleu(y) = 76 * y
tabVert(y) = 151 * y
tabRouge(y) = 28 * y
Next
For y = 0 To height - 1
For x = 0 To width - 1
'on récupère le niveau de gris sur 255
locNew = multiNew(y) + (x / 8)
locOld = (multiOld(y) + x) * 4
'Formule ci-dessous en commentaires, à éviter car coûteuse
'pix = CByte(0.3 * oldPixel(locOld) + 0.59 * oldPixel(locOld + 1) + 0.11 * oldPixel(locOld + 2))
pix = (tabBleu(oldPixel(locOld)) + tabVert(oldPixel(locOld + 1)) + tabRouge(oldPixel(locOld + 2))) >> 8
If ((pix >> 2) > pattern(((x And 7) << 3) + (y And 7))) Then
'On allume le pixel
newpix = newpix Or (1 << (7 - (x Mod 8)))
End If
If (x Mod 8 = 0) Then
'quand on a rempli 8 bits
'on écrit le byte dans l'image
newPixel(locNew) = newpix
'on éteint tous les pixels
'pour le nouveau cycle de 8 bits
newpix = 0
End If
Next
Next
'on recopie notre nouveau tableau dans la nouvelle image
System.Runtime.InteropServices.Marshal.Copy(newPixel, 0, bmpDataNew.Scan0, newPixel.Length)
bitmap1Bit.UnlockBits(bmpDataNew)
bm.UnlockBits(bmpDataOld)
'Mauvaise image avec cette méthode de sauvegarde :
'Call SauverImage(bitmap1Bit, FichierImageResultat)
'Mauvaise image avec cette méthode de sauvegarde aussi - le bug est dans le code de calcul :
bm2 = New Bitmap(width, height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
g = Graphics.FromImage(bm2)
g.DrawImage(bitmap1Bit, 0, 0, width, height)
Call SauverImage(bm2, FichierImageResultat)
MsgBox("Traitement terminé")
End Sub
Private Sub SauverImage(B As Bitmap, F As String)
Try
If Dir(F) <> "" Then My.Computer.FileSystem.DeleteFile(F)
B.Save(F)
Catch
End Try
End Sub |
