Modifier, changer et supprimer les couleurs d'une image

Soyez le premier à donner votre avis sur cette source.

Vue 5 906 fois - Téléchargée 509 fois

Télécharger le projet
Commenter

Description

MODIFIER, CHANGER ET SUPPRIMER LES COULEURS D'UNE IMAGE.
C'est ma première source sur ce site vite codé. Elle est faite pour un membre de ce site. Peut être elle peut rendre service pour quelqu'un d'autre.
C'est un exemple très simple, qui modifie et supprime des couleurs d'une image dans un picturebox.
J'ai crée une fonction qui utilise deux API GetPixel et SetPixelV (ou SetPixel) : La première pour récupérer la couleur réelle d'un point de l'image de coordonnée x et y, la deuxième API pour changer (supprimer) la couleur de cet point.
Il faut pour tester l'exemple :
- Module (module1) pour la fonction
- PictureBox (picture1) pour charger l'image a modifié.
- 5 Bouton (command1) indexer (rouge, vert, Bleue, Jaune, Noir)
Et c'est tout!
Bon ! J'ai testée avec l'image de type Bmp ça marche beaucoup mieux que avec les images jpg, c'est très normal car les images en jpg sont compressées, alors l'accès aux points de l'image sera compliquer et surtout lourde.
C?est très simple exemple, il y a des autres api et méthodes plus avancées pour ce genre des applications.
A vous ?

Source / Exemple : 


'A mettre dans un module
'Déclaration des API et des variables

'L'API SetPixelV change la couleur d'un point donné de coordonnées x et y. 
'crColor c'est la nouvelle couleur pour cet point.
Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Byte

' L'API GetPixel récupère la couleur d'un point de coordonnées x et y.
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
'hDC c'est le control qui contient l'image à modifier (de type "Bmp").
Dim x As Integer
Dim y As Integer

' fonction qui supprime une couleur d'une image
Public Sub SupCouleur(Picture As PictureBox, Couleur_Sup As Long)
'avec ces deux boucles for on parcoure tout les points de l'image
For x = 0 To Picture.ScaleWidth
    For y = 0 To Picture.ScaleHeight
        ' Ici on récupère la couleur du point de coordonnées x et y
        couleur_point = GetPixel(Picture.hDC, x, y)

        ' si c'est la couleur à supprimer alors on modifie ce point
        If couleur_point = Couleur_Sup Then
        ' appel du l'API SetPixelV pour modifier le point de coordonnées X et Y avec la 
'couleur Blanche
            SetPixelV Picture.hDC, x, y, vbWhite
'On peut changer la couleur à remplacer par des autres couleur (comme vbred pour 
'remplacer le point en rouge ....)(SetPixelV Picture.hDC, x, y, vbred). Aussi vous 
'pouvez utilisez des autres méthodes,' par exemple pour supprimer le point:
'SetPixelV Picture.hDC, x, y, (couleur_point - vbred)' mais dans ce cas faut enlever la
'condition if (If couleur_point = Couleur_Sup Then) ;)
        End If
    Next y
Next x
End Sub

' a mettre dans un form
Private Sub Command1_Click(Index As Integer)
' vous pouvez ajouter des autres couleurs à supprimer ou à modifier en remplaçant 
'le code de la couleur par un autre (ici vbred, vbblack..) ou bien directement le code de la couleur 
'(ex: SupCouleur Picture1, 255 ' pour supprimer le rouge).Vous pouvez aussi
'utilisez des autres méthodes d'appel de fonction, ici très simple avec select case
         Select Case Index
                  Case 0 ' Bouton Rouge
                  SupCouleur Picture1, vbRed
                  Case 1 ' Bouton vert
                  SupCouleur Picture1, vbGreen
                  Case 2 ' Bouton Bleue
                  SupCouleur Picture1, vbBlue
                  Case 3 ' Bouton Jaune
                  SupCouleur Picture1, vbYellow
                  Case Else ' Bouton Noir
                  SupCouleur Picture1, vbBlack
         End Select
End Sub
'**********************
Private Sub Form_Load()
' Charger l'image dans Picturebox
Picture1.Picture = LoadPicture(App.Path & "\couleurs.bmp")

' Changer la propriété ScaleMode de l'image en Pixel
Picture1.ScaleMode = 3
End Sub

