Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0804: Schneller Bildvergleich

 von 

Beschreibung 

Der Code erlaubt den schnellen Vergleich zweier Bilder. Es wird eine Aussage darüber gemacht, ob die Bilder gleich sind oder nicht. Die Funktion PictureCompare erwartet jeweils die Handle der zu vergleichenden Bilder.
Wenn sich das Bild in einem Image-Control befindet, ergibt sich das Handle wie folgt:
Hndl = Image1.Picture.Handle

Wenn sich das Bild in der Picture-Eigenschaft einer Picturebox befindet dann so:
Hndl = Picture1.Picture.Handle

Wenn das Bild in einer Variablen vom Typ StdPicture liegt, wird das Handle so ermittelt:
Hndl = Variablenname.Handle

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

RtlCompareMemory (CompareMemory), GetObjectA (GetObjectAPI)

Download:

Download des Beispielprojektes [33,29 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Schaltfläche "Command3"
' Steuerelement: Anzeige-Steuerelement "Image3"
' Steuerelement: Anzeige-Steuerelement "Image2"
' Steuerelement: Anzeige-Steuerelement "Image1"
Option Explicit

Private Sub Form_Load()
  
  Dim i As Long, Breite As Long, Hoehe As Long
  
  ' Bilder laden
  For i = 1 To 3
    With Me.Controls("Image" & CStr(i))
      Set .Picture = LoadPicture(App.Path & "\Bild" & IIf(i = 3, "2", "1") & ".jpeg")
      Breite = Int(0.5 + Me.ScaleX(.Picture.Width, vbHimetric, vbPixels))
      Hoehe = Int(0.5 + Me.ScaleY(.Picture.Height, vbHimetric, vbPixels))
      .ToolTipText = CStr(Breite) & " " & Chr$(215) & Str$(Hoehe)
    End With
  Next i
  
  Command1.Caption = "<-" & vbCr & "Vergleich" & vbCr & "->"
  Command2.Caption = Command1.Caption
  
End Sub

Private Sub Command1_Click()
  ' Bild von Image1 und Image2 vergleichen
  
  If PictureCompare(Image1.Picture.Handle, Image2.Picture.Handle) = True Then
    MsgBox "Die Bilder sind gleich.", vbOKOnly + vbInformation, Me.Caption
  Else
    MsgBox "Die Bilder sind verschieden.", vbOKOnly + vbInformation, Me.Caption
  End If
    
End Sub

Private Sub Command2_Click()
  ' Bild von Image2 und Image3 vergleichen
  
  If PictureCompare(Image2.Picture.Handle, Image3.Picture.Handle) = True Then
    MsgBox "Die Bilder sind gleich.", vbOKOnly + vbInformation, Me.Caption
  Else
    MsgBox "Die Bilder sind verschieden.", vbOKOnly + vbInformation, Me.Caption
  End If

End Sub

Private Sub Command3_Click()
  ' Beenden
  
  Unload Me

End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------
' Bildvergleich
' Copyright © 2013 by Zardoz

Option Explicit

Private Type BITMAP
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Integer
  bmBitsPixel As Integer
  bmBits As Long
End Type

Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function CompareMemory Lib "ntdll.dll" Alias "RtlCompareMemory" (ByVal Source1 As Any, ByVal Source2 As Any, ByVal Length As Long) As Long

Public Function PictureCompare(Handle1 As Long, Handle2 As Long) As Boolean
  ' Zwei Bilder auf Gleichheit prüfen
  
  Dim MapInfo1 As BITMAP, MapInfo2 As BITMAP, NBytes As Long
  
  PictureCompare = False
  If Handle1 = 0 Or Handle2 = 0 Then
    MsgBox "Error: Handle = 0", vbOKOnly + vbExclamation, App.Title
    Exit Function
  End If
  
  ' Bildinfos holen
  Call GetObjectAPI(Handle1, Len(MapInfo1), MapInfo1)
  Call GetObjectAPI(Handle2, Len(MapInfo2), MapInfo2)
  
  With MapInfo1
    ' Breite und Höhe vergleichen
    If .bmWidth = MapInfo2.bmWidth And .bmHeight = MapInfo2.bmHeight Then
      NBytes = .bmHeight * .bmWidthBytes ' Anzahl Bytes
      ' Bilddaten vergleichen
      PictureCompare = (CompareMemory(.bmBits, MapInfo2.bmBits, NBytes) = NBytes)
    End If
  End With
  
End Function
'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.