Remplacer une couleur dans une picture par une outre couleur vite

Commenter

Contenu du snippet

Choise une couleur dans une Picture et Remplacer par une outre couleur.

Source / Exemple : 


Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Dim PicBits() As Byte, PicInfo As BITMAP
Dim Cnt As Long, BytesPerLine As Long
Private Sub ChangeColor(Pic As PictureBox, RemoveColor As Long, NewColor As Long)
    'Get information (such as height and width) about the picturebox
    GetObject Pic.Picture, Len(PicInfo), PicInfo
    'reallocate storage space
    BytesPerLine = (PicInfo.bmWidth * 3 + 3) And &HFFFFFFFC
    ReDim PicBits(1 To BytesPerLine * PicInfo.bmHeight * 3) As Byte
    
    'Copy the bitmapbits to the array
    GetBitmapBits Pic.Picture, UBound(PicBits), PicBits(1)
    'Invert the bits
    CouleurRGB NewColor, mrd, mvd, mbd
For Cnt = 1 To UBound(PicBits) Step 3
If RGB(PicBits(Cnt), PicBits(Cnt + 1), PicBits(Cnt + 2)) = RemoveColor Then
PicBits(Cnt) = mbd: PicBits(Cnt + 1) = mvd: PicBits(Cnt + 2) = mrd
End If
 Next Cnt
  'Set the bits back to the picture
    SetBitmapBits Pic.Picture, UBound(PicBits), PicBits(1)
    'refresh
    Pic.Refresh
End Sub

Function CouleurRGB(ValeurColor, rd, vd, bd) As Long
ValeurC = ValeurColor
Dim r As Long: Dim v As Long: Dim b As Long: Dim Couleur1: Dim Couleur2: Couleur1 = ValeurC: Couleur2 = Couleur1: bd = ((((Couleur2 \ &H10000) And &HFF) * 50) + (((Couleur1 \ &H10000) And &HFF) * 50)) \ 100: vd = ((((Couleur2 \ &H100) And &HFF) * 50) + (((Couleur1 \ &H100) And &HFF) * 50)) \ 100: rd = (((Couleur2 And &HFF) * 50) + ((Couleur1 And &HFF) * 50)) \ 100: CouleurEff = RGB(rd, vd, bd) 'pour avoir la couleur directement !
End Function

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