Ir al contenido


Foto

[AYUDA DELPHI] Encontrar una Imagen en la Pantalla.


  • Por favor identifícate para responder
10 respuestas en este tema

#1 sir.dev.a.lot

sir.dev.a.lot

    Advanced Member

  • Miembros
  • PipPipPip
  • 545 mensajes
  • Location127.0.0.1

Escrito 27 diciembre 2016 - 03:44

Buenas Tardes Colegas...

 

Hoy me he estado cuestionando el rendimiento de una Libreria que uso para comparacion de 2 Imagenes.

 

Pero, al cabo de un tiempo, se me ocurrio plantearlo aqui en este foro para ver si alguien posee una solucion mas aplicabe y mejor optimizada.

 

Aqui explico lo que deseo:

 

Tengo una aplicacion que funciona como el Magnificador de Windows, que me copia un TRECT que yo le defina de la Pantalla a una imagen BMP, PNG, JPEG, etc.

 

Bien tengo la imagen en Temporal visualizandose en la aplicacion,  

 

llamemosle Imagen1

 

Luego subo o cargo a un Canvas una Imagen del disco duro, y la condiciono que cuando sea igual al TRECT y tambien en sus dimensiones me ejecute una condicion.

 

llamemosle Imagen2

 

Ahora, lo que quisiera es que su comparacion NO tuviese que ser Total, sino parcial asi me evito el estar enviandole las coordenadas exactas.

 

Es como si fuese un Scanner para la pantalla, cuando encuentre un Match mediante el TRECT de la imagen subida, sin la necesidad de definir la zona de la pantalla primero.

 

para que tengan una idea mas clara, imaginense un Lector de Codigos de Barras pero que detecte Imagenes.

 

Saludos!


  • 0

#2 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 13 enero 2017 - 06:43

No había visto esta pregunta hasta hoy.
 
No entiendo muy bien lo que quieres pero he hecho una función que escanea un TBitmap en busca de otro contenido en el primero. En caso de encontrarlo, devuelve true y las coordenadas donde lo encontró:


delphi
  1. function ScanBitmap(Bitmap1, Bitmap2: TBitmap; var x, y:integer): boolean;
  2. var
  3.   pB1, Pb2: PAnsiChar;
  4.   y2, old_y: integer;
  5.   Find: boolean;
  6. begin
  7.   Result:= false;
  8.   if (Bitmap1.Height < Bitmap2.Height) or (Bitmap1.Width < Bitmap2.Width) then exit;
  9.  
  10.   // Se tratan los pixels como tripletes RGB (formato 24bits)
  11.   Bitmap1.PixelFormat:= pf24bit;
  12.   Bitmap2.PixelFormat:= pf24bit;
  13.   x:= 0;
  14.   y:= Bitmap1.Height-1;
  15.   y2:= Bitmap2.Height-1;
  16.   old_y:= y;
  17.   repeat
  18.     pB1:= Bitmap1.ScanLine[y];
  19.     pB2:= Bitmap2.ScanLine[y2];
  20.     repeat
  21.       Find:= CompareMem(@pB1[x*3], pB2, Bitmap2.Width*3);
  22.       if Find then
  23.       begin
  24.         Result:= true; // Se encontró coincidencia
  25.         dec(y2);
  26.         break;
  27.       end;
  28.       y2:= Bitmap2.Height-1;
  29.       // si encontró sólo un trozo recupera la línea de escaner
  30.       if Result then
  31.       begin
  32.         y:= old_y;
  33.         Result:= false;
  34.       end else
  35.         // Si no encontró, siguiente pixel
  36.         inc(x);
  37.     until x >= Bitmap1.Width-Bitmap2.Width;
  38.     dec(y);   // siguiente línea
  39.     if not Find then
  40.     begin
  41.       x:= 0;
  42.       old_y:= y; // Línea de último escaner
  43.     end;
  44.   until (y = 0) or (y2 = 0);
  45.   y:= Bitmap1.Height - Bitmap2.Height - y;
  46. end;

Ejemplo se uso:


delphi
  1. var
  2. x,y: integer;
  3. begin
  4. if ScanBitmap(Image1.Picture.Bitmap, Image2.Picture.Bitmap, x, y) then
  5. Windows.Beep(1000, 100);
  6. end;

Esta función no trabaja con similitudes sino con contenido exacto, para ello convierte las imágenes a 24bits y luego escanea usando ScanLine.

