elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Tutorial básico de Quickjs


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  Color del Pixel en donde está el Mouse
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: Color del Pixel en donde está el Mouse  (Leído 3,978 veces)
Dessa


Desconectado Desconectado

Mensajes: 624



Ver Perfil
Color del Pixel en donde está el Mouse
« en: 30 Octubre 2008, 00:29 am »

'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:

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


En línea

Adrian Desanti
seba123neo
Moderador
***
Desconectado Desconectado

Mensajes: 3.621



Ver Perfil WWW
Re: Color del Pixel en donde está el Mouse
« Respuesta #1 en: 30 Octubre 2008, 00:30 am »

Hola,Dessa proba este code:

Código
  1. Option Explicit
  2.  
  3. Private Type POINTAPI
  4.    x As Long
  5.    y As Long
  6. End Type
  7.  
  8. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  9. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  10. Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
  11.  
  12. Private Sub Form_Load()
  13.    Timer1.Interval = 100
  14. End Sub
  15.  
  16. Private Sub Timer1_Timer()
  17.    Dim tPOS As POINTAPI
  18.    Dim sTmp As String
  19.    Dim lColor As Long
  20.    Dim lDC As Long
  21.    lDC = GetWindowDC(0)
  22.    Call GetCursorPos(tPOS)
  23.    lColor = GetPixel(lDC, tPOS.x, tPOS.y)
  24.    Me.BackColor = lColor
  25.    sTmp = Right$("000000" & Hex(lColor), 6)
  26.    Me.Caption = "R:" & Right$(sTmp, 2) & " G:" & Mid$(sTmp, 3, 2) & " B:" & Left$(sTmp, 2)
  27. End Sub

saludos.



« Última modificación: 30 Octubre 2008, 00:41 am por seba123neo » En línea

Dessa


Desconectado Desconectado

Mensajes: 624



Ver Perfil
Re: Color del Pixel en donde está el Mouse
« Respuesta #2 en: 30 Octubre 2008, 00:40 am »

Perfecto Seba , Gracias (otra vez).

« Última modificación: 6 Octubre 2009, 17:12 pm por Dessa » En línea

Adrian Desanti
TomaSs

Desconectado Desconectado

Mensajes: 101



Ver Perfil
Re: Color del Pixel en donde está el Mouse
« Respuesta #3 en: 30 Marzo 2010, 00:39 am »

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! :)
En línea

LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
Re: Color del Pixel en donde está el Mouse
« Respuesta #4 en: 30 Marzo 2010, 02:22 am »

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
  1. Option Explicit
  2. 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
  3. Private Declare Function UnhookWindowsHookEx Lib "user32.dll" (ByVal hHook As Long) As Long
  4. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  5. Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
  6. Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  7.  
  8. Private Const WH_MOUSE_LL As Long = 14
  9.  
  10. Private Type POINTAPI
  11.    x As Long
  12.    y As Long
  13. End Type
  14.  
  15. Dim hHook As Long
  16. Dim lDC As Long
  17.  
  18. Public Sub StartHook()
  19.    hHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, App.hInstance, 0)
  20.    lDC = GetWindowDC(0&)
  21. End Sub
  22.  
  23.  
  24. Public Sub StopHook()
  25.    Call UnhookWindowsHookEx(hHook)
  26.    ReleaseDC 0&, lDC
  27. End Sub
  28.  
  29.  
  30. Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, lParam As POINTAPI) As Long
  31.    On Error Resume Next
  32.  
  33.    Dim lColor As Long
  34.  
  35.    lColor = GetPixel(lDC, lParam.x, lParam.y)
  36.  
  37.    If lColor = -1 Then
  38.        ReleaseDC 0&, lDC
  39.        lDC = GetWindowDC(0&)
  40.        lColor = GetPixel(lDC, lParam.x, lParam.y)
  41.    End If
  42.  
  43.    Form1.BackColor = lColor
  44.  
  45. End Function
  46.  

y para el form1
Código
  1. Option Explicit
  2.  
  3. Private Sub Form_Load()
  4.    StartHook
  5. End Sub
  6.  
  7. Private Sub Form_Unload(Cancel As Integer)
  8.    StopHook
  9. End Sub
  10.  
Saludos.
« Última modificación: 30 Marzo 2010, 02:26 am por LeandroA » En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines