(11-19-2022, 12:22 AM)bplus Wrote:Quote:What was that memory method again?
From Steves example from which I made my comparison sub.
Who is mn accusing of cheating?
Point works with Alpha, I am pretty sure!
Wiki:
Update: I did some testing with alpha channels,
and it does NOT seem to detect a difference!
See test below!
PS Maybe _MEM method will work for alpha values?
Code: (Select All)
' ?????????????????????????????????????????????????????????????????????????????
' HOW MIGHT WE EFFICIENTLY COMPARE TWO IMAGES?
' ?????????????????????????????????????????????????????????????????????????????
Const FALSE = 0
Const TRUE = Not FALSE
' DO TEST
CompareImagesTest
' CLEAR IMAGES
Screen 0
System
' /////////////////////////////////////////////////////////////////////////////
Sub CompareImagesTest ()
Dim image1&
Dim image2&
Screen _NewImage(1024, 768, 32)
image1& = _NewImage(100, 100, 32)
image2& = _NewImage(100, 100, 32)
DrawSquare image1&, 10, 10, 80, cRed, cBlue
DrawSquare image2&, 10, 10, 80, cRed, cYellow
CompareNext image1&, image2&, "obviously different"
_Dest image2&
Paint (55, 85), cBlue, cRed
CompareNext image1&, image2&, "does it match?"
_Dest image1&
DrawSquare image1&, 20, 20, 10, cLime, cBlue
CompareNext image1&, image2&, "definitely different"
_Dest image1&
DrawSquare image1&, 20, 20, 10, cBlue, cBlue
CompareNext image1&, image2&, "does it match?"
_Dest image2&
Line (50, 50)-(50, 50), cWhite, , 65535
CompareNext image1&, image2&, "ONE PIXEL DIFFERENT!"
_Dest image2&
Line (50, 50)-(50, 50), cBlue, , 65535
CompareNext image1&, image2&, "does it match?"
' -----------------------------------------------------------------------------
' COMPARE ALPHA CHANNELS
_Dest image1&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 255), , 65535
_Dest image2&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0), , 65535
CompareNext image1&, image2&, "one pixel different: red alpha=255 vs red no alpha"
_Dest image1&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 254), , 65535
_Dest image2&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0), , 65535
CompareNext image1&, image2&, "one pixel different: red alpha=254 vs red no alpha"
_Dest image1&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 253), , 65535
_Dest image2&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0), , 65535
CompareNext image1&, image2&, "one pixel different: red alpha=253 vs red no alpha"
_Dest image1&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 255), , 65535
_Dest image2&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 254), , 65535
CompareNext image1&, image2&, "one pixel different: red alpha=255 vs red alpha=254"
_Dest image1&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 255), , 65535
_Dest image2&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 253), , 65535
CompareNext image1&, image2&, "one pixel different: red alpha=255 vs red alpha=253"
_Dest image1&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 254), , 65535
_Dest image2&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 253), , 65535
CompareNext image1&, image2&, "one pixel different: red alpha=254 vs red alpha=253"
_Dest image1&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 254), , 65535
_Dest image2&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 252), , 65535
CompareNext image1&, image2&, "one pixel different: red alpha=254 vs red alpha=252"
_Dest image1&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 253), , 65535
_Dest image2&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 252), , 65535
CompareNext image1&, image2&, "one pixel different: red alpha=253 vs red alpha=252"
_Dest image1&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 253), , 65535
_Dest image2&
Line (50, 50)-(50, 50), _RGB32(255, 0, 0, 251), , 65535
CompareNext image1&, image2&, "one pixel different: red alpha=253 vs red alpha=251"
' -----------------------------------------------------------------------------
' COMPARE REGULAR COLORS AGAIN JUST TO BE SURE...
_Dest image1&
Line (50, 50)-(50, 50), cBlack, , 65535
_Dest image2&
Line (50, 50)-(50, 50), cWhite, , 65535
CompareNext image1&, image2&, "ONE PIXEL DIFFERENT!"
_Dest image2&
Line (50, 50)-(50, 50), cBlack, , 65535
CompareNext image1&, image2&, "does it match?"
' -----------------------------------------------------------------------------
' CLEANUP
If image1& < -1 Then _FreeImage image1&
If image2& < -1 Then _FreeImage image2&
End Sub ' CompareImagesTest
' /////////////////////////////////////////////////////////////////////////////
Sub CompareNext (image1&, image2&, comment$)
Dim bResult1%
Dim bResult2%
' COMAPRE IMAGES
bResult1% = CompareImagesSquish%(image1&, image2&)
bResult2% = CompareImagesBPlus%(image1&, image2&)
' SHOW IMAGES
_Dest 0: Cls , cBlack
_PutImage (100, 100), image1&, 0
_PutImage (300, 100), image2&, 0
' SHOW RESULTS #1
If bResult1% = TRUE Then
DrawEqual 200, 100, cWhite
Else
DrawNot 200, 100, cWhite
DrawEqual 200, 100, cWhite
End If
' WAIT FOR USER
Locate 3, 1: Print comment$
Locate 5, 1: Print "RESULTS FOR CompareImagesSquish%"
Locate 15, 1: Print "PRESS ANY KEY TO CONTINUE": Sleep
' SHOW RESULTS #2
If bResult2% = TRUE Then
DrawEqual 200, 100, cRed
Else
DrawNot 200, 100, cRed
DrawEqual 200, 100, cRed
End If
' WAIT FOR USER
Locate 5, 1: Print "RESULTS FOR CompareImagesBPlus%"
Locate 15, 1: Print "PRESS ANY KEY TO CONTINUE": Sleep
End Sub ' CompareNext
' /////////////////////////////////////////////////////////////////////////////
' FROM: bplus
' https://qb64phoenix.com/forum/showthread.php?tid=1151&pid=10242#pid10242
' Well my idea didn't take so long for one compare, just blink and there's your answer:
' Not nearly as quick as memory methods though.
' b = b + ...
Function CompareImagesBPlus% (handle1 As Long, handle2 As Long)
Dim bResult%: bResult% = TRUE
Dim p1 As _Unsigned Long
Dim y, x As Integer
Dim bFinished%: bFinished% = FALSE
For y = 0 To _Height(handle1) - 1
For x = 0 To _Width(handle1) - 1
_Source handle1
p1 = Point(x, y)
_Source handle2
If Point(x, y) <> p1 Then
bResult% = FALSE
bFinished% = FALSE
Exit For
End If
Next x
If bFinished% = TRUE Then Exit For
Next y
CompareImagesBPlus% = bResult%
End Function ' CompareImagesBPlus%
' /////////////////////////////////////////////////////////////////////////////
' James D Jarvis
' https://qb64phoenix.com/forum/showthread.php?tid=1151&page=2
' squish the two images down to a really small image.
' If they don't match when they are 2 by 2 pixels they sure aren't
' going to match when they are say 200 by 200 pixels.
' if it matches keep comparing pixels by pixel in slightly larger
' scaled image until back up to original size.
Function CompareImagesSquish% (image1&, image2&)
Dim bResult%
Dim iDiffCount%
Dim iThreshold%
Dim iPassNum%
Dim xMax%
Dim yMax%
Dim pic1&
Dim pic2&
Dim px%
Dim py%
Dim color1~&
Dim color2~&
Dim bFinished%
bResult% = TRUE
bFinished% = FALSE
iDiffCount% = 0
iThreshold% = 2
iPassNum% = 0
For xMax% = 2 To _Width(image1&) Step 10
iPassNum% = iPassNum% + 1
'Locate 1, 1: Print iPassNum% ' this really just gives you something to look at
For yMax% = 2 To _Height(image1&) Step 10
pic1& = _NewImage(xMax%, yMax%)
pic2& = _NewImage(xMax%, yMax%)
_PutImage (0, 0)-(xMax%, yMax%), image1&, pic1&, (0, 0)-(_Width(image1&), _Height(image1&))
_PutImage (0, 0)-(xMax%, yMax%), image2&, pic2&, (0, 0)-(_Width(image2&), _Height(image2&))
For py% = 1 To yMax%
For px% = 1 To xMax%
_Source pic1&: color1 = Point(px%, py%)
_Source pic2&: color2 = Point(px%, py%)
If color1 <> color2 Then
iDiffCount% = iDiffCount% + 1
If iDiffCount% >= iThreshold% Then
bResult% = FALSE
bFinished% = TRUE
Exit For
End If
End If
Next px%
If bFinished% = TRUE Then Exit For
Next py%
If bFinished% = TRUE Then Exit For
Next yMax%
Next xMax%
' CLEANUP
If pic1& < -1 Then _FreeImage pic1&
If pic2& < -1 Then _FreeImage pic2&
CompareImagesSquish% = bResult%
End Function ' CompareImagesSquish%
' /////////////////////////////////////////////////////////////////////////////
Sub DrawSquare (img&, x1%, y1%, size%, fgcolor~&, bgcolor~&)
Dim x2%, y2%
If img& < -1 Then
_Dest img& ': Cls , cEmpty
x2% = (x1% + size%) - 1
y2% = (y1% + size%) - 1
Line (x1%, y1%)-(x2%, y1%), fgcolor~&, , 65535
Line (x2%, y1%)-(x2%, y2%), fgcolor~&, , 65535
Line (x2%, y2%)-(x1%, y2%), fgcolor~&, , 65535
Line (x1%, y2%)-(x1%, y1%), fgcolor~&, , 65535
If bgcolor~& <> cEmpty Then
'PAINT [STEP] (column%, row%), fillColor[, borderColor%]
Paint (x1% + 1, y1% + 1), bgcolor~&, fgcolor~&
End If
End If
End Sub ' Draw Square
' /////////////////////////////////////////////////////////////////////////////
Sub DrawEqual (x%, y%, MyColor~&)
Dim x1%, y1%, x2%, y2%
_Dest 0
' = (equal)
x1% = (x% + 30) + 0: y1% = (y% + 30) + 0
x2% = (x% + 70) - 1: y2% = (y% + 70) - 1
Line (x1%, y1%)-(x2%, y1%), MyColor~&, , 65535
Line (x1%, y2%)-(x2%, y2%), MyColor~&, , 65535
End Sub ' DrawEqual
' /////////////////////////////////////////////////////////////////////////////
Sub DrawNot (x%, y%, MyColor~&)
Dim x1%, y1%, x2%, y2%
_Dest 0
' ! (not)
x1% = (x% + 10) + 0: y1% = (y% + 10) + 0
x2% = x1%: y2% = (y% + 75) - 1
Line (x1%, y1%)-(x2%, y2%), MyColor~&, , 65535
x1% = (x% + 10) + 0: y1% = (y% + 85) + 0
x2% = x1%: y2% = (y% + 90) - 1
Line (x1%, y1%)-(x2%, y2%), MyColor~&, , 65535
End Sub ' DrawNotEqual
' /////////////////////////////////////////////////////////////////////////////
Function cBlack~& ()
cBlack = _RGB32(0, 0, 0)
End Function ' cBlack~&
Function cGray~& ()
cGray = _RGB32(128, 128, 128)
End Function ' cGray~&
Function cWhite~& ()
cWhite = _RGB32(255, 255, 255)
End Function ' cWhite~&
Function cRed~& ()
cRed = _RGB32(255, 0, 0)
End Function
Function cOrange~& ()
cOrange = _RGB32(255, 165, 0)
End Function ' cOrange~&
Function cYellow~& ()
cYellow = _RGB32(255, 255, 0)
End Function ' cYellow~&
Function cLime~& ()
cLime = _RGB32(0, 255, 0)
End Function ' cLime~&
Function cCyan~& ()
cCyan = _RGB32(0, 255, 255)
End Function ' cCyan~&
Function cBlue~& ()
cBlue = _RGB32(0, 0, 255)
End Function ' cBlue~&
Function cPurple~& ()
cPurple = _RGB32(128, 0, 255)
End Function ' cPurple~&
Function cMagenta~& ()
cMagenta = _RGB32(255, 0, 255)
End Function ' cMagenta~&
Function cEmpty~& ()
cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&