Título: Píxeles y Bucle For
Publicado por: calk9 en 18 Septiembre 2011, 20:40 pm
Buenas a todos, estoy realizando una aplicacion la cual en un bucle for recorre, moviende el mouse, una determinada área y al encontrar un píxel con determinado color, se frene. EL PROBLEMA es que, al recorrer el área moviendo el cursor con el bucle previamente mencionado anda todo perfecto, con una rapidez considerable, en cambio cuando "coloco" el código para verificar si encuentra el píxel lo hace un 90% más lento. Este es mi código: Dim iX As Integer Dim iY As Integer Dim hdc As Long, pxColor As Double Call GetCursorPos(Mouse) For iX = Mouse.x To Mouse.x + 100 For iY = Mouse.y To Mouse.y + 75 Call SetCursorPos(iX, iY) 'Hasta acá todo bien, lo que viene ahora es lo que lenta muchísimo mi aplicación... hdc = GetDC(0) pxColor = GetPixel(hdc, Mouse.x, Mouse.y) ReleaseDC 0, hdc Me.Caption = Hex(pxColor) If Me.Caption = "AA431B" Then Exit For End If '// Next iY Next iX
No se cual es el problema, por qué lo hace muchísimo mas lento. Ya que sin verificar el color lo hace en unas milésimas de segundo, y luego con el código para verificar tarda unos 20 o 30 en recorrer el mouse todo el área. Pues ni me imagino cuando haga áreas mas grandes. Saludos.
Título: Re: Píxeles y Bucle For
Publicado por: Sanlegas en 18 Septiembre 2011, 20:48 pm
Te recomendaria que averigues sobre el formato Bitmap ... es mucho mas rapido, salu2 !
Título: Re: Píxeles y Bucle For
Publicado por: raul338 en 18 Septiembre 2011, 20:54 pm
Exacto, toma un screenshot de la pantalla y de ahi analizalo :P
Título: Re: Píxeles y Bucle For
Publicado por: calk9 en 18 Septiembre 2011, 20:56 pm
Pues es en tiempo real... como podría hacer?
Título: Re: Píxeles y Bucle For
Publicado por: ignorantev1.1 en 18 Septiembre 2011, 21:14 pm
Perdon que me meta pero:
Llevo tiempo buscando y no encuentro nada al respecto ¿Hay alguna forma de volcar el contenido de un bitmap(de un contenedor) a un array?
Esa (creo) sería la forma mas rápida de encontrar determinado pixel...
Saludos!
Título: Re: Píxeles y Bucle For
Publicado por: raul338 en 18 Septiembre 2011, 21:25 pm
Llevo tiempo buscando y no encuentro nada al respecto ¿Hay alguna forma de volcar el contenido de un bitmap(de un contenedor) a un array?
Esa (creo) sería la forma mas rápida de encontrar determinado pixel...
un BMP es un array de por si con un par de bytes mas :P Aca en un tuto de DirectX para C# explican mas o menos como leer un bmp desde archivo :P: http://www.riemers.net/eng/Tutorials/DirectX/Csharp/Series1/tut10.php (http://www.riemers.net/eng/Tutorials/DirectX/Csharp/Series1/tut10.php) No hace falta saber mucho C# para entenderlo, tiene una buena introduccion :P
Título: Re: Píxeles y Bucle For
Publicado por: calk9 en 18 Septiembre 2011, 21:26 pm
Aver si me pueden ayudar con mi planteo...
Título: Re: Píxeles y Bucle For
Publicado por: Sanlegas en 18 Septiembre 2011, 21:42 pm
Perdon que me meta pero:
Llevo tiempo buscando y no encuentro nada al respecto ¿Hay alguna forma de volcar el contenido de un bitmap(de un contenedor) a un array?
Esa (creo) sería la forma mas rápida de encontrar determinado pixel...
Saludos!
Si, es posible http://carlosagreda.blogspot.com/2008/02/destripando-un-bmp-24-bits.html (http://carlosagreda.blogspot.com/2008/02/destripando-un-bmp-24-bits.html)
Título: Re: Píxeles y Bucle For
Publicado por: ignorantev1.1 en 18 Septiembre 2011, 22:14 pm
@calk9¡Tu no te metas!... Hahaha es broma :xD Esto te consumirá tiempo valioso siempre: Call SetCursorPos(iX, iY) No entiendo el porqué lo ideal sería colocar el cursor luego de encontrar el pixel que se busca, pero pues sabes lo que haces. Y todo esto: hdc = GetDC(0) pxColor = GetPixel(hdc, Mouse.x, Mouse.y) ReleaseDC 0, hdc Me.Caption = Hex(pxColor) If Me.Caption = "AA431B" Then Exit For End If
yo lo reduciría a esto: Me.Caption = Hex$(point(ix,iy) If Me.Caption = "AA431B" Then Exit For End If
@Raul338, @Tenient101Pues ambos son buenos tutoriales, pero no me referia a eso precisamente: :xD Más bien a cuando la imagen se almacena en un contenedor, por ejemplo hacer unos trazados en un picturebox(lineas, círculos y pintados), todo esto queda almacenado en el campo "image" del contenedor(picturebox o form), ahora volvar el contenido de "image" a un array, creo que la clave está en localizar el punto en memoria donde se almacena "image"... Saludos!
Título: Re: Píxeles y Bucle For
Publicado por: calk9 en 18 Septiembre 2011, 23:45 pm
Pues sigo teniendo el mismo problema. El API SetCursorPos no es el problema, ese bucle lo hace en unas milesimas de segundo. El problema es el ver el color del pixel. Gracias igual! ;D
Sigo esperando respuestas...
P.D: Te importaría darme tu msn?
Título: Re: Píxeles y Bucle For
Publicado por: raul338 en 18 Septiembre 2011, 23:54 pm
No entiendo el porqué lo ideal sería colocar el cursor luego de encontrar el pixel que se busca, pero pues sabes lo que haces.
Eso, importa el puntero del mouse? GetDC y ReleaseDC consumen IO :P
Título: Re: Píxeles y Bucle For
Publicado por: ignorantev1.1 en 19 Septiembre 2011, 00:24 am
P.D: Te importaría darme tu msn? Si es para mí, mandame tu msn por PM, si no lo es... emmm... el caballo corre por el campo... Eso, importa el puntero del mouse? GetDC y ReleaseDC consumen IO :P Exacto, ¿por qué no colocarlos fuera del bucle? ¿Y de mi plantiamiento ni hablamos verdad? :xD Saludos!
Título: Re: Píxeles y Bucle For
Publicado por: raul338 en 19 Septiembre 2011, 00:31 am
¿Y de mi plantiamiento ni hablamos verdad? :xD
Para eso es la misma tecnica, no podemos usar el DC como un mapa de bits :-\ asi que hay que convertirlo a BMP de ahi trabajar libremente :P
Título: Re: Píxeles y Bucle For
Publicado por: calk9 en 19 Septiembre 2011, 00:46 am
Jaj no me había fijado en eso, ya lo saqué del bucle pero el problema no era eso sino la sentencia if y el ver el color del pixel actual en donde se encuentra el mouse. Yo pense en ponerlo en un timer el código para verificar el color del pixel pero el bucle for es mucho más rapido que 1 milisegundo (que es el menor intervalo de un timer). Pues entonces digo, hago un hook y que al detectar WM_MOUSEMOVE verifique el color del pixel así estaría a la misma velocidad que el bulce... supongo jej. Pero necesito hacer un hook al mouse, no a mi aplicación y de otra ni hablar ya que tendría que inyectar una DLL... y no en basic :rolleyes:.
Alguna idea? :P
Saludos.
Título: Re: Píxeles y Bucle For
Publicado por: raul338 en 19 Septiembre 2011, 01:09 am
Para hacer un hook al mouse no tienes que inyectar una DLL, solo necesitas una funcion en un modulo :xD
Título: Re: Píxeles y Bucle For
Publicado por: calk9 en 19 Septiembre 2011, 03:33 am
Sep pero para un proceso que no es el mio si necesito inyectar una DLL. Como podría hookear el mouse, sin especificar un determinado hwnd, simplemente los mensajes del mouse?
Saludos
Título: Re: Píxeles y Bucle For
Publicado por: Hasseds en 19 Septiembre 2011, 04:01 am
mmm... revisá si esto puede servir, en caso q sirva... te toca optimizar. Option Explicit Private Sub Form_Load() Call SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, &H2 Or &H1) AutoRedraw = True FontBold = True BackColor = &HAA431B ForeColor = vbWhite StartHook End Sub Private Sub Form_Unload(Cancel As Integer) StopHook End Sub
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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags 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 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, &H0&) lDC = GetWindowDC(&H0&) End Sub Public Sub StopHook() Call UnhookWindowsHookEx(hHook) hHook = &H0& Call ReleaseDC(&H0&, lDC) End Sub Private Function MouseProc(ByVal ncode As Long, ByVal wParam As Long, lParam As POINTAPI) As Long Dim lColor As Long lColor = GetPixel(lDC, lParam.x, lParam.y) 'If Not lColor < 0 Then 'Form1.Cls 'Form1.Print Hex(lColor) If lColor = &HAA431B Then Form1.Caption = "SI" Else Form1.Caption = "NO" End If 'End If MouseProc = CallNextHookEx(hHook, ncode, wParam, lParam) End Function
Título: Re: Píxeles y Bucle For
Publicado por: raul338 en 19 Septiembre 2011, 11:04 am
Creo que estas equivocando en conceptos :P
Para hacer un Hook al mouse no necesitas un hwnd especifico, es directo al mouse, pase por donde pase, haga lo que haga :P
Lo que tu quieres caputrar son los mensajes del mouse sobre una ventana, se llama "subclassing". Esta la clase de Paul Caton para subclassifcar formularios de tus proyectos, pero cuando se trata de otras aplicaciones, solo queda una dll que se injecta sola (anda dando vueltas por ahi :xD)
Revisa bien que quieres hacer, para mi que con solo hookear el mouse alcanza
Título: Re: Píxeles y Bucle For
Publicado por: LeandroA en 19 Septiembre 2011, 21:19 pm
Hola, si es masomenos lo que entiendo esta es la forma mas rapida Option Explicit 'Autor: Leandro Ascierto 'Web: http://leandroascierto.com/blog/ Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByVal lColorRef As Long) As Long Private Declare Function SetCursorPos Lib "user32.dll" (ByVal x As Long, ByVal y As Long) As Long Private Type RGBQUAD rgbBlue As Byte rgbGreen As Byte rgbRed As Byte rgbReserved As Byte End Type Private Type BITMAPINFOHEADER biSize As Long biWidth As Long biHeight As Long biPlanes As Integer biBitCount As Integer biCompression As Long biSizeImage As Long biXPelsPerMeter As Long biYPelsPerMeter As Long biClrUsed As Long biClrImportant As Long End Type Private Type BITMAPINFO bmiHeader As BITMAPINFOHEADER bmiColors As RGBQUAD End Type Private Type SAFEARRAYBOUND cElements As Long lLbound As Long End Type Private Type SAFEARRAY2D cDims As Integer fFeatures As Integer cbElements As Long cLocks As Long pvData As Long Bounds(0 To 1) As SAFEARRAYBOUND End Type Private Type POINTAPI x As Long y As Long End Type Private Const DIB_RGB_COLORS = 0 Private Const BI_RGB = 0& Private Function FindColorInScreen(ByVal oColor As OLE_COLOR, ByRef PT() As POINTAPI) As Long Dim ScreenDC As Long Dim TmpDC As Long Dim hBmp As Long Dim OldBmp As Long Dim Addrs As Long Dim x As Long Dim y As Long Dim lpBits() As Long Dim BI As BITMAPINFO Dim SA As SAFEARRAY2D Dim W As Long, H As Long Dim lColor As Long W = Screen.Width / Screen.TwipsPerPixelX H = Screen.Height / Screen.TwipsPerPixelY With BI.bmiHeader .biSize = Len(BI.bmiHeader) .biWidth = W .biHeight = H .biPlanes = 1 .biBitCount = 32 .biCompression = BI_RGB .biSizeImage = AlignScan(.biWidth, .biBitCount) * .biHeight End With ScreenDC = GetDC(0) TmpDC = CreateCompatibleDC(ScreenDC) hBmp = CreateDIBSection(ScreenDC, BI, DIB_RGB_COLORS, Addrs, 0, 0) OldBmp = SelectObject(TmpDC, hBmp) Call BitBlt(TmpDC, 0, 0, W, H, ScreenDC, 0, 0, vbSrcCopy) Call ReleaseDC(0&, ScreenDC) With SA .cbElements = 4 .cDims = 2 .Bounds(0).lLbound = 0 .Bounds(0).cElements = H .Bounds(1).lLbound = 0 .Bounds(1).cElements = (BI.bmiHeader.biSizeImage \ .Bounds(0).cElements) \ 4 .pvData = Addrs End With CopyMemory ByVal VarPtrArray(lpBits), VarPtr(SA), 4 ReDim PT(0) lColor = ConvertColor(oColor) For y = H - 1 To 0 Step -1 For x = 0 To W - 1 If lpBits(x, y) = lColor Then ReDim Preserve PT(FindColorInScreen) With PT(FindColorInScreen) .x = x .y = H - y End With FindColorInScreen = FindColorInScreen + 1 End If Next Next CopyMemory ByVal VarPtrArray(lpBits), 0&, 4 Call DeleteObject(SelectObject(TmpDC, OldBmp)) Call DeleteDC(TmpDC) End Function Private Function AlignScan(ByVal inWidth As Long, ByVal inDepth As Integer) As Long AlignScan = (((inWidth * inDepth) + &H1F) And Not &H1F&) \ &H8 End Function Private Function ConvertColor(oColor As OLE_COLOR) As Long Dim RGBA(0 To 3) As Byte Dim BGRA(0 To 3) As Byte OleTranslateColor oColor, 0, VarPtr(RGBA(0)) BGRA(0) = RGBA(2) BGRA(1) = RGBA(1) BGRA(2) = RGBA(0) BGRA(3) = &HFF CopyMemory ConvertColor, BGRA(0), 4& End Function Private Sub Form_Load() Dim lCount As Long Dim PT() As POINTAPI Me.AutoRedraw = True lCount = FindColorInScreen(vbBlue, PT) If lCount > 0 Then SetCursorPos PT(0).x, PT(0).y Dim i As Long For i = 0 To lCount - 1 Debug.Print PT(i).x, PT(i).y Next End If End Sub
Título: Re: Píxeles y Bucle For
Publicado por: calk9 en 20 Septiembre 2011, 00:51 am
mmm... revisá si esto puede servir, en caso q sirva... te toca optimizar. Option Explicit Private Sub Form_Load() Call SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, &H2 Or &H1) AutoRedraw = True FontBold = True BackColor = &HAA431B ForeColor = vbWhite StartHook End Sub Private Sub Form_Unload(Cancel As Integer) StopHook End Sub
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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags 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 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, &H0&) lDC = GetWindowDC(&H0&) End Sub Public Sub StopHook() Call UnhookWindowsHookEx(hHook) hHook = &H0& Call ReleaseDC(&H0&, lDC) End Sub Private Function MouseProc(ByVal ncode As Long, ByVal wParam As Long, lParam As POINTAPI) As Long Dim lColor As Long lColor = GetPixel(lDC, lParam.x, lParam.y) 'If Not lColor < 0 Then 'Form1.Cls 'Form1.Print Hex(lColor) If lColor = &HAA431B Then Form1.Caption = "SI" Else Form1.Caption = "NO" End If 'End If MouseProc = CallNextHookEx(hHook, ncode, wParam, lParam) End Function
Excelente justo lo que necesitaba! Gracias.
Título: Re: Píxeles y Bucle For
Publicado por: Hasseds en 20 Septiembre 2011, 02:28 am
De Nadas, usa stopHook para terminar la búsqueda y capturar las coordenadas If Not GetPixel(lDC, lParam.x, lParam.y) = &HAA431B Then Form1.Caption = "" Else Form1.Caption = "AA431B " & lParam.x & " " & lParam.y StopHook Exit Function 'si hace falta End If
Si podés usá WindowfromPoint para que solo actúe sobre el control o la ventana que corresponda y si tenés q cerrar la aplicación desde el code ... Unload Me o cerrar desde la "X" (BOTON CERRAR), saludos
|