Const BI_RGB = 0&
Const DIB_RGB_COLORS = 0
Private Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Declare Function GetDIBColorTable Lib "gdi32" (ByVal hdc As Long, ByVal un1 As Long, ByVal un2 As Long, pRGBQuad As RGBQUAD) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Sub GrayScale(PicSRC As PictureBox)
Const pixR = 1
Const pixG = 2
Const pixB = 3
Dim bitmap_info As BITMAPINFO
Dim pixels() As Byte
Dim bytes_per_scanLine As Integer
Dim x As Integer
Dim y As Integer
Dim ave_color As Byte
Dim bw As Long
Dim bh As Long
bw = PicSRC.ScaleWidth
bh = PicSRC.ScaleHeight
bytes_per_scanLine = ((((bw * 32) + 31) \ 32) * 4)
' Prepare la bitmap description.
With bitmap_info.bmiHeader
.biSize = 40
.biWidth = bw
.biHeight = -bh
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
.biSizeImage = bytes_per_scanLine * bh
End With
' Transforme en bitmap's data.
ReDim pixels(1 To 4, 1 To bw, 1 To bh)
GetDIBits PicSRC.hdc, PicSRC.Image, 0, bh, pixels(1, 1, 1), bitmap_info, DIB_RGB_COLORS
' Modifie les pixels.
For y = 1 To bh
For x = 1 To bw
ave_color = CByte((CInt(pixels(pixR, x, y)) + pixels(pixG, x, y) + pixels(pixB, x, y)) \ 3)
' une autre possibilité:
' ave_color = CByte((CInt(pixels(pixR, x, y)) * 0.299 + pixels(pixG, x, y) * 0.587 + pixels(pixB, x, y) * 0.114))
pixels(pixR, x, y) = ave_color
pixels(pixG, x, y) = ave_color
pixels(pixB, x, y) = ave_color
Next x
Next y
' Affiche le resultat.
SetDIBits PicSRC.hdc, PicSRC.Image, 0, bh, pixels(1, 1, 1), bitmap_info, DIB_RGB_COLORS
PicSRC.Picture = PicSRC.Image
End Sub
' pour l'utilisation il faut une PictureBox
Picture1.Picture = LoadPicture("Lechemincomplet\votreimage")
GrayScale Picture1