[RESOLVED] How to compare images in VBA?

[JasonT]

Hi all

I need to compare to jpeg images and display the differences. This is what i have written but it does not work.



Private Declare Function GetPixel Lib "GDI32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "GDI32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Public Function Min(ByVal d1 As Integer, ByVal d2 As Integer) As Integer
Min = d1
If d2 < d1 Then Min = d2
End Function

Private Sub CommandButtonGenerate_Click()

' Load the images.

Dim RefPath As String
Dim StudPath As String

StudPath = CommonDialogDrawStudent.FileName
RefPath = CommonDialogDraw.FileName

ImageStud.Picture = LoadPicture(StudPath)
ImageRef.Picture = LoadPicture(RefPath)

' Make a difference image.
Dim wid As Integer
Dim hgt As Integer

wid = Min(ImageStud.Picture.Width, ImageRef.Picture.Width)
hgt = Min(ImageStud.Picture.Height, ImageRef.Picture.Height)

Dim x As Integer
Dim y As Integer

Dim ColourStud As Long
Dim ColourRef As Long
Dim Resultdiff As Long 'this is where the error comes in, but i couldnt figure it out

ImageDiff.Picture.Width = wid
ImageDiff.Picture.Height = hgt

ColourStud = ImageStud.Picture
ColourRef = ImageRef.Picture

Resultdiff = ImageDiff.Picture

For x = 0 To wid - 1
For y = 0 To hgt - 1

If GetPixel(ColourStud, x, y) = GetPixel(ColourRef, x, y) Then
SetPixel Resultdiff, x, y, &H0
Else
SetPixel Resultdiff, x, y, &HFF0000

End If
Next y
Next x

End Sub

[westconn1]

'this is where the error comes in, but i couldnt figure it out

what error?

[JasonT]

When the program runs to this line "ImageDiff.Picture.Width = wid"

The debugger will show this error message "Run-time error '91' Object Variable or With block varaible not set"

[westconn1]

"Run-time error '91' Object Variable or With block varaible not set"

indicates no picture
the width of the picture maybe read only
you can resize the image control, then use the picturesizemode to the size of the image control

[JasonT]

Hi

I tired to use a frame (called Frame1) instead of a image to store the differences. This time round, i get the errror "Run-time error '438'. Object does not supprot this method or property" when it runs to this line "SetPixel Frame1.hDC, x, y, &H0". How to use GetPixel, SetPixel? Thanks.


Private Declare Function GetPixel Lib "GDI32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "GDI32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Public Function Min(ByVal d1 As Integer, ByVal d2 As Integer) As Integer
Min = d1
If d2 < d1 Then Min = d2
End Function

Private Sub CommandButtonGenerate_Click()

' Load the images.

Dim RefPath As String
Dim StudPath As String

StudPath = CommonDialogDrawStudent.FileName
RefPath = CommonDialogDraw.FileName

ImageStud.Picture = LoadPicture(StudPath)
ImageRef.Picture = LoadPicture(RefPath)

' Make a difference image.
Dim wid As Integer
Dim hgt As Integer

wid = Min(ImageStud.Picture.Width, ImageRef.Picture.Width)
hgt = Min(ImageStud.Picture.Height, ImageRef.Picture.Height)

Dim x As Integer
Dim y As Integer

Dim ColourStud As Long
Dim ColourRef As Long


Frame1.Width = wid
Frame1.Height = hgt

ColourStud = ImageStud.Picture
ColourRef = ImageRef.Picture

For x = 0 To wid - 1
For y = 0 To hgt - 1

If GetPixel(ColourStud, x, y) = GetPixel(ColourRef, x, y) Then
SetPixel Frame1.hDC, x, y, &H0 ' here is the error
Else
SetPixel Frame1.hDC, x, y, &HFF0000

End If
Next y
Next x

End Sub

[westconn1]

frames are lightweight controls and do not have hdc, in fact i am not sure that any forms2 controls have hdc
you might have to try things like getDC API

[JasonT]

Hi

Would you elaborate on how to use getDC. Thank you.

[westconn1]

search in this forum, there have been examples by koolsid and others
if the search is still broken use google