'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.
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
Hola,Dessa proba este code:
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.
Perfecto Seba , Gracias (otra vez).
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! :)
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
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
Option Explicit
Private Sub Form_Load()
StartHook
End Sub
Private Sub Form_Unload(Cancel As Integer)
StopHook
End Sub
Saludos.