Sólo encuentra la primera congruencia, si hay más no sigue buscando.

Se puede optimizar más a base de entender peor su funcionamiento.

 

 

 

Saludos.


  • 3

#3 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 14 enero 2017 - 06:08

Un grado más de optimización es el uso de punteros:


delphi
  1. function ScanBitmap_(Bitmap1, Bitmap2: TBitmap; var x, y:integer): boolean;
  2. var
  3.   pIni1, PIni2, pB1, Pb2: PAnsiChar;
  4.   Size1, Size2: integer;
  5. begin
  6.   Result:= false;
  7.   if (Bitmap1.Height < Bitmap2.Height) or (Bitmap1.Width < Bitmap2.Width) then exit;
  8.  
  9.   // Se tratan los pixels como RGBQUAD (formato 32bits)
  10.   Bitmap1.PixelFormat:= pf32bit;
  11.   Bitmap2.PixelFormat:= pf32bit;
  12.  
  13.   // Calculamos los punteros de inicio y trabajo
  14.   pIni1:= Bitmap1.ScanLine[Bitmap1.Height-1];
  15.   pIni2:= Bitmap2.ScanLine[Bitmap2.Height-1];
  16.   pB1:= PIni1; pB2:= pIni2;
  17.   // Calculamos los tamaños de cada línea de pixels
  18.   Size1:= Bitmap1.Width*4;
  19.   Size2:= Bitmap2.Width*4;
  20.  
  21.   // Escaneando...
  22.   repeat
  23.     repeat
  24.       if CompareMem(pB1, pB2, Size2) then
  25.       begin
  26.         // Si encontró, incrementamos una línea a cada bitmap
  27.         inc(pB1, Size1);
  28.         inc(pB2, Size2);
  29.       end
  30.       else if pB2 >= PIni2 + Bitmap2.Height * Size2 then
  31.         Result:= true  // ¡EURECA! hemos encontrado la congruencia completa
  32.       else
  33.         inc(pB1, 4);   // No encontró, escaneamos desde el siguiente pixel
  34.     // Hasta que cubramos el bitmap a buscar o lo hayamos encontrado
  35.     until Result or (pB1 >= pIni1 + (Bitmap1.Height - Bitmap2.Height) * Size1);
  36.   // Hasta terminar el escaner completo o encontremos el bitmap
  37.   until Result or (pB1 >= pIni1 + Bitmap1.Height*Size1);
  38.  
  39.   // Calculando variables de retorno:
  40.   x:= ((DWORD(pB1) - DWORD(pIni1)) mod Size1) div 4;
  41.   y:= (DWORD(pB1) - DWORD(pIni1)) div Size1 - Bitmap2.Height;
  42. end;

Escanea un TBitmap en busca de otro contenido en el primero. En caso de encontrarlo, devuelve true y las coordenadas donde lo encontró. El funcionamiento es similar a la función anterior pero simplificando el algoritmo por el uso de punteros. Los comentarios aclaran el funcionamiento con punteros.

 

Esta función no trabaja con similitudes sino con contenido exacto, para ello convierte las imágenes a 324bits y luego escanea usando una sola vez ScanLine para encontrar los punteros a los pixels, esta vez de tamaño 4 bytes (RGBQUAD). Sólo encuentra la primera congruencia, si hay más no sigue buscando.

 

 

Saludos.


  • 2

#4 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 15 enero 2017 - 07:58

Si aplicamos la aritmética de punteros para PDWORD (RGBQUAD) podemos llegar a este código más optimizado y con menos operaciones matemáticas:


