youngnoviceinneedofhelp

Hi, I have this piece of visual basic code, that when set up correctly takes two images and compares their RGB values of each pixel to check whether they are the same image. All you need is a button called command1 ( i think).
But if i run it, and click the button i get runtime error '9' subscript out of range.
I am using excels visual basic editor at the moment until i can get a copy of real visual basic.
Here is the code:

Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Function VarPtr Lib "msvbvm50.dll" (Ptr As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (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 DeleteObject Lib "gdi32" (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 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 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 Type OffScreenDC
DC As Long
Object As IPictureDisp
End Type

Private MyPict1 As OffScreenDC
Private MyPict2 As OffScreenDC

Private Sub Form_Unload(Cancel As Integer)
DeleteDC MyPict1.DC
DeleteDC MyPict2.DC
Set MyPict1.Object = Nothing
Set MyPict2.Object = Nothing
End Sub

Private Sub Command1_Click()
LoadDCs MyPict1, "C:\1.bmp"
LoadDCs MyPict2, "C:\2.bmp"
MsgBox CompareDCs(MyPict1, MyPict2)
End Sub


Private Sub LoadDCs(ByRef MyPict As OffScreenDC, ByVal iFilename As String)
'Create compatible DC...
MyPict.DC = CreateCompatibleDC(0)

'Load bitmap...
Set MyPict.Object = LoadPicture(iFilename)
'Throw the Picture into the DC...
SelectObject MyPict.DC, MyPict.Object

' 'Paint the image to CHECK its been loaded...
' BitBlt Picture1.hdc, 0, 0, MyPict.Object.Width, MyPict.Object.Height, MyPict.DC, 0, 0, vbSrcCopy
' Picture1.Refresh
End Sub

Private Function CompareDCs(ByRef MyPict1 As OffScreenDC, ByRef MyPict2 As OffScreenDC) As Boolean
Dim i As Integer
Dim j As Integer
Dim pic1() As Byte
Dim pic2() As Byte
Dim sa1 As SAFEARRAY2D
Dim sa2 As SAFEARRAY2D
Dim bmp1 As BITMAP
Dim bmp2 As BITMAP
Dim sR As Integer, sG As Integer, sB As Integer

'First Pic...
'Pass the IPictureDisp object to get its details...
GetObjectAPI MyPict1.Object, Len(bmp1), bmp1

With sa1
.cbElements = 1
.cDims = 2
.Bounds(0).lLbound = 0
.Bounds(0).cElements = bmp1.bmHeight
.Bounds(1).lLbound = 0
.Bounds(1).cElements = bmp1.bmWidthBytes
.pvData = bmp1.bmBits
End With

'Links Pic1() to the picture in the DC, any changes
'made to Pic1() are seen in the picture in the DC...
CopyMemory ByVal VarPtrArray(pic1), VarPtr(sa1), 4

'Second Pic...
'Pass the IPictureDisp object to get its details...
GetObjectAPI MyPict2.Object, Len(bmp2), bmp2

With sa2
.cbElements = 1
.cDims = 2
.Bounds(0).lLbound = 0
.Bounds(0).cElements = bmp2.bmHeight
.Bounds(1).lLbound = 0
.Bounds(1).cElements = bmp2.bmWidthBytes
.pvData = bmp2.bmBits
End With

'Links Pic2() to the picture in the DC, any changes
'made to Pic2() are seen in the picture in the DC...
CopyMemory ByVal VarPtrArray(pic2), VarPtr(sa2), 4

CompareDCs = True
For i = 0 To UBound(pic1, 1) - 1 Step 3
For j = 0 To UBound(pic1, 2)
sR = pic1(i + 2, j) 'Get Red value for this pixel
sG = pic1(i + 1, j) 'Get Green value for this pixel
sB = pic1(i, j) 'Get Blue value for this pixel
If sR = pic2(i + 2, j) Then
'Red Matches
If sG = pic2(i + 1, j) Then
'Green Matches as well
If sB = pic1(i, j) Then
'Blue Matches as well
'[This Pixel is same color]

Else
'[Not Same]
CompareDCs = False
End If
Else
'[Not Same]
CompareDCs = False
End If
Else
'[Not Same]
CompareDCs = False
End If
Next
Next

'Clear the link...
CopyMemory ByVal VarPtrArray(pic1), 0&, 4
CopyMemory ByVal VarPtrArray(pic2), 0&, 4

End Function


But please can someone help me sort my problem.
Thanks
Alex

ReggaetonKing

you are going to hear this over and over again....Please use "code tags"!

__________________
I would love to change the world, but they won't give me the source code!

youngnoviceinneedofhelp

Sorry. Must remember

Ooble

If you're still looking for a free version of VB, you can get Visual Basic .NET for free from http://msdn.microsoft.com/vstudio/express/vb/. It's similar to VB, but not quite, though Microsoft have made it quite easy to ease yourself into it.

__________________
Me :: You :: Them