MODIFIER, CHANGER ET SUPPRIMER LES COULEURS D'UNE IMAGE

loskiller62 Messages postés 135 Date d'inscription jeudi 30 janvier 2003 Statut Membre Dernière intervention 12 juillet 2006 - 15 déc. 2003 à 01:41
cs_kmeleon34 Messages postés 1 Date d'inscription lundi 31 mars 2008 Statut Membre Dernière intervention 31 mars 2008 - 31 mars 2008 à 16:06

Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/18095-modifier-changer-et-supprimer-les-couleurs-d-une-image

cs_kmeleon34 Messages postés 1 Date d'inscription lundi 31 mars 2008 Statut Membre Dernière intervention 31 mars 2008
31 mars 2008 à 16:06

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

fox94_7 Messages postés 32 Date d'inscription vendredi 5 novembre 2004 Statut Membre Dernière intervention 13 juillet 2007
29 juin 2007 à 16:55

salut je veux remplacer la couleur par rien (transparent)

DarkanLeGrd Messages postés 17 Date d'inscription lundi 5 avril 2004 Statut Membre Dernière intervention 12 mars 2005
11 oct. 2004 à 14:50

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!

davidauche Messages postés 150 Date d'inscription jeudi 20 mars 2003 Statut Membre Dernière intervention 8 janvier 2008
18 déc. 2003 à 14:06

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

loskiller62 Messages postés 135 Date d'inscription jeudi 30 janvier 2003 Statut Membre Dernière intervention 12 juillet 2006 1
17 déc. 2003 à 22:59

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 :-)

davidauche Messages postés 150 Date d'inscription jeudi 20 mars 2003 Statut Membre Dernière intervention 8 janvier 2008
17 déc. 2003 à 21:12

bonjour loskiller62,
pour ton probleme, tu peux utiliser les api pour tu rendre ta fenetre au premier plan et visible.
pour comment faire getpixel sans pour autant avoir à visualiser l'image à l'ecran, normalement ça marche, car getpixel utilise le hdc de control(picturebox dans mon prog).
bon, je vais tester ce soir, si je trouve des problemes, je corrigerai et je te donne les resultats ;)
a++++++++
davidauche

loskiller62 Messages postés 135 Date d'inscription jeudi 30 janvier 2003 Statut Membre Dernière intervention 12 juillet 2006 1
15 déc. 2003 à 01:41

Coucou. J'ai un problème de taille avec GetPixel: ça ne marche pas si on a une fenetre quelconque au dessus de l'image. Je dois travailler sur de grandes images et c'est embêtant (pour pas dire autre chose), car si l'image sors de l'ecran ça ne marche pas.
Comment faire un getpixel sans pour autant avoir à visualiser l'image à l'écran voilà la question...

Discussions similaires

[Photoshop] : Image noir et blanc en image blanc et noir ?

Inverser les couleurs d'une image 16x16

initialisation du BITMAPINFO pour avoir une palette 256 couleurs!

Creation d'une Bitmap en niveaux de gris (256 ou 65536)

Palette couleur

Votre réponse

Discussions similaires