delphi
  1. function ScanBitmap__(Bitmap1, Bitmap2: TBitmap; var x, y:integer): boolean;
  2. var
  3. pB1, Pb2, pFin1, PFin2: PDWORD;
  4. begin
  5. Result:= false;
  6. if (Bitmap1.Height < Bitmap2.Height) or (Bitmap1.Width < Bitmap2.Width) then exit;
  7.  
  8. // Se tratan los pixels como RGBQUAD (formato 32bits)
  9. Bitmap1.PixelFormat:= pf32bit;
  10. Bitmap2.PixelFormat:= pf32bit;
  11.  
  12. // Calculamos los punteros de trabajo y fin
  13. pB1:= Bitmap1.ScanLine[Bitmap1.Height-1];
  14. pB2:= Bitmap2.ScanLine[Bitmap2.Height-1];
  15. pFin1:= PB1; inc(pFin1, Bitmap1.Width * (Bitmap1.Height - Bitmap2.Height));
  16. pFin2:= pB2; inc(pFin2, Bitmap2.Width * Bitmap2.Height);
  17.  
  18. // Escaneando...
  19. repeat
  20. repeat
  21. if CompareMem(pB1, pB2, Bitmap2.Width shl 2) then
  22. begin
  23. // Si encontró, incrementamos una línea a cada bitmap
  24. inc(pB1, Bitmap1.Width);
  25. inc(pB2, Bitmap2.Width);
  26. end
  27. else if int64(pB2) >= int64(PFin2) then
  28. Result:= true // ¡EURECA! hemos encontrado la congruencia completa
  29. else
  30. inc(pB1, 1); // No encontró, escaneamos desde el siguiente pixel
  31. // Hasta que cubramos el bitmap a buscar o lo hayamos encontrado
  32. until Result or (int64(pB1) >= int64(pFin1));
  33. // Hasta terminar el escaner completo o encontremos el bitmap
  34. until Result or (int64(pB1) >= int64(pFin1));
  35.  
  36. // Calculando variables de retorno:
  37. x:= ((int64(pB1) - int64(Bitmap1.ScanLine[Bitmap1.Height-1])) shr 2) mod Bitmap1.Width;
  38. y:= ((int64(pB1) - int64(Bitmap1.ScanLine[Bitmap1.Height-1])) shr 2) div Bitmap1.Width - Bitmap2.Height;
  39. end;


Saludos.
  • 2

#5 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 15 enero 2017 - 11:38

Aclaraciones para Lazarus:

1. Lazarus solo trabaja con Bitmaps 24bits con lo que sobran las conversiones pero obliga a algún cálculo más si trabajamos con punteros pues los tamaños de las líneas deben ser múltiplos de 4 bytes en un bitmap y eso se asegura cuando el tipo de bitmap es 32bits en lugar de 24.
2. Lazarus trata el mapa de bits, desde el punto de vista del puntero devuelto por ScanLine, distinto que Delphi (Windows). En delphi el mapa comienza en la última línea, se leen de abajo a arriba. Lazarus les da la vuelta y las lee de arriba a abajo, de forma que mientras que el puntero más bajo en Delphi es ScanLine[UltimaLinea-1], en Lazarus es ScanLine[0].
 
La primera versión de ScanBitmap expuesta en este tema, trabaja bien en Delphi y Lazarus, incluso compilado a 64 bits. Para una versión que trabaje con punteros en Lazarus se han de hacer algunos pequeños cambios para adaptar la forma de interpretar los pixels en el puntero devuelto por ScanLine:

LAZARUS 32 y 64 bits: 


delphi
  1. function ScanBitmap_(Bitmap1, Bitmap2: TBitmap; var x, y:integer): boolean;
  2. var
  3. pB1, Pb2, pFin1, PFin2: PBYTE;
  4. Size1, Size2: integer;
  5. begin
  6. Result:= false;
  7. if (Bitmap1.Height < Bitmap2.Height) or (Bitmap1.Width < Bitmap2.Width) then exit;
  8.  
  9. // Lazarus trata los Bitmap como RGBTRIPLE (formato 24bits)
  10. // Ajustamos tamaños en bytes a múltiplo de 4
  11. Size1:= ((Bitmap1.Width * 3 + 3) and $FFFFFFFC);
  12. Size2:= ((Bitmap2.Width * 3 + 3) and $FFFFFFFC);
  13.  
  14. // Calculamos los punteros de trabajo y fin
  15. pB1:= Bitmap1.ScanLine[0];
  16. pB2:= Bitmap2.ScanLine[0];
  17. pFin1:= PB1; inc(pFin1, Size1 * (Bitmap1.Height - Bitmap2.Height));
  18. pFin2:= pB2; inc(pFin2, Size2 * Bitmap2.Height);
  19.  
  20. // Escaneando...
  21. repeat
  22. repeat
  23. if CompareMem(pB1, pB2, Bitmap2.Width * 3) then
  24. begin
  25. // Si encontró, incrementamos una línea a cada bitmap
  26. inc(pB1, Size1);
  27. inc(pB2, Size2);
  28. end
  29. else if int64(pB2) >= int64(PFin2) then
  30. Result:= true // ¡EURECA! hemos encontrado la congruencia completa
  31. else
  32. inc(pB1, 3); // No encontró, escaneamos desde el siguiente pixel
  33. // Hasta que cubramos el bitmap a buscar o lo hayamos encontrado
  34. until Result or (int64(pB1) >= int64(pFin1));
  35. // Hasta terminar el escaner completo o encontremos el bitmap
  36. until Result or (int64(pB1) >= int64(pFin1));
  37.  
  38. // Calculando variables de retorno:
  39. x:= ((int64(pB1) - int64(Bitmap1.ScanLine[0])) mod Size1) div 3;
  40. y:= Bitmap1.Height - (int64(pB1) - int64(Bitmap1.ScanLine[0])) div Size1;
  41. end;

