ImageChecksum - Überprüfen, ob 2 Bilder ähnlich sind

[BlackFish]

Simples Verfahrens um zu überprüfen, ob zwei Bilder ähnlich sind.
Die Prozedur gibt eine 192 Bit Prüfsumme zurück, die mit anderen Prüfsummen auf Ähnlichkeit verglichen werden kann (man kann zählen wieviel Bits unterschiedlich sind).
Im Gegensatz zu einer Hash-Prüfsumme gibt die Prozedur eine ähnliche Prüfsumme zurück, wenn die beiden Bilder ähnlich sind.
Die beiden Bilder können dabei unterschiedliche Größen, Qualität, Helligkeit, Kontrast, Sättigung, Farbton, Rauschen haben und werden dennoch als gleich oder ähnlich gewertet (nur wenige Bits sind anderst).
Gedrehte/Gespiegelte Bilder werden momentan nicht erkannt.

Code: Alles auswählen

;AUTHOR:  codeprof
;LICENSE: PUBLIC DOMAIN (can be used without any restriction)

Procedure.s ImageChecksum(image)
  Protected Dim v.i(7,7,1,1)
  Protected img, x, y, c, checksum.s = ""
  img = CopyImage(image,#PB_Any)
  If IsImage(img)
    ResizeImage(img, 64, 64, #PB_Image_Smooth)
    
    StartDrawing(ImageOutput(img))
    For x = 0 To 63
      For y = 0 To 63
        c = Point(x,y)
        v(x >> 3,y >> 3, (x >> 2) & 1 , (y >> 2) & 1 ) + (Red(c) * 3) + (Green(c) * 6) + Blue(c)
      Next
    Next
    StopDrawing()
    For x=0 To 7
      For y=0 To 7
        ;+-
        ;+-            
        If (v(x,y,0,0) + v(x,y,0,1)) - (v(x,y,1,0) + v(x,y,1,1)) > 0
          checksum + "1"
        Else
          checksum + "0"
        EndIf    
        ;++
        ;--
        If (v(x,y,0,0) + v(x,y,1,0)) - (v(x,y,0,1) + v(x,y,1,1)) >= 0
          checksum + "1"
        Else
          checksum + "0"
        EndIf        
        ;+-
        ;-+
        If (v(x,y,0,0) + v(x,y,1,1)) - (v(x,y,0,1) + v(x,y,1,0)) >= 0
          checksum + "1"
        Else
          checksum + "0"
        EndIf    
      Next
    Next
    FreeImage(img)
  EndIf    
  ProcedureReturn checksum
EndProcedure  

Procedure ImageChecksumError(checksum1.s, checksum2.s)
  Protected error = 0
  For i = 1 To 192
    If Mid(checksum1, i, 1) <> Mid(checksum2, i, 1):error+1:EndIf
  Next  
  ProcedureReturn error
EndProcedure




;Example:

UseJPEGImageDecoder()


LoadImage(1,"D:\testbilder\image1.jpg")
LoadImage(2,"D:\testbilder\image2.jpg")

Debug ImageChecksum(1)
Debug ImageChecksum(2)

If ImageChecksumError(ImageChecksum(1),ImageChecksum(2)) <= 8
  Debug "Pictures are similar"
Else
  Debug "Pictures are not similar"
EndIf  

[Karl]

Hallo,

berechne doch z. B. die Histogramme und vergleiche diese. Dann kannst du dir das fatale Resizing ersparen. Gedreht und gespiegelt ist dann mit abgedeckt.

Ab wann sind denn bei dir die Bilder als ähnlich zu betrachten?

Gruß Karl