Soyez le premier à donner votre avis sur cette source.
Vue 7 010 fois - Téléchargée 632 fois
'==================================================================================================== 'Nom du programme : Copie d'une image avec transparence 'Version : 1.0 'Auteur : Teillet nicolas 'Environnement de développement : Visual basic 6.0 (édition entreprise) 'Résumé : Programme permettant de copier une image avec une couleur de transparence '==================================================================================================== '==================================================================================================== 'Nom du fichier : FRM_PRINCIPALE 'Crée le : 21/03/2004 'Rôle : Feuille principale du projet '==================================================================================================== 'structure stockant les informations des en-têtes bitmap Private Type BITMAPINFOHEADER 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 'structure stockant les informations des bits d'une image Private Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type 'stucture permettant de définir un bitmap Private Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors As RGBQUAD End Type 'fonction permettant de calculer le temps écoulé depuis l'allumage de Windows en ms Private Declare Function GetTickCount Lib "kernel32" () As Long 'fonction permettant de créer un Device Contexte compatible avec un autre déjà éxistant Private Declare Function CreateCompatibleDC Lib "gdi32" ( _ ByVal hdc As Long) As Long 'fonction permettant de créer un bitmap indépendant de tout device context Private Declare Function CreateDIBSection Lib "gdi32" ( _ ByVal hdc As Long, _ pBitmapInfo As BITMAPINFO, _ ByVal iUsage As Long, _ ByVal ppvBits As Long, _ ByVal hSection As Long, _ ByVal dwOffset As Long) As Long 'fonction permettant de récupèrer les bits d'une image 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 BITMAPINFO, _ ByVal wUsage As Long) As Long 'fonction permettant d'appliquer un tableau de bits à une image Private Declare Function SetDIBitsToDevice Lib "gdi32" ( _ ByVal hdc As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal dx As Long, _ ByVal dy As Long, _ ByVal SrcX As Long, _ ByVal SrcY As Long, _ ByVal nStartScan As Long, _ ByVal nScanLines As Long, _ lpBits As Any, _ lpBitmapInfo As BITMAPINFO, _ ByVal wUsage As Long) As Long 'fonction permettant de détruire un Device Context Private Declare Function DeleteDC Lib "gdi32" ( _ ByVal hdc As Long) As Long 'fonction permettant de copier une image Private Declare Function BitBlt Lib "gdi32" ( _ ByVal hDestDC As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal hSrcDC As Long, _ ByVal xSrc As Long, _ ByVal ySrc As Long, _ ByVal dwRop As Long) As Long 'fonction permettant de sélectionner un objet pour le tracé Private Declare Function SelectObject Lib "gdi32" ( _ ByVal hdc As Long, _ ByVal hObject As Long) As Long 'fonction permettant de détruire l'objet sélectionné pour le tracé Private Declare Function DeleteObject Lib "gdi32" ( _ ByVal hObject As Long) As Long 'fonction permettant de copier une image avec une couleur de transparence Private Declare Function TransparentBlt Lib "msimg32.dll" ( _ ByVal hdc As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal nWidth As Long, _ ByVal nHeight As Long, _ ByVal hSrcDC As Long, _ ByVal xSrc As Long, _ ByVal ySrc As Long, _ ByVal nSrcWidth As Long, _ ByVal nSrcHeight As Long, _ ByVal crTransparent As Long) As Boolean 'déclaration des constantes API privées à l'objet Const BI_RGB = 0 'définit le type de compression d'un bitmap Const DIB_RGB_COLORS = 0 'table de couleur en RGB Public Function BlueValue(ByVal LNG_Couleur As Long) As Integer '================================================================== 'Permet d'obtenir la valeur bleu d'une couleur RGB spécifiée ' 'COL_Couleur : Couleur de type RGB ' 'Renvoie la valeur bleu de la couleur envoyé sous forme d'un entier 'Renvoie "-1" en cas d'erreur '=================================================================== 'on active la routine de traitement d'erreur On Error GoTo erreur0 'on renvoie les bits correspondants à la valeur rouge de la couleur : ceux du milieu BlueValue = Int(LNG_Couleur / (256 ^ 2)) 'la fonction est finie Exit Function 'routine de traitement d'erreur erreur0: 'Problème : On n'a pas pu retourner la valeur de bleu 'Solution : on renvoie une valeur d'erreur : "-1" BlueValue = -1 End Function Public Function GreenValue(ByVal LNG_Couleur As Long) As Integer '=================================================================== 'Permet d'obtenir la valeur vert d'une couleur RGB ' 'COL_Couleur : Couleur de type RGB ' 'Renvoie la valeur vert de la couleur envoyé sous forme d'un entier 'Renvoie "-1" en cas d'erreur '=================================================================== 'on active la routine de traitement d'erreur On Error GoTo erreur0 'on renvoie les bits correspondants à la valeur rouge de la couleur : ceux du milieu à côté de ceux du bleu GreenValue = Int((LNG_Couleur - BlueValue(LNG_Couleur) * (256 ^ 2)) / 256) 'la fonction est finie Exit Function 'routine de traitement d'erreur erreur0: 'Problème : On n'a pas pu retourner la valeur de vert 'Solution : on renvoie une valeur d'erreur : "-1" GreenValue = -1 End Function Public Function RedValue(ByVal LNG_Couleur As Long) As Integer '=================================================================== 'Permet d'obtenir la valeur rouge d'une couleur RGB spécifiée ' 'COL_Couleur : Couleur de type RGB ' 'Revoie la valeur rouge de la couleur envoyé sous forme d'un entier 'Renvoie -1 en cas d'erreur '==================================================================== 'on active la routine de traitement d'erreur On Error GoTo erreur0 'on renvoie les bits correspondants à la valeur rouge de la couleur : ceux de droite RedValue = Int(LNG_Couleur - Val(BlueValue(LNG_Couleur)) * (256 ^ 2) - Val(GreenValue(LNG_Couleur)) * Val(256)) 'la fonction est finie Exit Function 'routine de traitement d'erreur erreur0: 'Problème : On n'a pas pu retourner la valeur de rouge 'Solution : on renvoie une valeur d'erreur : "-1" RedValue = -1 End Function Private Sub BTN_EXECUTER_Click() '============================================================= 'Permet de calculer la fusion de deux images '============================================================= '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_Handle_Bitmap2 As Long 'stocke le handle du bitmap Dim LNG_Handle_DC2 As Long 'stocke le handle du device context Dim TYP_Info_Bitmap2 As BITMAPINFO 'stocke les info du bitmap Dim BYT_Bits2() As Byte 'stocke les bits de l'image Dim LNG_for1 As Long 'stocke les valeurs de la boucle For->Next Dim LNG_Temps As Long 'stocke le temps mis pour le calcul de l'image finale 'calcul du temps pour TransparentBlt LNG_Temps = GetTickCount 'on copie l'image avec une couleur de transparence Call TransparentBlt(PCT_DESTINATION.hdc, 0, 0, PCT_SOURCE.ScaleWidth, PCT_SOURCE.ScaleHeight, PCT_SOURCE.hdc, 0, 0, PCT_DESTINATION.ScaleWidth, PCT_DESTINATION.ScaleHeight, vbBlack) PCT_DESTINATION.Refresh 'affichage du temps avec TransparentBlt LAB_TEMPS.Caption = "Temps mis pour le calcul avec TransparentBlt (incompatible Win95/Win98) : " & GetTickCount - LNG_Temps & " ms." 'calcul du temps pour TransparentBlt LNG_Temps = GetTickCount '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 - 1 'largeur de l'image .biHeight = PCT_SOURCE.ScaleHeight - 1 'hauteur de l'image End With 'on remplit les informations du bitmap With TYP_Info_Bitmap2.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_Bitmap2.bmiHeader) 'taille de la structure .biWidth = PCT_SOURCE.ScaleWidth - 1 'largeur de l'image .biHeight = PCT_SOURCE.ScaleHeight - 1 '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 ReDim BYT_Bits2(1 To TYP_Info_Bitmap2.bmiHeader.biWidth * TYP_Info_Bitmap2.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) 'on création d'un device context compatible avec le picturebox, un bitmap, et copie l'image dedans. LNG_Handle_DC2 = CreateCompatibleDC(PCT_DESTINATION.hdc) LNG_Handle_Bitmap2 = CreateDIBSection(LNG_Handle_DC2, TYP_Info_Bitmap2, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&) Call SelectObject(LNG_Handle_DC2, LNG_Handle_Bitmap2) Call BitBlt(LNG_Handle_DC2, 0, 0, TYP_Info_Bitmap2.bmiHeader.biWidth, TYP_Info_Bitmap2.bmiHeader.biHeight, PCT_DESTINATION.hdc, 0, 0, vbSrcCopy) 'on récupère les bits de l'image Call GetDIBits(LNG_Handle_DC2, LNG_Handle_Bitmap2, 0, TYP_Info_Bitmap2.bmiHeader.biHeight, BYT_Bits2(1), TYP_Info_Bitmap2, DIB_RGB_COLORS) 'on calcule les nouvelles couleurs de l'image For LNG_for1 = 1 To TYP_Info_Bitmap.bmiHeader.biWidth * TYP_Info_Bitmap.bmiHeader.biHeight * 3 Step 3 If BYT_Bits(LNG_for1) = 0 And BYT_Bits(LNG_for1 + 1) = 0 And BYT_Bits(LNG_for1 + 2) = 0 Then BYT_Bits(LNG_for1) = BYT_Bits2(LNG_for1) BYT_Bits(LNG_for1 + 1) = BYT_Bits2(LNG_for1 + 1) BYT_Bits(LNG_for1 + 2) = BYT_Bits2(LNG_for1 + 2) End If Next LNG_for1 'on affiche l'image fusionnée, 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) PCT_DESTINATION.Refresh 'on détruit les device contexts et les bitmaps crées Call DeleteDC(LNG_Handle_DC) Call DeleteObject(LNG_Handle_Bitmap) 'affichage du temps avec la méthode compatible LAB_TEMPS2.Caption = "Temps mis pour le calcul avec la méthode compatible Win95/Win98 : " & GetTickCount - LNG_Temps & " ms." End Sub Private Sub Form_Load() 'on rafraichit l'affichage dès le chargement Call BTN_EXECUTER_Click End Sub
DarK Sidious
DarK Sidious
quand à l'établissement du masque...peut-être serait-il possible de le faire facilement, dans le cas où la couleur transparente est le noir :
on crée un bitmap avec un bit par pixel, puis on blit l'image dessus...étant donné que bitblt effectue les conversions de couleur, il est possible que dans ce cas toutes les couleurs sauf le noir deviennent blanches...resterait alors à inverser le résultat avec un deuxième bitblt...à vérifier...
Par contre, si on applique la copie avec l'image de base sur fond noir, et l'image du masque, alors ca marche bien, et c'est plus rapide que ma méthode, mais c'est un peu plus fastidieux à mon goût !
DarK Sidious
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.