MODIFIER, CHANGER ET SUPPRIMER LES COULEURS D'UNE IMAGE

Messages postés
135
Date d'inscription
jeudi 30 janvier 2003
Statut
Membre
Dernière intervention
12 juillet 2006
- - Dernière réponse : 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

Afficher la suite 
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
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)
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!
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
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 :-)