Conclusion :


J'espère que c'est facile à comprendre, vous pouvez améliorer le code et l'utilisez dans des autres applications.
On peut ajouter des autres arguments pour la fonction SupCouleur, par exemple on ajoute la couleur remplaçante ...
Bon courage...
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
cs_kmeleon34
Messages postés
1
Date d'inscription
lundi 31 mars 2008
Statut
Membre
Dernière intervention
31 mars 2008
Bonjour,

J'ai essayé de copier ce code sous access mais j'ai quelques erreurs.
Si quelqu'un peu m'aider, mon objectif est simple:

J'ai une image de base avec des surfaces de couleurs différentes (comme l'image de ce projet)
J'ai un fichier texte avec les données ratachées à l'image. A savoir : chaque surface a un identifiant + un code couleur + la nouvelle couleur.
Ce que je veux, c'est, sous access, lire dans le txt et mémoriser ce qu'il y a à changer, puis regarder chaque pixel de mon image et voir s'il doit être changé. Une fois sela fait, il faut sauvegarder l'image bmp ou autre.

Tout ceci ne doit pas être visible, ce n'aest qu'après que je vai chargé l'image finale.

Voici un début de code :

Pour lire le txt :

Private Sub macro_map()
Dim dbs As Database
Dim rst1 As Recordset
Dim rep_base As String
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.File
Dim oTxt As Scripting.TextStream
Dim i, j As Integer
Dim machaine, tablo(344, 2) As String
Dim lhProcess As Long
Dim lProcessID As Long
Dim lpExitCode As Long

Set oFSO = New Scripting.FileSystemObject
Set dbs = CurrentDb
Set rst1 = dbs.OpenRecordset("SELECT * FROM CONFIG WHERE CONFIG.TypeDonnee='Répertoire contenant les images';")
If Not (rst1.EOF) Then
rst1.MoveFirst
rep_base = rst1!Donnee
rst1.Close
'******************** li dans le fichier data.src *********************
Set oFl = oFSO.GetFile(rep_base & "\data\data.src")
Set oTxt = oFl.OpenAsTextStream(ForReading)
i = 0
With oTxt
While (Not .AtEndOfStream And i < 344)
i = i + 1
machaine = .ReadLine
tablo(i, 1) = Left(machaine, InStr(machaine, vbTab) - 1)
tablo(i, 2) = Right(machaine, Len(machaine) - InStr(machaine, vbTab))
Wend
j = i
End With
oTxt.Close
Set oFl = Nothing

'******************** lance la requête (cherchez pas à la comprendre je vous donne le fichier résultat juste après) ******************************** Set rst1 dbs.OpenRecordset("select insee, ville, d_min FROM (SELECT COMMUNE.insee, COMMUNE.Nom AS Ville, MIN(DISTANCE.km+CATEGCS.DistSup) AS D_Min FROM (FAMTE INNER JOIN TYPENGIN ON FAMTE.Libelle TYPENGIN.Famille) INNER JOIN (((CATEGCS INNER JOIN CS ON CATEGCS.ProVol = CS.ProVol) INNER JOIN ARME ON CS.Nom = ARME.ArmeCS) INNER JOIN (COMMUNE INNER JOIN DISTANCE ON COMMUNE.INSEE = DISTANCE.DistCOM) ON CS.Nom = DISTANCE.DistCS) ON TYPENGIN.Libelle = ARME.ArmeTE WHERE (((FAMTE.Libelle) = 'FPT')) GROUP BY COMMUNE.insee,COMMUNE.Nom ORDER BY COMMUNE.Nom) ;")
Set oFl = oFSO.GetFile(rep_base & "\data\carte.src")
Set oTxt = oFl.OpenAsTextStream(ForWriting)
rst1.MoveFirst
i = 0
'******************** écris dans le fichier carte.src ******************
oTxt.WriteLine "#" & vbTab & "iden" & vbTab & "commune" & vbTab & "nouvelle_couleur"
While Not (rst1.EOF)
i = i + 1
With oTxt
If (rst1!D_Min <= 10) Then
.WriteLine i & vbTab & rst1!INSEE & vbTab & rst1!Ville & vbTab & "FF7700"
Else
If (rst1!D_Min <= 20) Then
.WriteLine i & vbTab & rst1!INSEE & vbTab & rst1!Ville & vbTab & "77FF00"
Else
If (rst1!D_Min <= 30) Then
.WriteLine i & vbTab & rst1!INSEE & vbTab & rst1!Ville & vbTab & "00FF77"
Else
If (rst1!D_Min <= 45) Then
.WriteLine i & vbTab & rst1!INSEE & vbTab & rst1!Ville & vbTab & "0077FF"
Else
.WriteLine i & vbTab & rst1!INSEE & vbTab & rst1!Ville & vbTab & "000000"
End If
End If
End If
End If
End With
rst1.MoveNext
Wend
oTxt.Close
Set oFSO = Nothing
rst1.Close
End If
dbs.Close

