¡Hola!
Estoy intentado hacer una aplicacion que compara 2 imágenes. El problema que tengo es que recorto una cachito de ambas y las comparo, y al parecer, cuando cargo el cacho en el control picture/image, aunque se muestra correctamente, me da la sensación de que compara vacio con vacio, y por eso siempre me dice que son iguales.
Este es el código del programa:
picEsperada.Cls
picCapturada.Cls
picEsperadaDetalle.Cls
picCapturadaDetalle.Cls
picEsperada = LoadPicture(rutaInicio & parametros(1))
picCapturada = LoadPicture(rutaInicio & parametros(1) & ".cap")
picEsperada.Refresh
picCapturada.Refresh
'recorta un cacho de 10x10 pixeles desde la esquina superior izquierda
picEsperadaDetalle.PaintPicture picEsperada.Picture, 0, 0, , , 0, 0, 10, 10
picCapturadaDetalle.PaintPicture picCapturada.Picture, 0, 0, , , 0, 0, 10, 10
picEsperadaDetalle.Refresh
picCapturadaDetalle.Refresh
iguales = ComparaImagen(picCapturadaDetalle.Picture, picEsperadaDetalle.Picture)
If iguales = False Then
msgbox "distintas"
End If
Y éste es el código de la función que compara:
Public Function ComparaImagen(Pic1 As Picture, Pic2 As Picture) As Boolean
Dim i, j As Integer
Dim Bm1 As BitMap
Dim Bm2 As BitMap
Dim Bytes1() As Byte
Dim Bytes2() As Byte
' Get the Bitmap Info of the first Picture
GetObject picCapturada, Len(Bm1), Bm1
' Get the Bitmap Info of the second Picture
GetObject picEsperada, Len(Bm2), Bm2
' Allocate space for the bitmap data.
ReDim Bytes1(0 To Bm1.bmWidthBytes - 1, 0 To Bm1.bmHeight - 1)
ReDim Bytes2(0 To Bm2.bmWidthBytes - 1, 0 To Bm2.bmHeight - 1)
If (UBound(Bytes1, 1) <> UBound(Bytes2, 1)) Or (UBound(Bytes1, 2) <> UBound(Bytes2, 2)) Then
ComparaImagen = False
Exit Function
End If
' Get the bitmap data.
GetBitmapBits Pic1, Bm1.bmHeight * Bm1.bmWidthBytes, Bytes1(0, 0)
GetBitmapBits Pic2, Bm2.bmHeight * Bm2.bmWidthBytes, Bytes2(0, 0)
'Compare the Colors of Each Byte
For i = LBound(Bytes1, 1) To UBound(Bytes1, 1)
For j = LBound(Bytes1, 2) To UBound(Bytes1, 2)
'If the color is different
If Bytes1(i, j) <> Bytes2(i, j) Then
ComparaImagen = False
Exit Function
End If
Next j
Next i
ComparaImagen = True
End Function
Public Function final()
End Function
Así que a ver si alguien conoce otro modo de cargar las imágenes que no sea con paintpicture. O algun modo de comparar las imágenes sin necesidad de cargarlas en un formulario/picture/image.
Saludos
