我应该如何检测多次出现的具有相同颜色的像素

Question

此问题与 Visual Basic .NET 2010 相关

好的，我制作了这个程序，它可以在屏幕上的任何表面上重绘图像。我正在使用一些 Win32 API 来移动鼠标并模拟点击等。

问题是，我过去只是让它点击每个像素，这导致在 flash 或 javascript 表面上使用时会出现很多延迟。

我需要检测像素的“线”，例如，如果我正在枚举像素并检查它们的颜色，如果当前像素是黑色，接下来的 10 个也是黑色，我需要能够检测它并绘制一条线而不是单击每条线，以防止滞后。

这是我当前的代码，这是我枚举像素的方式。

Private Sub Draw()
    If First Then
        Pos = New Point(Me.Location)
        MsgBox("Position set, click again to draw" & vbCrLf _
               & "Estimated time: " & (Me.BackgroundImage.Width * Me.BackgroundImage.Height) / 60 & " seconds (1ms/pixel)")
        First = False
    Else
        Using Bmp As New Bitmap(Me.BackgroundImage)
            Using BmpSize As New Bitmap(Bmp.Width, Bmp.Height, System.Drawing.Imaging.PixelFormat.Format32bppPArgb) 'Use to get size of bitmap
                For y As Integer = 0 To BmpSize.Height - 1
                    For x = 0 To BmpSize.Width - 1
                        Dim curPixColor As Color = Bmp.GetPixel(x, y)
                        If curPixColor = Color.White Then Continue For 'Treat white as nothing
                        If IsColorBlack(curPixColor) Then
                            'TODO:
                            'If more than 1 black pixel in a row, use _Drag() to draw line
                            'If 1 pixel followed by white, use _Click() to draw 1 pixel
                        End If
                    Next
                Next
                MsgBox("Drawn")
                First = True 'Nevermind this, used for resetting the program
            End Using
        End Using
    End If
End Sub

Private Sub _Drag(ByVal From As Point, ByVal _To As Point)
    SetCursorPos(From.X, From.Y)
    mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
    SetCursorPos(_To.X, _To.Y)
    mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
End Sub

Private Sub _Click(ByVal At As Point)
    SetCursorPos(At.X, At.Y)
    mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
    mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
End Sub

一如既往，我们非常感谢您的帮助。这是一个相当复杂的问题，但我希望我能说得通。

Answer 1

你可以试试这样算

'Count of the black pixels
Dim BlackCount As Integer = 1
'Another intermediate X variable
Dim ThisX As Integer = x + 1
'Run along until reaching the right edge or a not black pixel
While ThisX < Bmp.Width AndAlso IsColorBlack(Bmp.GetPixel(ThisX, y))
    BlackCount += 1
    ThisX += 1
End While
'Act accordingly
If BlackCount > 1 Then
   'Drag from x to Thisx-1
Else
   'Click
End If
x = ThisX 'Update the X variable to skip over the covered area

还尝试确定导致延迟的原因。 GetPixel 和 SetPixel 非常慢。为了提高性能，请查看 LockBits 读取像素值的方式。尝试 google 或 http://msdn.microsoft.com/de-de/library/ms229672%28v=vs.90%29.aspx 作为第一次开始。它的速度要快很多，应该在读取大量像素时使用。