vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Brandneu! sevEingabe v3.0 - Das Eingabecontrol der Superlative!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2018
 
zurück
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:     [ Jetzt bewerten ]Views:  11.714 
ohne HomepageSystem:  Win2k, WinXP, Vista, Win7, Win8, Win10 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

Dieser Tipp wurde bereits 11.714 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


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.
 
   

Druckansicht Druckansicht Copyright ©2000-2018 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel