Transparence généralisée des picturebox

Soyez le premier à donner votre avis sur cette source.

Vue 12 794 fois - Téléchargée 690 fois

Télécharger le projet
Commenter

Description

Ce code fait suite à celui proposé pour la transparence de deux images. Il permet de traiter la transparence de plusieurs images en tenant compte de celles qui sont au dessus et au dessous.
Le code ressemble beaucoup au précédent mais la mise en oeuvre est très différente.
Exemple
Sur un fond noir, on dispose d'une image du Soleil, derrière la Terre et derrière la Terre la Lune.
Plus loin Jupiter sans interaction avec les images précédentes
Devant le soleil, Mercure et devant Mercure, Vénus. Mars se trouve derrière Mercure et la Terre
Par la méthode des deux images, il faudrait
dessiner Jupiter
Appliquer la transparence Terre/Lune (la Lune derrière)
Appliquer la transparence Terre/Mars (deuxième dessin de la terre)
Appliquer la transparence Soleil/Terre (troisième dessin de la Terre)
Appliquer la transparence Mercure/Soleil (deuxième dessin du soleil)
Appliquer le transparence Vénus/Mercure (deuxième dessin de Mercure)
La méthode globale permet de dessiner sur un fond qui occupe tout l'espace de dessin (un tableau)
On détermine l'ordre de dessin des images : du dessous vers le dessus
Seuls les pixels dont la couleur n'est pas proche de la couleur de transparence sont transmis
au cadre.

Source / Exemple : 


