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
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.