Zwei Bilder in Stücke aufteilen und Vergleichen z.b gut für Bild übertragung

    • VB.NET

      Zwei Bilder in Stücke aufteilen und Vergleichen z.b gut für Bild übertragung

      Hallo,

      Mit diesen Code kann man 2Bilder Vergleichen z.b (Einen Screenshot und ein äteres Desktop Bild)

      VB.NET-Quellcode

      1. Imports System.Drawing.Drawing2D
      2. Imports System.Drawing
      3. Imports System.Drawing.Imaging
      4. Imports System.Runtime
      6. Public Class Main
      7. Private rect As Rectangle
      8. Private rect2 As Rectangle
      9. Public Sub CheckImages(ByVal SourceImage As Image, ByVal TargetImage As Image, ByVal Part_width As Integer, ByVal Part_height As Integer)
      10. Dim i2 As Integer = 0
      11. For i As Integer = 0 To 10
      12. Dim CurrentBlock As Image = GetScreenRectangle(i, i2, SourceImage)
      13. rect2 = New Rectangle(i * Part_height, i2 * Part_width, Part_height, Part_width)
      14. Application.DoEvents()
      15. If Not modBitMapsEqual.IsEqual(CurrentBlock, GetScreenRectangle(i, i2, TargetImage)) = True Then
      16. ''IMAGE TEIL IST NICHT GLEICH!!!
      17. '' HIER EINÜGEN WAS PASSIEREN SOLL!
      18. End If
      19. If i = 10 AndAlso Not i2 = 10 Then
      20. i2 += 1
      21. i = 0
      22. End If
      23. Next
      24. End Sub
      26. Private Function GetScreenRectangle(ByVal xPos As Integer, ByVal yPos As Integer, ByVal SourceImage As Image)
      27. Dim Region As New Rectangle(xPos * 0, yPos * 0, 0, 0) ''BITTE HIER EURE GRÖßE EINTRAGEN Z,B ( xPos * 100, yPos * 100, 100 ,100)
      28. Return GetPicturePart(SourceImage, Region)
      29. End Function
      30. Private Function CaptureScreen() As Bitmap
      31. Dim b As New Bitmap(SystemInformation.VirtualScreen.Width, SystemInformation.VirtualScreen.Height)
      32. Dim g As Graphics = Graphics.FromImage(b)
      33. g.CopyFromScreen(0, 0, 0, 0, b.Size)
      34. g.Dispose()
      35. Return b
      36. End Function
      37. Private Function GetPicturePart(ByVal SourceImage As Image, ByVal Region As Rectangle) As Bitmap
      38. Dim ImagePart As Bitmap = New Bitmap(Region.Width, Region.Height)
      39. Using G As Graphics = Graphics.FromImage(ImagePart)
      40. Dim TargetRect As Rectangle = New Rectangle(0, 0, Region.Width, Region.Height)
      41. Dim SourceRect As Rectangle = Region
      42. G.DrawImage(SourceImage, TargetRect, SourceRect, GraphicsUnit.Pixel)
      43. End Using
      44. Return ImagePart
      45. End Function
      46. End Class


      Und das Module:

      VB.NET-Quellcode

      1. Option Strict On
      2. Option Explicit On
      3. Option Infer Off
      5. Imports System
      6. Imports System.Drawing ' Bitmap / Rectangle
      7. Imports System.Drawing.Imaging ' BitmapData / ImageLockMode
      8. Imports System.Runtime ' CompilerServices / InterOpServices
      10. Module modBitMapsEqual
      12. ''' <summary>
      13. ''' Ist in beiden Bitmap-Objekten das gleiche Bild enthalten?
      14. ''' (Kriterium: Alle Pixelwerte sind identisch)</summary>
      15. ''' <param name="bmp1">Erste Bitmap für Vergleich</param>
      16. ''' <param name="bmp2">Zweite Bitmap für Vergleich</param>
      17. ''' <returns>True, falls gleiches Bild, sonst False</returns>
      18. <CompilerServices.Extension()> _
      19. Public Function IsEqual(ByVal bmp1 As Bitmap, ByVal bmp2 As Bitmap) As Boolean
      21. Dim equal As Boolean = True ' für Pixelvergleich
      23. ' Sind zwei Bilder vorhanden?
      24. If bmp1 Is Nothing Or bmp2 Is Nothing Then Return False
      26. ' Gleiche Klassen-Instanz ---> gleiches Bild
      27. If Bitmap.ReferenceEquals(bmp1, bmp2) Then Return True
      29. ' Ungleiche Größe/Farbtiefe --> ungleiches Bild
      30. With bmp1
      31. If .Width <> bmp2.Width Then Return False
      32. If .Height <> bmp2.Height Then Return False
      33. If .PixelFormat <> bmp2.PixelFormat Then Return False
      34. End With
      37. ' Bei beiden Bitmaps alle Bild-Daten im Speicher sperren
      38. Dim rect As New Rectangle(0, 0, bmp1.Width, bmp1.Height)
      39. Dim bd1 As BitmapData = bmp1.LockBits(rect, ImageLockMode.ReadOnly, bmp1.PixelFormat)
      40. Dim bd2 As BitmapData = bmp2.LockBits(rect, ImageLockMode.ReadOnly, bmp2.PixelFormat)
      42. ' Gesamtzahl der Bild-Bytes per Scanbreite & Bildhöhe ermitteln
      43. Dim ByteZahl As Integer = bd1.Stride * bd1.Height
      45. ' Bitmap-Daten besorgen (Bytearray)
      46. Dim bmp1_bytes(ByteZahl - 1), bmp2_bytes(ByteZahl - 1) As Byte
      48. ' Die gesperrten Bilddaten in 2 Bytearrays kopieren
      49. InteropServices.Marshal.Copy(bd1.Scan0, bmp1_bytes, 0, ByteZahl)
      50. InteropServices.Marshal.Copy(bd2.Scan0, bmp2_bytes, 0, ByteZahl)
      52. ' Bitmap-Daten vergleichen
      53. For i As Integer = 0 To ByteZahl - 1
      54. If bmp1_bytes(i) <> bmp2_bytes(i) Then
      55. equal = False : Exit For
      56. End If
      57. Next i
      59. ' Daten und Ressourcen freigeben
      60. bmp1.UnlockBits(bd1) : bmp2.UnlockBits(bd2)
      62. ' Rückgabe
      63. Return equal
      64. End Function
      66. End Module


      damit kann man dan z.b für eine Bildübertragung benutzen ohne das ganze bild zuschicken.

      mfg vbler.

      Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „vbler“ ()