Remplacer une couleur dans une picture par une outre couleur vite

Soyez le premier à donner votre avis sur cette source.

Snippet vu 3 767 fois - Téléchargée 46 fois

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

Ajouter un commentaire

Commentaires

muelsaco
Messages postés
2
Date d'inscription
vendredi 20 juin 2003
Statut
Membre
Dernière intervention
5 mars 2005

Exellent, si vous comprenez pas que c'est 1000 fois plus rapide que pset et getpxl, je peux rien pour vous...
En tout cas çà mérite 10 !
Pour info la source sur http://www.allapi.net/ est bien plus clair.
logisim
Messages postés
49
Date d'inscription
mardi 8 mai 2001
Statut
Membre
Dernière intervention
14 août 2004

Super ! Mais ça ne serait pas plus simple d'utiliser l'API SetBkColor ?
NicolleauElise
Messages postés
16
Date d'inscription
lundi 21 octobre 2002
Statut
Membre
Dernière intervention
20 novembre 2002

et un ptit 1 pour baisser cette moyenne ! {:)
cs_Anthomicro
Messages postés
9433
Date d'inscription
mardi 9 octobre 2001
Statut
Membre
Dernière intervention
13 avril 2007
8
Salut tout le monde !
ça marche impec et en plus c'est super rapide !
Et un truc en plus pour mon prog de desssin, un !
Un petit 10 pour remonter cette moyenne
:-)
cs_patrick
Messages postés
32
Date d'inscription
vendredi 19 mai 2000
Statut
Membre
Dernière intervention
21 juillet 2015

Le code "originel" vient de l'API Guide :

'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net

Pour répondre à Scooby1, il semble que cela ne fonctionne qu'avec des images BMP sauvegardées en 24 Bit (RGB)

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.