OVH Cloud OVH Cloud

Colorier l'intérieur d'un BMP

17 réponses
Avatar
Raymond Fournier
Bonjour a tous,
Est-ce possible de colorier avec une couleur l'intérieur d'une image en
bmp par le code vb. C'est dans le but d'utiliser une image de drag and
drop qui est noir et blanc et d'avoir une couleur a la place du blanc,
pour ensuite l'utiliser comme icône de drag and drop.

Merci, Raymond Fournier :-)

--
Ceci est une signature automatique de MesNews.
Site : http://www.mesnews.net

7 réponses

1 2
Avatar
Raymond Fournier
Après mure réflexion, Bob a écrit :
Raymond, dans le message précédent, j'ai oublié de préciser le dossier
d'entrée de l'aide :

- Manuels en ligne
--- Aide Visual Basic
-----Exemples de code
---------Exemples - H
-------------hdc
@+
Bob



Merci de ton aide. Raymond Fournier

--
Ceci est une signature automatique de MesNews.
Site : http://www.mesnews.net
Avatar
Jacques93
Bonjour Bob et Raymond,
Bob a écrit :
Bonjour bob,
J'ai utilisé ton exemple et sa fonction très bien. Petite question est-ce
possible d'utiliser un pictureBox au lieu d'un contrôle image ?
J'ai essayé : FloodFill Picture1.hdc, X, Y, ForeColor , mais ca ne
fonctionne pas.






Dans le code de l'exemple, les propriétés :

ScaleMode
FillStyle
Left + X
Top + Y
ForeColor
FillColor
hDC
etc ...

font référence à la feuille c'est à dire :

Form1.ScaleMode
Form1.FillStyle
Form1.Left
Form1.Top
Form1.ForeColor
Form1.FillColor
Form1.hDC
etc ...

et FloodFill agit directement sur la feuille. Pour l'utiliser avec un
PictureBox, il faut adapter le code. Par exemple :

Private Sub Picture1_MouseDown(Button As Integer, _
Shift As Integer, _
X As Single, Y As Single)
X = X / 15
Y = Y / 15
With Picture1
.ScaleMode = vbPixels
.FillStyle = vbFSSolid
X = .Left + X
Y = .Top + Y
.ForeColor = vbBlack ' couleur ligne
.FillColor = vbBlue ' couleur de remplissage
FloodFill .hDC, X, Y, .ForeColor
End With
End Sub




--
Cordialement,

Jacques.
Avatar
Jacques93
Petit correctif :

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
X = X / 15
Y = Y / 15
With Picture1
.ScaleMode = vbPixels
.FillStyle = vbFSSolid

'X = .Left + X => à supprimer
'Y = .Top + Y => à supprimer

.ForeColor = vbBlack ' couleur ligne
.FillColor = vbGreen ' couleur de remplissage
FloodFill .hDC, X, Y, .ForeColor
End With
End Sub



--
Cordialement,

Jacques.
Avatar
Bob
Bonjour Jacques,
Merci pour les compléments d'informations, je vais essayer ça tout de suite.
Je ne manipule pas souvent ce genre d'instructions, d'où ces quelques
lacunes.
Cordailement, Bob

"Jacques93" a écrit dans le message de news:
%
Petit correctif :

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
X = X / 15
Y = Y / 15
With Picture1
.ScaleMode = vbPixels
.FillStyle = vbFSSolid

'X = .Left + X => à supprimer
'Y = .Top + Y => à supprimer

.ForeColor = vbBlack ' couleur ligne
.FillColor = vbGreen ' couleur de remplissage
FloodFill .hDC, X, Y, .ForeColor
End With
End Sub



--
Cordialement,

Jacques.


Avatar
Bob
En réalité, il ne faut plus que ça pour que ça tourne.
Seul truc à voir : le remplissage n'agit qu'à partir du second clic dans un
département.
Je pense qu'il faudrait initialiser "Mode", "Style" etc dans une autre
procédure, avant d'appeler celle-ci.
A suivre.
Merci encore.
Bob

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
With Picture1
.ScaleMode = vbPixels
.FillStyle = vbFSSolid
.ForeColor = vbBlack ' couleur ligne
.FillColor = vbBlue ' couleur de remplissage
FloodFill .hDC, X, Y, .ForeColor
End With
End Sub

