Je cherche à obtenir la couleur, ou plutôt le niveau de gris d'un pixel
sur une image.
En VB, ça marche avec le code ci-joint mais en VBA97, rien à faire.
Il semble qu'il n'existe pas en VBA97 de propriété permettant de
récupérer la couleur du pixel ?
--
Je crée 2 labels : lblColor et lblCoord
un shape : shpResult
la picturebox s'appelle imgEx
Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal
X As Long, ByVal Y As Long) As Long
Private Sub Form_Load()
End Sub
Private Sub imgEx_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
Dim Color As Long
Color = GetPixel(imgEx.hdc, X, Y)
lblColor.Caption = "&&H" & Hex(Color)
lblCoord.Caption = "X : " & X & vbCrLf & "Y : " & Y
shpResult.FillColor = Color
shpResult.Refresh
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Michel Pierron
Bonsoir Christian; L'image doit appartenir à l'userform (propriété picture) puisqu'il faut un handle. shpResult sera un label au lieu d'un shape. Dans UserForm_MouseMove, X et Y doivent être multipliés par 4/3 puisque les API utilisent des pixels et Excel des points.
Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 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 hDC As Long
Private Sub UserForm_Activate() hDC = GetDC(FindWindow(vbNullString, Me.Caption)) End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer _ , ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) lblCoord.Caption = "X= " & X & " Y= " & Y Dim Color As Long Color = GetPixel(hDC, X * 4 / 3, Y * 4 / 3) lblColor.Caption = "&H" & Hex(Color) shpResult.BackColor = Color End Sub
MP
"Christian Herbé" a écrit dans le message de news:
RE bonjour
Je cherche à obtenir la couleur, ou plutôt le niveau de gris d'un pixel sur une image.
En VB, ça marche avec le code ci-joint mais en VBA97, rien à faire. Il semble qu'il n'existe pas en VBA97 de propriété permettant de récupérer la couleur du pixel ?
-- Je crée 2 labels : lblColor et lblCoord un shape : shpResult la picturebox s'appelle imgEx
Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Sub Form_Load()
End Sub
Private Sub imgEx_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Color As Long
Color = GetPixel(imgEx.hdc, X, Y) lblColor.Caption = "&&H" & Hex(Color) lblCoord.Caption = "X : " & X & vbCrLf & "Y : " & Y shpResult.FillColor = Color shpResult.Refresh
End Sub
Bonsoir Christian;
L'image doit appartenir à l'userform (propriété picture) puisqu'il faut un handle.
shpResult sera un label au lieu d'un shape.
Dans UserForm_MouseMove, X et Y doivent être multipliés par 4/3 puisque les API
utilisent des pixels et Excel des points.
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 hDC As Long
Private Sub UserForm_Activate()
hDC = GetDC(FindWindow(vbNullString, Me.Caption))
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer _
, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
lblCoord.Caption = "X= " & X & " Y= " & Y
Dim Color As Long
Color = GetPixel(hDC, X * 4 / 3, Y * 4 / 3)
lblColor.Caption = "&H" & Hex(Color)
shpResult.BackColor = Color
End Sub
MP
"Christian Herbé" <herbe@nancy.inra.fr> a écrit dans le message de
news:eKb4a0z6DHA.2712@tk2msftngp13.phx.gbl...
RE bonjour
Je cherche à obtenir la couleur, ou plutôt le niveau de gris d'un pixel
sur une image.
En VB, ça marche avec le code ci-joint mais en VBA97, rien à faire.
Il semble qu'il n'existe pas en VBA97 de propriété permettant de
récupérer la couleur du pixel ?
--
Je crée 2 labels : lblColor et lblCoord
un shape : shpResult
la picturebox s'appelle imgEx
Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal
X As Long, ByVal Y As Long) As Long
Private Sub Form_Load()
End Sub
Private Sub imgEx_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
Dim Color As Long
Color = GetPixel(imgEx.hdc, X, Y)
lblColor.Caption = "&&H" & Hex(Color)
lblCoord.Caption = "X : " & X & vbCrLf & "Y : " & Y
shpResult.FillColor = Color
shpResult.Refresh
Bonsoir Christian; L'image doit appartenir à l'userform (propriété picture) puisqu'il faut un handle. shpResult sera un label au lieu d'un shape. Dans UserForm_MouseMove, X et Y doivent être multipliés par 4/3 puisque les API utilisent des pixels et Excel des points.
Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 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 hDC As Long
Private Sub UserForm_Activate() hDC = GetDC(FindWindow(vbNullString, Me.Caption)) End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer _ , ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) lblCoord.Caption = "X= " & X & " Y= " & Y Dim Color As Long Color = GetPixel(hDC, X * 4 / 3, Y * 4 / 3) lblColor.Caption = "&H" & Hex(Color) shpResult.BackColor = Color End Sub
MP
"Christian Herbé" a écrit dans le message de news:
RE bonjour
Je cherche à obtenir la couleur, ou plutôt le niveau de gris d'un pixel sur une image.
En VB, ça marche avec le code ci-joint mais en VBA97, rien à faire. Il semble qu'il n'existe pas en VBA97 de propriété permettant de récupérer la couleur du pixel ?
-- Je crée 2 labels : lblColor et lblCoord un shape : shpResult la picturebox s'appelle imgEx
Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Sub Form_Load()
End Sub
Private Sub imgEx_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Color As Long
Color = GetPixel(imgEx.hdc, X, Y) lblColor.Caption = "&&H" & Hex(Color) lblCoord.Caption = "X : " & X & vbCrLf & "Y : " & Y shpResult.FillColor = Color shpResult.Refresh
End Sub
popi
RE Salut Christian, en complément de Michel, la possibilité de prendre une couleur en dehors du userform : http://www.popivog.com/api5%20couleur2.zip
@+ popi
RE Salut Christian,
en complément de Michel, la possibilité de prendre une couleur en dehors du
userform :
http://www.popivog.com/api5%20couleur2.zip