'D'après un travail de DARKSIDIOUS (http://www.vbfrance.com/auteur/DARKSIDIOUS/13557.aspx)
'téléchargeable ici : http://www.vbfrance.com/code.aspx?ID=21354
'avec l'aide de Jean-Marc (http://www.vbfrance.com/auteur/JEANMARCN2/205448.aspx)
'20 avril 2008

Option Explicit

'
' Déclaration des types privées pour les API
'

Private Const pixR As Integer = 3       ' index du pixel de couleur rouge
Private Const pixV As Integer = 2       ' index du pixel de couleur vert
Private Const pixB As Integer = 1       ' index du pixel de couleur bleu

' structure stockant les informations des en-têtes bitmap
Private Type t_EnteteBitMap
            Taille          As Long     ' il s'agit du nombre de bits décrivant l'entête
            Largeur         As Long
            Hauteur         As Long
            NbPlans         As Integer  ' pour du BMP 1 plan
            NbBits          As Integer  ' il s'agit du nombre de bits décrivant le pixel (32 bits ici)
            Compression     As Long     ' pour du BMP, compression = 0
            TailleImage     As Long
            XPixelsParMetre As Long
            YPixelsParMetre As Long
            biClrUsed       As Long     ' ?
            biClrImportant  As Long     ' ?
End Type
        
Private Type t_Couleur
            Bleu            As Byte
            Vert            As Byte
            Rouge           As Byte
            Reserve         As Byte
End Type
        
Private Type t_InfoBitMap
            Entete          As t_EnteteBitMap
            Couleur         As t_Couleur
End Type
        
Private Type t_TabByte
            T()             As Byte
End Type
        
' Fonction permettant de définir les bits d'un bitmap dans un DC
Private Declare Function SetDIBits Lib "gdi32.dll" (ByVal hdc As Long, _
                                                    ByVal hBitmap As Long, _
                                                    ByVal nStartScan As Long, _
                                                    ByVal nNumScans As Long, _
                                                    ByRef lpBits As Any, _
                                                    ByRef lpBI As t_InfoBitMap, _
                                                    ByVal wUsage As Long) As Long
     

' Fonction permettant de récupèrer les bits d'une image dans un tableau passé en paramètre
' hdc est un handle sur un device context
' hBitMap est un identifiant de bitmap
' nStartScan est l'octet où commence la récupération des bits
' nScanLines est le nombre de lignes à récupérer
' lpBits pointe sur un buffer capable de recevoir les données du bitmap
' lpBitMapInfo est d'un type capable de recevoir les informations de bitmap
' wUsage vaut 0 pour une table de couleurs en RGB
Private Declare Function GetDIBits Lib "gdi32" (ByVal hdc As Long, _
                                                ByVal hBitmap As Long, _
                                                ByVal nStartScan As Long, _
                                                ByVal nScanLines As Long, _
                                                lpBits As Any, _
                                                lpBitmapInfo As t_InfoBitMap, _
                                                ByVal wUsage As Long) As Long
                                                     
                                                      
'---------------------------------------------------------------------------------------
' Procedure : ConstruireTransparence
' DateTime  : 20/04/2008 14:22
' Author    : Patrice
' Purpose   : Permet de dessiner l'ensemble des images passées par l'intermédiaire d'un tableau
'             d'images. Les images sont classées par ordre de hiérarchie, les premières sont dessous
'             les autres. Lors du dessin, les pixels dont la couleur est proche de la couleur
'             de transparence sont ignorés.
'             4 paramètres
'             Cadre : l'image résultat de l'ensemble des dessins
'             Images() : un tbaleau d'images à dessiner
'             CouleurTransparente : la couleur qui sera considérée comme transparente.
'             Sensibilité : en fait ce sont les points dont la couleur est suffisamment proche de la
'             couleur de transparence qui seront ignorés. L'argument sensibilité mesure cette
'             proximité
'---------------------------------------------------------------------------------------
'
Sub ConstruireTransparence(Cadre As PictureBox, Images() As PictureBox, _
                           ByVal CouleurTransparente As Long, ByVal Sensibilite As Long)
   
   'Il faut définir les infos du cadre
    Dim InfoBitMapCadre As t_InfoBitMap
    Dim TabBitMapCadre As t_TabByte
    
    InfoBitMapCadre = ExtraireInfo(Cadre)
    TabBitMapCadre = ExtraireBits(InfoBitMapCadre, Cadre)
    
    Dim Index As Long
    Dim InfoBitMapImage As t_InfoBitMap
    Dim TabBitMapImage As t_TabByte
    Dim R                   As Byte, _
        V                   As Byte, _
        B                   As Byte
    'Les composantes R, V, B de la couleur de transparence
    Dim R_Transp            As Byte, _
        V_Transp            As Byte, _
        B_Transp            As Byte
    
    R_Transp = Rouge(CouleurTransparente)
    V_Transp = Vert(CouleurTransparente)
    B_Transp = Bleu(CouleurTransparente)
    
    Dim PremiereLigne As Long, DerniereLigne As Long, PremierPoint As Long, DernierPoint As Long
    Dim Ligne As Long, Point As Long
    'on dessine chaque image dans l'ordre
    For Index = LBound(Images) To UBound(Images)
        InfoBitMapImage = ExtraireInfo(Images(Index))
        TabBitMapImage = ExtraireBits(InfoBitMapImage, Images(Index))
        PremiereLigne = Images(Index).Top
        DerniereLigne = Int(Images(Index).Top + Images(Index).Height - 1)
        PremierPoint = Images(Index).Left
        DernierPoint = Int(Images(Index).Left + Images(Index).Width - 1)
        For Ligne = PremiereLigne To DerniereLigne
            For Point = PremierPoint To DernierPoint
                GetPixelRVB TabBitMapImage, Point, Ligne, R, V, B
                'Si la couleur du pixel est proche de la couleur de transparence (ici noire)
                'il est ignoré
                If Not Proche(R, V, B, R_Transp, V_Transp, B_Transp, Sensibilite) Then
                    SetPixelRVB TabBitMapCadre, Point, Ligne, R, V, B
                End If
            Next Point
        Next Ligne
        Erase TabBitMapImage.T
    Next Index
    
    Refresh Cadre, TabBitMapCadre, InfoBitMapCadre
    Cadre.Visible = True
    Erase TabBitMapCadre.T
    
End Sub

'---------------------------------------------------------------------------------------
' Function  : Proche
' DateTime  : 09/05/2008 14:30
' Author    : Patrice
' Purpose   : Ce prédicat (fonction booléenne) renvoie vrai si les couleurs (R1,V1,B1) et (R2,V2,B2)
'             sont proches. C'est à dire la différence en valeur absolue de chacune de leurs
'             composantes est inférieure au seuil de sensibilité.
'---------------------------------------------------------------------------------------
'
Private Function Proche(R1 As Byte, V1 As Byte, B1 As Byte, R2 As Byte, V2 As Byte, B2 As Byte, Sensibilite As Long)
    
    Proche = False
    If Abs(R1 - R2) < Sensibilite Then
        If Abs(V1 - V2) < Sensibilite Then
            If Abs(B1 - B2) < Sensibilite Then
                Proche = True
            End If
        End If
    End If
    
End Function

'---------------------------------------------------------------------------------------
' Procedure : ExtraireInfo
' DateTime  : 20/04/2008 14:31
' Author    : Patrice
' Purpose   : On renvoie les infos d'une PictureBox (margeur, hauteur, ...)
'---------------------------------------------------------------------------------------
'
Private Function ExtraireInfo(PictBox As PictureBox) As t_InfoBitMap

    Dim InfoBitMap As t_InfoBitMap
    
    InfoBitMap.Entete.Taille = Len(InfoBitMap.Entete)
    InfoBitMap.Entete.Largeur = PictBox.ScaleWidth
    InfoBitMap.Entete.Hauteur = -PictBox.ScaleHeight
    InfoBitMap.Entete.NbPlans = 1
    InfoBitMap.Entete.NbBits = 32
    InfoBitMap.Entete.Compression = 0
    InfoBitMap.Entete.TailleImage = 4 * PictBox.ScaleWidth * PictBox.ScaleHeight
    ExtraireInfo = InfoBitMap
    
End Function

'---------------------------------------------------------------------------------------
' Procedure : ExtraireBits
' DateTime  : 20/04/2008 14:20
' Author    : Patrice
' Purpose   : On renvoie un tableau de bits à trois dimensions
'             un pixel est défini par sa position (x,y) et sa couleur sur 4 bytes (byte1 = bleu,
'             byte2 = vert, byte3 = rouge, byte4=?).
'             première dimension : 1 à 4 couleur
'             deuxième dimension : lignes
'             troisième dimension : colonnes
'             Tel que présenté, la quotité de rouge du pixel de coordonnées (25,13), ligne 25
'             collone 13 sera T(pixR,25,13)
'---------------------------------------------------------------------------------------
'
Private Function ExtraireBits(InfoBitMap As t_InfoBitMap, PictBox As PictureBox) As t_TabByte
    
    Dim TableauDeBitsImage  As t_TabByte
    
    Dim X_Min               As Long, _
        X_Max               As Long, _
        Y_Min               As Long, _
        Y_Max               As Long
    
    ' Le With va nettement améliorer la lisibilité et surtout les performances
    With PictBox
        X_Min = .Left
        X_Max = .Left + .Width - 1
        Y_Min = .Top
        Y_Max = .Top + .Height - 1
    
        ReDim TableauDeBitsImage.T(1 To 4, X_Min To X_Max, Y_Min To Y_Max) As Byte
    
        Call GetDIBits(.hdc, _
                       .Image, _
                       0, _
                       .ScaleHeight, _
                       TableauDeBitsImage.T(1, X_Min, Y_Min), _
                       InfoBitMap, _
                       0)
    End With
    
    ExtraireBits = TableauDeBitsImage
    
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetPixelRVB
' DateTime  : 20/04/2008 14:17
' Author    : Patrice
' Purpose   : Permet de récupèrer la couleur (les composantes RGB) d'un pixel de l'image
'---------------------------------------------------------------------------------------
'
Private Sub GetPixelRVB(TabBitMap As t_TabByte, _
                        ByVal x As Long, _
                        ByVal y As Long, _
                        ByRef R As Byte, _
                        ByRef V As Byte, _
                        ByRef B As Byte) _

    R = TabBitMap.T(pixR, x, y)
    V = TabBitMap.T(pixV, x, y)
    B = TabBitMap.T(pixB, x, y)
    
End Sub

'---------------------------------------------------------------------------------------
' Procedure : SetPixelRVB
' DateTime  : 20/04/2008 14:13
' Author    : Patrice
' Purpose   : Permet de définir la couleur d'un pixel de l'image
' Params    : x, y    : Coordonnées en pixel du point de l'image dont on veut définir la couleur
'             R, V, B : composantes rouge, verte et bleue du pixel à appliquer
'---------------------------------------------------------------------------------------
'
Public Sub SetPixelRVB(TabBitMap As t_TabByte, _
                       ByVal x As Long, _
                       ByVal y As Long, _
                       ByVal R As Byte, _
                       ByVal V As Byte, _
                       ByVal B As Byte)
    
    TabBitMap.T(pixR, x, y) = R
    TabBitMap.T(pixV, x, y) = V
    TabBitMap.T(pixB, x, y) = B

End Sub

'---------------------------------------------------------------------------------------
' Procedure : Refresh
' DateTime  : 20/04/2008 13:51
' Author    : Patrice
' Purpose   : Permet d'insérer l'image stockée dans le tableau dans le PictureBox
'---------------------------------------------------------------------------------------
'
Private Sub Refresh(PictBox As PictureBox, TabBitMap As t_TabByte, InfoBitMap As t_InfoBitMap)

    Call SetDIBits(PictBox.hdc, _
                   PictBox.Image, _
                   0, _
                   PictBox.ScaleHeight, _
                   TabBitMap.T(1, LBound(TabBitMap.T, 2), _
                   LBound(TabBitMap.T, 3)), _
                   InfoBitMap, _
                   0)
                   
End Sub

'renvoie la composante bleue de la couleur
Private Function Bleu(ByVal Couleur As Long) As Byte
    'Couleur = 65536 * Bleu + 256* Vert + Rouge
    Bleu = ((Couleur \ 65536) And &HFF)
End Function

'renvoie la composante verte de la couleur
Private Function Vert(ByVal Couleur As Long) As Byte
    'Couleur = 65536 * Bleu + 256* Vert + Rouge
    Vert = ((Couleur \ 256) And &HFF)
End Function

'renvoie la composante rouge de la couleur
Private Function Rouge(ByVal Couleur As Long) As Byte
    'Couleur = 65536 * Bleu + 256* Vert + Rouge
    Rouge = (Couleur And &HFF)
End Function

Conclusion :


Ce code est somme toute plus simple que le précédent pour deux images.

Modification du 02/06/08
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Commenter la réponse de cs_EBArtSoft
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 (Patrice H)