"Jacques93" a écrit dans le message de news:
%
Petit correctif :

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
X = X / 15
Y = Y / 15
With Picture1
.ScaleMode = vbPixels
.FillStyle = vbFSSolid

'X = .Left + X => à supprimer
'Y = .Top + Y => à supprimer

.ForeColor = vbBlack ' couleur ligne
.FillColor = vbGreen ' couleur de remplissage
FloodFill .hDC, X, Y, .ForeColor
End With
End Sub



--
Cordialement,

Jacques.


Avatar
Jacques93
Bonjour Bob,
Bob a écrit :
En réalité, il ne faut plus que ça pour que ça tourne.
Seul truc à voir : le remplissage n'agit qu'à partir du second clic dans un
département.
Je pense qu'il faudrait initialiser "Mode", "Style" etc dans une autre
procédure, avant d'appeler celle-ci.
A suivre.
Merci encore.
Bob



Pour moi, avec ce code c'est Ok (à condition de bien cadrer l'image dans
le PictureBox) :

Option Explicit

Public colorcls ' couleur de remplissage si département pas fait
Public colorfond ' couleur de remplissage si département fait

Private Sub Command1_Click()
' Remplir les départements avec la couleur définie par "si fait"
Picture1.FillColor = colorfond ' couleur de remplissage
remplir
End Sub

Private Sub Command2_Click()
' Effacer les départements avec la couleur définie par "si pas fait"
Picture1.FillColor = colorcls ' couleur de remplissage
remplir
End Sub

Private Sub Command3_Click()
' choix de la couleur de remplissage si département fait
' Affecte la valeur True à la propriété
' CancelError.
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' Définit la propriété Flags.
CommonDialog1.Flags = cdlCCRGBInit
' Affiche la boîte de dialogue Couleur.
CommonDialog1.ShowColor
' Définit la couleur
' en fonction de la couleur sélectionnée.
colorfond = CommonDialog1.Color
Label1.BackColor = CommonDialog1.Color
Picture1.FillColor = colorfond ' couleur de remplissage
remplir
Exit Sub

ErrHandler:
End Sub

Private Sub Command4_Click()
' choix de la couleur de remplissage si département pas fait
' Affecte la valeur True à la propriété
' CancelError.
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' Définit la propriété Flags.
CommonDialog1.Flags = cdlCCRGBInit
' Affiche la boîte de dialogue Couleur.
CommonDialog1.ShowColor
' Définit la couleur
' en fonction de la couleur sélectionnée.
colorcls = CommonDialog1.Color
Label2.BackColor = CommonDialog1.Color
Picture1.FillColor = colorcls ' couleur de remplissage
remplir
Exit Sub

ErrHandler:
End Sub

Private Sub Form_Activate()
With Picture1
.ScaleMode = vbPixels
.FillStyle = vbFSSolid ' style de remplissage
.ForeColor = vbBlack ' couleur ligne
colorfond = &HFF00& ' couleur par défaut au démarrage si
département fait
colorcls = &HFFFFFF ' couleur par défaut au démarrage si
département pas fait
End With
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
With Picture1
.ForeColor = vbBlack ' couleur ligne
.FillColor = &HFF& ' couleur de remplissage
FloodFill .hDC, X, Y, .ForeColor ' Appelle l’API Windows pour
remplir la surface
End With
Label3 = "X: " & Str$(X) & " " & "Y: " & Str$(Y)
End Sub

Sub remplir()
Dim n As Integer, z As Integer
Dim a As String
Dim X As Long, Y As Long

MousePointer = 11
Open App.Path & "coordonnees.txt" For Input As #1
For n = 0 To 97
Line Input #1, a
If n <> 20 Then
z = InStr(a, ";")
X = Val(Left$(a, z - 1))
Y = Val(Mid$(a, z + 1))
FloodFill Picture1.hDC, X, Y, Picture1.ForeColor ' Appelle
l’API Windows pour remplir la surface
End If
Next n
Close 1
MousePointer = 0
End Sub

Private Sub Timer1_Timer()
With Picture1
.ForeColor = vbBlack ' couleur ligne
.FillColor = &HFFFF00 ' couleur de remplissage
FloodFill .hDC, 25, 25, .ForeColor
FloodFill .hDC, 400, 138, .ForeColor
End With
Timer1.Enabled = False
End Sub


