Bonjour,

J'aimerai changer certaines couleurs sur une image. mais je n'y arrive pas...

J'ai une image de base avec des surfaces de couleurs différentes :

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'est qu'après que je vai chargé l'image finale. (je vais générer plusieurs images différentes mais n'en afficher qu'une)

Voici un début de code :

Pour lire le txt :

Code VBA : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
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
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
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
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
    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