Rubrik: Grafik und Font · Bilder und Icons | VB-Versionen: VB2005, VB2008 | 05.02.09 |
Sind zwei Bilder gleich? Erweiterungsmethode für das Bitmap-Objekt, zur pixelgenauen Prüfung, ob zwei Bilder identisch sind. | ||
Autor: Manfred Bohn | Bewertung: | Views: 14.684 |
ohne Homepage | System: 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