--
Cordialement,

Jacques.
Avatar
Bob
"Jacques93" a écrit dans le message de news:

Bonjour Bob,
Bob a écrit :
En réalité, il ne faut plus que ça pour que ça tourne.
Seul truc à voir : le remplissage n'agit qu'à partir du second clic dans
un département.
Je pense qu'il faudrait initialiser "Mode", "Style" etc dans une autre
procédure, avant d'appeler celle-ci.
A suivre.
Merci encore.
Bob



Pour moi, avec ce code c'est Ok (à condition de bien cadrer l'image dans
le PictureBox) :

Option Explicit

Public colorcls ' couleur de remplissage si département pas fait
Public colorfond ' couleur de remplissage si département fait

Private Sub Command1_Click()
' Remplir les départements avec la couleur définie par "si fait"
Picture1.FillColor = colorfond ' couleur de remplissage
remplir
End Sub

Private Sub Command2_Click()
' Effacer les départements avec la couleur définie par "si pas fait"
Picture1.FillColor = colorcls ' couleur de remplissage
remplir
End Sub

Private Sub Command3_Click()
' choix de la couleur de remplissage si département fait
' Affecte la valeur True à la propriété
' CancelError.
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' Définit la propriété Flags.
CommonDialog1.Flags = cdlCCRGBInit
' Affiche la boîte de dialogue Couleur.
CommonDialog1.ShowColor
' Définit la couleur
' en fonction de la couleur sélectionnée.
colorfond = CommonDialog1.Color
Label1.BackColor = CommonDialog1.Color
Picture1.FillColor = colorfond ' couleur de remplissage
remplir
Exit Sub

ErrHandler:
End Sub

Private Sub Command4_Click()
' choix de la couleur de remplissage si département pas fait
' Affecte la valeur True à la propriété
' CancelError.
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' Définit la propriété Flags.
CommonDialog1.Flags = cdlCCRGBInit
' Affiche la boîte de dialogue Couleur.
CommonDialog1.ShowColor
' Définit la couleur
' en fonction de la couleur sélectionnée.
colorcls = CommonDialog1.Color
Label2.BackColor = CommonDialog1.Color
Picture1.FillColor = colorcls ' couleur de remplissage
remplir
Exit Sub

ErrHandler:
End Sub

Private Sub Form_Activate()
With Picture1
.ScaleMode = vbPixels
.FillStyle = vbFSSolid ' style de remplissage
.ForeColor = vbBlack ' couleur ligne
colorfond = &HFF00& ' couleur par défaut au démarrage si
département fait
colorcls = &HFFFFFF ' couleur par défaut au démarrage si
département pas fait
End With
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
With Picture1
.ForeColor = vbBlack ' couleur ligne
.FillColor = &HFF& ' couleur de remplissage
FloodFill .hDC, X, Y, .ForeColor ' Appelle l’API Windows pour remplir
la surface
End With
Label3 = "X: " & Str$(X) & " " & "Y: " & Str$(Y)
End Sub

Sub remplir()
Dim n As Integer, z As Integer
Dim a As String
Dim X As Long, Y As Long

MousePointer = 11
Open App.Path & "coordonnees.txt" For Input As #1
For n = 0 To 97
Line Input #1, a
If n <> 20 Then
z = InStr(a, ";")
X = Val(Left$(a, z - 1))
Y = Val(Mid$(a, z + 1))
FloodFill Picture1.hDC, X, Y, Picture1.ForeColor ' Appelle l’API
Windows pour remplir la surface
End If
Next n
Close 1
MousePointer = 0
End Sub

Private Sub Timer1_Timer()
With Picture1
.ForeColor = vbBlack ' couleur ligne
.FillColor = &HFFFF00 ' couleur de remplissage
FloodFill .hDC, 25, 25, .ForeColor
FloodFill .hDC, 400, 138, .ForeColor
End With
Timer1.Enabled = False
End Sub


--
Cordialement,

Jacques.



Je n'avais repris que la procédure "Picture1_MouseDown....." et j'avais
remplacé l'objet "Image" par un objet "Picture".
En reprenant la totalité c'est ok sans problème.
Encore merci.
Cordialement, Bob
1 2