Find bitmap in bitmap

[Flaming Idiots]

I am going to work on adding support for masks, but it will be a lot slower. I am going to include a sample project with this to show how it works.

Public NotInheritable Class ImageScanner

    Public Shared Function FindBitmap(ByVal Haystack As Bitmap, ByVal Needle As Bitmap, Optional ByVal ShowDebug As Boolean = False) As Rectangle()
        Dim HaystackStride As Integer = 0
        Dim HaystackBPP As Integer = 0
        Dim HaystackData As String = BitmapToString(Haystack, New Rectangle(0, 0, Haystack.Width, Haystack.Height), HaystackStride, HaystackBPP)
        Dim NeedleStride As Integer = 0
        Dim NeedleBPP As Integer = 0
        Dim NeedleData As String = BitmapToString(Needle, New Rectangle(0, 0, Needle.Width, Needle.Height), NeedleStride, NeedleBPP)
        Dim ReturnList As New List(Of Rectangle)
        For Y As Integer = 0 To Haystack.Height - Needle.Height
            For X As Integer = 0 To Haystack.Width - Needle.Width
                If GetPixelFromString(HaystackData, New Point(X, Y), HaystackStride, HaystackBPP).ToArgb <> _
                GetPixelFromString(NeedleData, New Point(0, 0), NeedleStride, NeedleBPP).ToArgb Then Continue For
                If ShowDebug Then Debug.WriteLine(New Point(X, Y).ToString)
                Dim ChildCompare As Image = Haystack.Clone(New Rectangle(X, Y, Needle.Width, Needle.Height), Imaging.PixelFormat.Format24bppRgb)
                If BitmapToString(ChildCompare, New Rectangle(0, 0, Needle.Width, Needle.Height), 0, 0) = NeedleData Then
                    ReturnList.Add(New Rectangle(X, Y, Needle.Width, Needle.Height))
                End If
                ChildCompare.Dispose()
            Next
        Next
        Return ReturnList.ToArray
    End Function

    Private Shared Function GetPixelFromString(ByVal S As String, ByVal P As Point, _
    ByVal Stride As Long, ByVal BPP As Integer) As Color
        Dim StartPos As Long = (Stride * P.Y) + (BPP * P.X)
        Dim BChar As Char = S(StartPos + 0)
        Dim GChar As Char = S(StartPos + 1)
        Dim RChar As Char = S(StartPos + 2)
        Return Color.FromArgb(Asc(RChar), Asc(GChar), Asc(BChar))
    End Function

    Private Shared Function BitmapToString(ByVal Image As Bitmap, ByVal Bounds As Rectangle, ByRef Stride As Integer, ByRef BPP As Integer) As String
        Dim BitmapData As Imaging.BitmapData = Image.LockBits(Bounds, Imaging.ImageLockMode.ReadOnly, Imaging.PixelFormat.Format24bppRgb)
        BPP = (BitmapData.Stride - 1) / BitmapData.Width
        Stride = BitmapData.Stride
        Dim ImageData As String = Runtime.InteropServices.Marshal.PtrToStringAnsi(BitmapData.Scan0, BitmapData.Stride * BitmapData.Height)
        Image.UnlockBits(BitmapData)
        Return ImageData
    End Function

End Class

In the example, it took 4 seconds to find a 56x96 image in a 591x640 image.

Here is the sample: Clicky

 

[Cheeter]

The link is down. Could I have the sample?
Or could someone explain how to use this class. I'm kinda a beginner at some points in VB. I can't figure out how to use a class without some guidelines

 

[Flaming Idiots]

That code is old and slow. I rewrote it and made it about 4-5 times faster.

Here is a sample that takes a snapshot of the screen, and finds the image:

Private Sub FindBitmap() Handles Button1.Click
    Dim Target = My.Resources.photoshop_icon
    Dim ScreenBounds = Screen.PrimaryScreen.Bounds
    Dim Source = New Bitmap(ScreenBounds.Width, ScreenBounds.Height, Imaging.PixelFormat.Format32bppArgb)
    Using Gfx = Graphics.FromImage(Source)
        Gfx.CopyFromScreen(Nothing, Nothing, ScreenBounds.Size)
    End Using
    Dim Result = Source.FindBitmap(Target)
    Debug.WriteLine(If(Result.HasValue, "Found bitmap at: " & Result.Value.ToString, "Could not find bitmap."))
