HI

I use this code to compare picturebox images. Problem is it is too slow. I want to compare two bitmaps and only give their paths and I only want them open in memory - then I want to compare,close, and move on to next images.

This is the problem part:

' Get the Bitmap Info of the first Picture
GetObject Pic1, Len(Bm1), Bm1

I want to do something like this:

' Get the Bitmap Info of the first .bmp file
GetObject myPicFile.InMemoryVersion, Len(Bm1), Bm1


Please help if you know how I can do this:


vbcode:

Private Type BitMap
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Function ComparePic(Pic1 As Picture, Pic2 As Picture) As Boolean
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 Pic1, Len(Bm1), Bm1

' Get the Bitmap Info of the second Picture
GetObject Pic2, 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
ComparePic = False
Exit Function
End If

' Get the bitmap data.
GetBitmapBits Pic1, bmHeight * bmWidthBytes, Bytes1(0, 0)
GetBitmapBits Pic2, bmHeight * 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 Bytes1(i, j) <> Bytes2(i, j) Then
ComparePic = False
Exit Function
End If
Next j
Next i

ComparePic = True
End Function

Private Sub Command1_Click()
If ComparePic(Picture1.Picture, Picture2.Picture) = True Then
MsgBox "They have the same Image!"
Else
MsgBox "They are different..."
End If
End Sub

Private Sub Command2_Click()
If ComparePic(Picture1.Picture, Picture3.Picture) = True Then
MsgBox "They have the same Image!"
Else
MsgBox "They are different..."
End If
End Sub

Private Sub Command3_Click()
If ComparePic(Picture3.Picture, Picture4.Picture) = True Then
MsgBox "They have the same Image!"
Else
MsgBox "They are different..."
End If
End Sub

Private Sub Command4_Click()
If ComparePic(Picture2.Picture, Picture3.Picture) = True Then
MsgBox "They have the same Image!"
Else
MsgBox "They are different..."
End If
End Sub