Saludos.


  • 2

#6 sir.dev.a.lot

sir.dev.a.lot

    Advanced Member

  • Miembros
  • PipPipPip
  • 545 mensajes
  • Location127.0.0.1

Escrito 15 enero 2017 - 05:19

Hola @Escafandra

 

Gracias por Responder y tomarte parte de tu tiempo para mi pregunta.

 

Les voy a dar una probada y luego comento.

 

Saludos!


  • 0

#7 Delphius

Delphius

    Advanced Member

  • Administrador
  • 6.295 mensajes
  • LocationArgentina

Escrito 15 enero 2017 - 10:16

Hola,

Yo no termino de entender, ¿Cómo es eso de que el Scanline en Lazarus tiene las líneas de pixel en orden inverso al de Delphi? Estoy tratando de familiarizarme con eso, por el momento estoy leyendo esto. He visto una tabla que comenta algo sobre BitOrder en ReverseBits pero no estoy muy seguro si es a eso lo que te refieres. Tengo que leer la doc con más tranquilidad a ver si lo entiendo.

 

Ha decir verdad, me resulta extraño lo que dices. Tengo mis proyectos en los que uso la suite BGRABitmap, y uso el Scanline de toda la vida como lo usaba en Delphi y hasta el momento no he tenido inconveniente alguno. Aclaro que a diferencia de Delphi, la suite BGRABitmap trabaja SIEMPRE con 32bits, y los canales están en ese orden: Blue, Green, Red y Alpha, y que además es una suite que trabaja con bitmap independiente del dispositivo en lo posible ya que es multiplataforma.

 

Desconozco si es que algo de eso tiene que ver.

 

Saludos,


  • 0

#8 escafandra

escafandra

    Advanced Member

  • Administrador
  • 4.107 mensajes
  • LocationMadrid - España

Escrito 16 enero 2017 - 05:06

Hola,
Yo no termino de entender, ¿Cómo es eso de que el Scanline en Lazarus tiene las líneas de pixel en orden inverso al de Delphi? Estoy tratando de familiarizarme con eso, por el momento estoy leyendo esto. He visto una tabla que comenta algo sobre BitOrder en ReverseBits pero no estoy muy seguro si es a eso lo que te refieres. Tengo que leer la doc con más tranquilidad a ver si lo entiendo.

Ha decir verdad, me resulta extraño lo que dices. Tengo mis proyectos en los que uso la suite BGRABitmap, y uso el Scanline de toda la vida como lo usaba en Delphi y hasta el momento no he tenido inconveniente alguno. Aclaro que a diferencia de Delphi, la suite BGRABitmap trabaja SIEMPRE con 32bits, y los canales están en ese orden: Blue, Green, Red y Alpha, y que además es una suite que trabaja con bitmap independiente del dispositivo en lo posible ya que es multiplataforma.

Desconozco si es que algo de eso tiene que ver.

Saludos,



Quizás no me explicado bien y voy a extenderme un poco para explicarlo con más detalle.

 

En Lazarus y en Delphi ScanLine TBitmap.ScanLine devuelven un puntero a una misma línea del mapa de pixels que se leen de izquierda a derecha como estamos acostumbrados. La diferencia es que Lazarus lo trata como un tipo de 24bits y Delphi puede abarcar en un TBitmap desde 1 a 32 bits sin problemas, e incluso realiza las conversiones hacia arriba de forma excelente (no tanto hacia abajo). Para que Lazarus acepte ScanLine en un TBitmap debemos incluir uses Windows como primer uses. 
 
El mapa de bytes de un Bitmap es un mapa de memoria contínua de todo el Bitmap. Windows lo trata de forma que comienza por la última línea de la imagen hasta la primera. En realidad, ScanLine nos devuelve mucho más que una línea, nos devuelve un puntero a todo el mapa restante desde la línea pedida.
 
