Image en niveaux de gris

Commenter

Contenu du snippet 

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

Compatibilité : VB6

Disponible dans d'autres langages :

A voir également

S'inscrire maintenant

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.

Du même auteur (MorpionMx)