' coller également le code de modification de l'image ici

End Sub

Voici les 2 fichiers txt :
-data.src :
iden couleur
34135001 FF0000
34121002 00FF00
34101003 0000FF
34130004 00FFFF
34313005 FFFF00
34127006 FF00FF
34130007 FFFFFF
34135009 000000
...

-carte.src:
# iden commune nouvelle_couleur
1 34135001 ABEILHAN 77FF00
2 34121002 ADISSAN FF7700
3 34101003 AGDE FF7700
4 34130004 AGEL 00FF77
5 34313005 AGONES 77FF00
6 34127006 AIGNE 77FF00
7 34130007 AIGUES VIVES 77FF00
8 34135009 ALIGNAN DU VENT 77FF00
...

Et voici le code pour changer les pixels mais qui ne marche pas :

'module1
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Byte

'partie à coller dans form1
Dim x, y, z As Integer

For x = 0 To Image7.ImageWidth
For y = 0 To Image7.ImageHeight
couleur_point = GetPixel(GetDC(0), x, y)
For z = 1 To 343
If couleur_point = tablo(z, 1) Then
SetPixel mon_image.Handle, x, y, vbYellow '(en jaune pour l'instant mais sera remplacé par la nouvelle couleur : carte.src)
End If
Next z
Next y
Next x
Me.Refresh
End Sub

Voilà cela ne marche pas ... quelqu'un peut m'aider?

Merci
Signaler
fox94_7
Messages postés
32
Date d'inscription
vendredi 5 novembre 2004
Statut
Membre
Dernière intervention
13 juillet 2007
salut je veux remplacer la couleur par rien (transparent)
Signaler
DarkanLeGrd
Messages postés
17
Date d'inscription
lundi 5 avril 2004
Statut
Membre
Dernière intervention
12 mars 2005
Attention, j'attire l'attention du lecteur sur le fait que cette source ne "suprime" pas la couleur. Les pixels sont remplacés par du vbWhite...

Mise à part, c'est simple et efficace!
good!
Signaler
davidauche
Messages postés
150
Date d'inscription
jeudi 20 mars 2003
Statut
Membre
Dernière intervention
8 janvier 2008
re, bon t'as raison, le probleme existe, j'ai pas testee cette situation ;)
et effectivement, c'es ça la reponse que j'arrive a trouver(autoredraw), sinon, il y a des autres solution un peu compliquer avec les api, ou bien tu ne laisse jamais ta fenetre quitte l'ecran, avec simple code en utilisant les proprietes left,top,width,height et screen .....
merci pour cette remarque, je suis en train de programmer un truc avec setpixel et getpixel, mais pour colorer les bouton (command)donc ce probleme sera plus compliquer a resoudre, surtout sont creer dynamiquement :(
a++++
davidauche
Signaler
loskiller62
Messages postés
135
Date d'inscription
jeudi 30 janvier 2003
Statut
Membre
Dernière intervention
12 juillet 2006
 1
C'est bon le problème est réglé. En mettant l'autoredraw de la picturebox à true ça marche dans la plupart des cas: plus besoin d'avoir la fenêtre au premier plan. La seule condition est que l'image apparaisse dans son intégralité dans la picturebox. Le truc si on ne veut pas forcément voir l'image est de créer une picture box suffisamment grande pour acceuillir tout type d'image et de la placer hors du champ visuel de la form (elle est là mais on ne la voit pas).
Merci quand même :-)
Afficher les 7 commentaires
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 (davidauche)