Color del Pixel en donde está el Mouse

[Dessa]

'Hola alguien me puede ayudar para saber de que color es el pixel en que se encuentra el puntero del mouse, estoy intentando con el sig.code pero no sale.

Código [Seleccionar] Expandir



Option Explicit
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim ret As Long
Dim Handle As Long
Dim Cor As POINTAPI
Dim hhdc As Long

Private Sub Form_Load()
Timer1.Interval = 10
End Sub

Private Sub Timer1_Timer()

'Obtengo la coordenada del Mouse
ret = GetCursorPos(Cor)
'Recupero el HWND del comntrol asociado a esa coordenada
Handle = WindowFromPoint(Cor.X, Cor.Y)
'Obtengo el hdc del control
hhdc = GetDC(Handle)
Label1.Caption = Hex(GetPixel(hhdc, Cor.X, Cor.Y))
Label2 = Cor.X & "  " & Cor.Y

End Sub



'Gracias & Saludos

[seba123neo]

Hola,Dessa proba este code:

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

Private Sub Form_Load()
    Timer1.Interval = 100
End Sub

Private Sub Timer1_Timer()
    Dim tPOS As POINTAPI
    Dim sTmp As String
    Dim lColor As Long
    Dim lDC As Long
    lDC = GetWindowDC(0)
    Call GetCursorPos(tPOS)
    lColor = GetPixel(lDC, tPOS.x, tPOS.y)
    Me.BackColor = lColor
    sTmp = Right$("000000" & Hex(lColor), 6)
    Me.Caption = "R:" & Right$(sTmp, 2) & " G:" & Mid$(sTmp, 3, 2) & " B:" & Left$(sTmp, 2)
End Sub

saludos.

[Dessa]

Perfecto Seba , Gracias (otra vez).

[TomaSs]

Una preguntilla, y no habría alguna manera de hacer eso pero sin un timer??? sino que directamente lo haga al mover el raton???
esk para el evento mousemove se tiene que indicar sobre que objeto se va ha mover (Ej: picture1_mousemove), y si es para toda la pantalla, o todo el formulario dificil...
Aver si alguien podría ayudarme.

Muchas gracias de antemano!

[LeandroA]

Este tema esta algo viejo segun las reglas no se puede revivir. pero bueno para la proxima crea un nuevo post y pode hacer referencia al link

bueno la respuesta es utilizando hook

en un modulo .bas

Código (vb) [Seleccionar] Expandir


Option Explicit
Private Declare Function SetWindowsHookEx Lib "user32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook 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 GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Const WH_MOUSE_LL As Long = 14

Private Type POINTAPI
   x As Long
   y As Long
End Type

Dim hHook As Long
Dim lDC As Long

Public Sub StartHook()
   hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, App.hInstance, 0)
   lDC = GetWindowDC(0&)
End Sub


Public Sub StopHook()
   Call UnhookWindowsHookEx(hHook)
   ReleaseDC 0&, lDC
End Sub


Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, lParam As POINTAPI) As Long
    On Error Resume Next
   
    Dim lColor As Long
   
    lColor = GetPixel(lDC, lParam.x, lParam.y)
   
    If lColor = -1 Then
        ReleaseDC 0&, lDC
        lDC = GetWindowDC(0&)
        lColor = GetPixel(lDC, lParam.x, lParam.y)
    End If
   
    Form1.BackColor = lColor

End Function


y para el form1

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Sub Form_Load()
   StartHook
End Sub

Private Sub Form_Unload(Cancel As Integer)
   StopHook
End Sub

Saludos.