Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0804: Schneller Bildvergleich

VB 5/6-Tipp 0804: Schneller Bildvergleich

 von Zardoz

Schwierigkeitsgrad:

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 --------------