将屏幕截图作为位图加载到函数中,而不将其另存为文件

时间:2016-02-16 02:52:15

标签: vb.net bitmap

基本上我的程序从用户处获取“样本”图像,然后截取整个用户屏幕的截图,然后如果在用户屏幕上找到该样本,则返回其坐标并将鼠标移动到那里。

如果我将屏幕截图保存到位图并将示例与文件进行比较,它可以正常工作,但是当我尝试将屏幕截图直接调用到函数中时,它无法找到匹配项。

知道为什么吗?

首先触发比较的按钮点击代码:

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
    Dim clickhere As Point

    Dim bounds As Rectangle
    Dim screenshot As System.Drawing.Bitmap
    Dim graph As Graphics
    bounds = Screen.PrimaryScreen.Bounds
    screenshot = New System.Drawing.Bitmap(bounds.Width, bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
    graph = Graphics.FromImage(screenshot)
    graph.CopyFromScreen(bounds.X, bounds.Y, 0, 0, bounds.Size, CopyPixelOperation.SourceCopy)


    Dim src As New Bitmap(srcpath.Text)



    Dim g = Graphics.FromImage(screenshot)
    g.CopyFromScreen(0, 0, 0, 0, screenshot.Size)
    g.Dispose()


    clickhere = BitmapExtension.Contains(screenshot, src)
    MsgBox(clickhere.ToString)
    Cursor.Position = clickhere
End Sub

这是功能:

 Imports System.Drawing
    Imports System.Runtime.CompilerServices
    Imports System.Drawing.Imaging
    Imports System.Runtime.InteropServices

    Module BitmapExtension

        <Extension()>
        Public Function Contains(src As Bitmap, ByRef bmp As Bitmap) As Point
            '
            '-- Some logic pre-checks
            '
            If src Is Nothing OrElse bmp Is Nothing Then Return New Point(Integer.MinValue, Integer.MinValue)

            If src.Width < bmp.Width OrElse src.Height < bmp.Height Then
                Return New Point(Integer.MinValue, Integer.MinValue)
            End If
            '
            '-- Prepare optimizations
            '
            Dim sr As New Rectangle(0, 0, src.Width, src.Height)
            Dim br As New Rectangle(0, 0, bmp.Width, bmp.Height)

            Dim srcLock As BitmapData = src.LockBits(sr, Imaging.ImageLockMode.ReadOnly, PixelFormat.Format32bppRgb)
            Dim bmpLock As BitmapData = bmp.LockBits(br, Imaging.ImageLockMode.ReadOnly, PixelFormat.Format32bppRgb)

            Dim sStride As Integer = srcLock.Stride
            Dim bStride As Integer = bmpLock.Stride

            Dim srcSize As Integer = sStride * src.Height
            Dim bmpSize As Integer = bStride * bmp.Height

            Dim srcBuff(srcSize) As Byte
            Dim bmpBuff(bmpSize) As Byte

            Marshal.Copy(srcLock.Scan0, srcBuff, 0, srcSize)
            Marshal.Copy(bmpLock.Scan0, bmpBuff, 0, bmpSize)

            ' we don't need to lock the image anymore as we have a local copy
            bmp.UnlockBits(bmpLock)
            src.UnlockBits(srcLock)

            Return FindMatch(srcBuff, src.Width, src.Height, sStride, bmpBuff, bmp.Width, bmp.Height, bStride)

        End Function

        Private Function FindMatch(srcBuff() As Byte, srcWidth As Integer, srcHeight As Integer, srcStride As Integer,
        bmpBuff() As Byte, bmpWidth As Integer, bmpHeight As Integer, bmpStride As Integer) As Point
            For Y As Integer = 0 To srcHeight - bmpHeight - 1
                For x As Integer = 0 To srcWidth - bmpWidth - 1
                    If AllPixelsMatch(x, Y, srcBuff, srcStride, bmpBuff, bmpWidth, bmpHeight, bmpStride) Then
                        Return New Point(x, Y)
                    End If
                Next
            Next
            Return New Point(Integer.MinValue, Integer.MinValue)
        End Function

        Private Function AllPixelsMatch(X As Integer, Y As Integer, srcBuff() As Byte, srcStride As Integer,
          bmpBuff() As Byte, bmpWidth As Integer, bmpHeight As Integer, bmpStride As Integer) As Boolean
            For by As Integer = 0 To bmpHeight - 1
                For bx As Integer = 0 To bmpWidth - 1
                    Dim bmpIndex As Integer = by * bmpStride + bx * 4
                    Dim a As Byte = bmpBuff(bmpIndex + 3)
                    'If bmp pixel is not transparent, check if the colours are identical
                    If a > 0 T

hen
                    Dim srcX = X + bx
                    Dim srcY = Y + by
                    Dim srcIndex = srcY * srcStride + srcX * 4
                    For i As Integer = 0 To 2
                        'check if the r, g and b bytes match
                        If srcBuff(srcIndex + i) <> bmpBuff(bmpIndex + i) Then Return False
                    Next
                Else
                    'if bmp pixel is transparent, continue seeking.
                    Continue For
                End If
            Next
        Next
        Return True
    End Function
End Module

0 个答案:

没有答案