vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Grafik und Font · Bilder und Icons   |   VB-Versionen: VB2005, VB200805.02.09
Sind zwei Bilder gleich?

Erweiterungsmethode für das Bitmap-Objekt, zur pixelgenauen Prüfung, ob zwei Bilder identisch sind.

Autor:   Manfred BohnBewertung:  Views:  14.684 
ohne HomepageSystem:  Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Um festzustellen, ob zwei Bilddateien das (exakt) gleiche Bild enthalten, kann man die Bilder in Bitmap-Objekte laden und einen Pixelvergleich durchführen.

Zu beachten ist dabei, dass jede Bildbearbeitung (Komprimierung, Formatierung, Aufhellung o.ä.) die Bildpixel ändert - selbst wenn für das Auge die Bilder noch identisch erscheinen.

VB 2008

Um die Erweiterungsmethode 'IsEqual' für das Bitmap-Objekt verwenden zu können, ist nur das Modul dem Projekt hinzuzufügen (ab VB 2008).

Aufrufbeispiel:

With My.Computer.FileSystem.SpecialDirectories
  Dim pic1 As New Drawing.Bitmap(.MyPictures & "\pic1.jpg")
  Dim pic2 As New Drawing.Bitmap(.MyPictures & "\pic2.jpg")
 
  If pic1.IsEqual(pic2) Then
    MsgBox("Die Bildpixel sind identisch")
  Else
    MsgBox("Die Bildpixel sind NICHT identisch")
  End If
End With
Option Strict On
Option Explicit On
Option Infer Off
 
Imports System
Imports System.Drawing ' Bitmap / Rectangle
Imports System.Drawing.Imaging ' BitmapData / ImageLockMode
Imports System.Runtime ' CompilerServices / InterOpServices
 
Module modBitMapsEqual
 
  ''' <summary>
  ''' Ist in beiden Bitmap-Objekten das gleiche Bild enthalten?
  ''' (Kriterium: Alle Pixelwerte sind identisch)</summary>
  ''' <param name="bmp1">Erste Bitmap für Vergleich</param>
  ''' <param name="bmp2">Zweite Bitmap für Vergleich</param>
  ''' <returns>True, falls gleiches Bild, sonst False</returns>
  <CompilerServices.Extension()> _
  Public Function IsEqual(ByVal bmp1 As Bitmap, ByVal bmp2 As Bitmap) As Boolean
 
    Dim equal As Boolean = True ' für Pixelvergleich
 
    ' Sind zwei Bilder vorhanden?
    If bmp1 Is Nothing Or bmp2 Is Nothing Then Return False
 
    ' Gleiche Klassen-Instanz ---> gleiches Bild
    If Bitmap.ReferenceEquals(bmp1, bmp2) Then Return True
 
    ' Ungleiche Größe/Farbtiefe --> ungleiches Bild
    With bmp1
      If .Width <> bmp2.Width Then Return False
      If .Height <> bmp2.Height Then Return False
      If .PixelFormat <> bmp2.PixelFormat Then Return False
    End With
 
 
    ' Bei beiden Bitmaps alle Bild-Daten im Speicher sperren
    Dim rect As New Rectangle(0, 0, bmp1.Width, bmp1.Height)
    Dim bd1 As BitmapData = bmp1.LockBits(rect, ImageLockMode.ReadOnly, bmp1.PixelFormat)
    Dim bd2 As BitmapData = bmp2.LockBits(rect, ImageLockMode.ReadOnly, bmp2.PixelFormat)
 
    ' Gesamtzahl der Bild-Bytes per Scanbreite & Bildhöhe ermitteln
    Dim ByteZahl As Integer = bd1.Stride * bd1.Height
 
    ' Bitmap-Daten besorgen (Bytearray)
    Dim bmp1_bytes(ByteZahl - 1), bmp2_bytes(ByteZahl - 1) As Byte
 
    ' Die gesperrten Bilddaten in 2 Bytearrays kopieren
    InteropServices.Marshal.Copy(bd1.Scan0, bmp1_bytes, 0, ByteZahl)
    InteropServices.Marshal.Copy(bd2.Scan0, bmp2_bytes, 0, ByteZahl)
 
    ' Bitmap-Daten vergleichen
    For i As Integer = 0 To ByteZahl - 1
      If bmp1_bytes(i) <> bmp2_bytes(i) Then
        equal = False : Exit For
      End If
    Next i
 
    ' Daten und Ressourcen freigeben
    bmp1.UnlockBits(bd1) : bmp2.UnlockBits(bd2)
 
    ' Rückgabe
    Return equal
  End Function
 
End Module 

VB 2005

Unter VB2005 werden Erweiterungsmethoden (Extensions) noch nicht unterstützt. Jedoch lässt sich obiger Code sehr einfach anpassen und somit auch unter VB2005 einsetzen.

Änderungen am Modul "modBitMapEqual"

Option Strict On
Option Explicit On
 
Imports System
Imports System.Drawing ' Bitmap / Rectangle
Imports System.Drawing.Imaging ' BitmapData / ImageLockMode
Imports System.Runtime ' CompilerServices / InterOpServices
 
Module modBitMapsEqual
 
  ''' <summary>
  ''' Ist in beiden Bitmap-Objekten das gleiche Bild enthalten?
  ''' (Kriterium: Alle Pixelwerte sind identisch)</summary>
  ''' <param name="bmp1">Erste Bitmap für Vergleich</param>
  ''' <param name="bmp2">Zweite Bitmap für Vergleich</param>
  ''' <returns>True, falls gleiches Bild, sonst False</returns>
  Public Function BmpIsEqual(ByVal bmp1 As Bitmap, ByVal bmp2 As Bitmap) As Boolean
    ...

Aufrufbeispiel:

With My.Computer.FileSystem.SpecialDirectories
  Dim pic1 As New Drawing.Bitmap(.MyPictures & "\pic1.jpg")
  Dim pic2 As New Drawing.Bitmap(.MyPictures & "\pic2.jpg")
 
  If BmpIsEqual(pic1, pic2) Then
    MsgBox("Die Bildpixel sind identisch")
  Else
    MsgBox("Die Bildpixel sind NICHT identisch")
  End If
End With



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
 
Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.