End Sub

Here is the source for the bitmap finder.

Public Module ImageScanner

    Private Const BytesPerPixel As Integer = 3

    <System.Runtime.CompilerServices.Extension()> _
    Public Function FindBitmap(ByVal Source As Bitmap, ByVal Target As Bitmap) As Rectangle?
        Return Source.FindBitmap(New Rectangle(Nothing, Source.Size), Target)
    End Function

    <System.Runtime.CompilerServices.Extension()> _
    Public Function FindBitmap(ByVal Source As Bitmap, ByVal Area As Rectangle, ByVal Target As Bitmap) As Rectangle?
        Dim SourceData As Imaging.BitmapData = Nothing
        Dim SourceBytes = Source.GetBitmapData(New Rectangle(0, 0, Source.Width, Source.Height), SourceData)

        Dim TargetData As Imaging.BitmapData = Nothing
        Dim TargetBytes = Target.GetBitmapData(New Rectangle(0, 0, Target.Width, Target.Height), TargetData)

        Dim FirstTargetPixel = TargetBytes.GetPixelFromArray(Nothing, TargetData).ToArgb
        Dim TargetSection = TargetBytes.GetSection(New Rectangle(0, 0, Target.Width, Target.Height), TargetData)

        For Y = Area.Top To Area.Bottom - Target.Height
            For X = Area.Left To Area.Right - Target.Width
                If SourceBytes.GetPixelFromArray(New Point(X, Y), SourceData).ToArgb <> FirstTargetPixel Then Continue For
                Dim SectionBounds = New Rectangle(X, Y, Target.Width, Target.Height)
                Dim Section = SourceBytes.GetSection(SectionBounds, SourceData)
                If CompareByteArray(Section, TargetSection) Then Return SectionBounds
        Next X, Y
        Return Nothing
    End Function

    <System.Runtime.CompilerServices.Extension()> _
    Private Function GetPixelFromArray(ByVal Array As Byte(), ByVal Point As Point, ByVal BitmapData As Imaging.BitmapData) As Color
        Dim Offset = (BitmapData.Stride * Point.Y) + (BytesPerPixel * Point.X)
        Return Color.FromArgb(Array(Offset + 2), Array(Offset + 2), Array(Offset))
    End Function

    <System.Runtime.CompilerServices.Extension()> _
    Private Function GetBitmapData(ByVal Bitmap As Bitmap, ByVal Area As Rectangle, ByRef BitmapData As Imaging.BitmapData) As Byte()
        BitmapData = Bitmap.LockBits(Area, Imaging.ImageLockMode.ReadOnly, Imaging.PixelFormat.Format24bppRgb)
        Dim Out = New Byte(BitmapData.Height * BitmapData.Stride) {}
        System.Runtime.InteropServices.Marshal.Copy(BitmapData.Scan0, Out, 0, Out.Length)
        Bitmap.UnlockBits(BitmapData)
        Return Out
    End Function

    <System.Runtime.CompilerServices.Extension()> _
    Private Function GetSection(ByVal Bytes As Byte(), ByVal Area As Rectangle, ByVal BitmapData As Imaging.BitmapData) As Byte()
        Using Out = New IO.MemoryStream
            For Y = Area.Top To Area.Bottom - 1
                Dim Offset = (BitmapData.Stride * Y) + (BytesPerPixel * Area.Left)
                Out.Write(Bytes, Offset, Area.Width * BytesPerPixel)
            Next
            Return Out.ToArray
        End Using
    End Function

    Private Function CompareByteArray(ByVal Array1 As Byte(), ByVal Array2 As Byte()) As Boolean
        For Position = 0 To Array1.Length - 1
            If Array1(Position) <> Array2(Position) Then Return False
        Next
        Return True
    End Function

End Module

 

[hampe-92]

this looks cool, I'm not a vb.net programmer so just to know I understood this right, this is for "reading" captchas, right?

 

[Stuart]

It could be used to do that yea although you would have to add some after code to make it loop through the alphabet and such.

 

[hampe-92]

It could be used to do that yea although you would have to add some after code to make it loop through the alphabet and such.

ok nice, yeah I understand that more code is needed to use it to that but I just wanted to see if I understood you right about the "find bitmap in bitmap"..