Cada línea es un conjunto de Bytes que debe estar alineado a DWORD: 4. En un mapa de 32 bits el alineamiento está hecho por naturaleza, de forma que si recorremos el valor de los punteros desde ScanLine[LastLine-1] encontramos la lílea pedida, pero si seguimos incrementando el puntero saltamos a la siguiente linea de arriba y así hasta acabar el bitmap, es todo un continuo. Esto es así en Delphi y en Windows puesto que usa la API GetDIBits para ello que por defecto devuelve un mapa "bottom-up DIB", aunque la misma API puede cambiarlo a "top-down DIB" si usamos una altura negativa.
 
Al escribir el código para Lazarus expuesto en este tema, previamente escrito en delphi7, me di cuenta que no funcionaba más allá de la primera línea. Dado que el código se basa en ScanLine y lectura continua hasta el valor del último puntero válido, examine los punteros que daba Lazarus:
 


delphi
  1. //LAZARUS
  2. var
  3. p1, p2: Pointer;
  4. begin
  5. p1:= Bitmap.ScanLine[LastLine-1];
  6. p2:= Bitmap.ScanLine[LastLine-2];
  7.  
  8. // Resulta que p1 > p2 CONTRARIO a Delphi

Tras esto me di cuenta que Lazarus trata por defecto el mapa como "top-down DIB" lo que me permitió solucionar el problema de compatibilidad con pequeños cambios, puesto que el ScanLine de Lazarus tambien devuelve todo el mapa desde la línea pedida.
 
En definitiva, tanto en Delphi como en Lazarus ScanLine te devuelven un puntero a la misma línea de la Imagen que se lee de izquierda a derecha. La única diferencia es cuando tratamos de interpretar todo el mapa desde el primer valor de puntero, En delphi haremos Bitmap.ScanLine[LastLine-1] y en Lazarus Bitmap.ScanLine[0] en ambos casos obtenemos un puntero al inicio de todo el mapa de bits que podremos tratar como un continuo.
 
No olvidar que al acabar una línea podemos tener Bytes de relleno para alinearla a DWORD, eso obliga a calcular el nº de bytes que contiene que en general se calcula así:


delphi
  1. Size:= ((Width * (BitCount / 8)) + 3) and $FFFFFFFC;
  2. // ó mejor con división binaria
  3. Size:= ((Width * (BitCount shl 3)) + 3) and $FFFFFFFC;

 Conocido esto, para saltar de una línea a la siguiente sin modificar el "valor de la coordenada x" incrementaremos el puntero así: inc(p, Size), obteniendo el mismo pixel una linea más arriba (delphi) o abajo (Lazarus).
 
 
Saludos.


  • 2

#9 Delphius

Delphius

    Advanced Member

  • Administrador
  • 6.295 mensajes
  • LocationArgentina

Escrito 16 enero 2017 - 08:29

Creo que ya lo estoy entendiendo.
Ahora estoy en modo AFK. Por la tarde cuando llegue a casa lo analizo mejor porque desde el celu no tengo como probar algunas cosas.
Si es que lo entendí bien, me interesa esa forma de trabajar. Podría mejorar un buen par de algoritmos de mis proyectos de visión artificial.

Luego te comento mis experiencias en un hilo aparte.

Gracias maestro por tus enseñanzas.

Saludos
  • 0

#10 Koalasoft

Koalasoft

    Advanced Member

  • Miembros
  • PipPipPip
  • 142 mensajes
  • LocationMéxico

Escrito 01 febrero 2017 - 12:47

[offtopic]

 

Los leo a todos y me quedo  :| !! .. no soy programador al 100% ya que mi especialidad en Adminstrador de Sistemas, pero espero algún día alcanzar sus niveles !! .. Felicidades ..  :ap:

 

[/offtopic]


  • 0

#11 Delphius

Delphius

    Advanced Member

  • Administrador
  • 6.295 mensajes
  • LocationArgentina

Escrito 01 febrero 2017 - 06:43

[offtopic]

 

Los leo a todos y me quedo  :| !! .. no soy programador al 100% ya que mi especialidad en Adminstrador de Sistemas, pero espero algún día alcanzar sus niveles !! .. Felicidades ..  :ap:

 

[/offtopic]

 

Somos varios los que hacemos cola para recibir clases del maestro escafandra. Yo soy alumno desde el primer día en que lo conocí en el foro.

 

Saludos,


  • 0




IP.Board spam blocked by CleanTalk.