Ombrer une image ou comment utiliser getdibits pour manipuler des pixels

Télécharger le projet
Commenter

Description

Ce petit programme vous permet de faire des ombres pour une image. N'ayant rien trouvé sur ce site de comparable, n'ayant également vu que très peu de source manipulant les pixels grâce la fonction API GetDIBits, j'ai décidé de faire cette source qui va également m'être utile pour des contrôles ActiveX par la suite.

Ce code n'est pas très long ni pas très compliqué à comprendre si vous manipulez déjà bien l'API Windows. Il est surtout là pour illustrer comment manipuler une image dont on a récupèrer les bits dans un tableau. Ceci est bien plus rapide qu'avec les manipulations GetPixel => SetPixel traditionnelle, et je vous encourage d'utiliser les fonctions GetDIBits et SetDIBits pour manipuler les images : c'est quasi immédiat, ce qui est infaisable avec VB et ses fonctions Point et PSet !

Source / Exemple : 


'Code complet, il ne manque que les déclarations de fonctions que vous trouverez dans le zip

Private Sub BTN_APPLIQUER_Click()

'on active la routine de traitement d'erreur
On Error Resume Next
'l'erreur etant minime, on continue l'éxécution normalement

'déclaration des variables privées
Dim LNG_Handle_Bitmap As Long 'stocke le handle du bitmap
Dim LNG_Handle_DC As Long 'stocke le handle du device context
Dim TYP_Info_Bitmap As BITMAPINFO 'stocke les info du bitmap
Dim BYT_Bits() As Byte 'stocke les bits de l'image
Dim LNG_For1 As Long 'stocke les valeurs de la boucle For->Next
    
    'on remplit les informations du bitmap
    With TYP_Info_Bitmap.bmiHeader
        .biBitCount = 24 'profondeur de 24 bits
        .biCompression = BI_RGB 'les couleurs sont stockées en RGB
        .biPlanes = 1 'un seul plan pour l'image
        .biSize = Len(TYP_Info_Bitmap.bmiHeader) 'taille de la structure
        .biWidth = PCT_SOURCE.ScaleWidth 'largeur de l'image
        .biHeight = PCT_DESTINATION.ScaleHeight 'hauteur de l'image
    End With
        
    'on redimensionne le tableau de bits selon la taille de l'image
    ReDim BYT_Bits(1 To TYP_Info_Bitmap.bmiHeader.biWidth * TYP_Info_Bitmap.bmiHeader.biHeight * 3) As Byte
    
    'on création d'un device context compatible avec le picturebox, un bitmap, et copie l'image dedans.
    LNG_Handle_DC = CreateCompatibleDC(PCT_SOURCE.hdc)
    LNG_Handle_Bitmap = CreateDIBSection(LNG_Handle_DC, TYP_Info_Bitmap, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)
    Call SelectObject(LNG_Handle_DC, LNG_Handle_Bitmap)
    Call BitBlt(LNG_Handle_DC, 0, 0, TYP_Info_Bitmap.bmiHeader.biWidth, TYP_Info_Bitmap.bmiHeader.biHeight, PCT_SOURCE.hdc, 0, 0, vbSrcCopy)
    
    'on récupère les bits de l'image
    Call GetDIBits(LNG_Handle_DC, LNG_Handle_Bitmap, 0, TYP_Info_Bitmap.bmiHeader.biHeight, BYT_Bits(1), TYP_Info_Bitmap, DIB_RGB_COLORS)
    
    'traitement des pixels
    For LNG_For1 = 1 To TYP_Info_Bitmap.bmiHeader.biWidth * TYP_Info_Bitmap.bmiHeader.biHeight * 3 Step 3
    
        If BYT_Bits(LNG_For1) = 255 And BYT_Bits(LNG_For1 + 1) = 0 And BYT_Bits(LNG_For1 + 2) = 0 Then
            
            'si les pixels sont bleus alors il deviennent blancs
            BYT_Bits(LNG_For1) = 255
            BYT_Bits(LNG_For1 + 1) = 255
            BYT_Bits(LNG_For1 + 2) = 255
        
        Else
        
            'si les pixels ne sont pas bleus, alors ils deviennent gris
            BYT_Bits(LNG_For1) = 128
            BYT_Bits(LNG_For1 + 1) = 128
            BYT_Bits(LNG_For1 + 2) = 128
        
        End If
    
    Next LNG_For1
    
    'on affiche l'ombre, et on détruit le device context et le bitmap
    Call SetDIBitsToDevice(PCT_DESTINATION.hdc, 0, 0, TYP_Info_Bitmap.bmiHeader.biWidth, TYP_Info_Bitmap.bmiHeader.biHeight, 0, 0, 0, TYP_Info_Bitmap.bmiHeader.biHeight, BYT_Bits(1), TYP_Info_Bitmap, DIB_RGB_COLORS)
    DeleteDC LNG_Handle_DC
    DeleteObject LNG_Handle_Bitmap
    PCT_DESTINATION.Refresh

    'on affiche l'ombre puis l'image source avec transparence pour simuler une ombre
    Call BitBlt(PCT_RESULTAT.hdc, 2, 2, PCT_DESTINATION.Width, PCT_DESTINATION.Height, PCT_DESTINATION.hdc, 0, 0, vbSrcCopy)
    Call TransparentBlt(PCT_RESULTAT.hdc, 5, 5, PCT_SOURCE.Width, PCT_SOURCE.Height, PCT_SOURCE.hdc, 0, 0, PCT_SOURCE.Width, PCT_SOURCE.Height, vbBlue)
    PCT_RESULTAT.Refresh
    
End Sub

Conclusion :


Je ne pense pas faire de mise à jour de cette source.
Télécharger le projet

Codes Sources

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 (cs_DARKSIDIOUS)