Question

我正在寻找一种在VB.net提供图像时检测网格方块中心的方法

我想从带有蓝色方块的网格图像开始，如下所示： Grid

我希望程序在每个方格的中心制作一个点数组（点不在图片中心） Grid with Red points

我不想修改图像，我只是想获得积分。我尝试过x和y的getpixel，但这只是返回相同的点

  Dim search_color As Color = Color.FromArgb(255, 64, 128, 192)
    Dim background_color As Color = Color.FromArgb(255, 240, 240, 240)
    Dim grid_color As Color = Color.FromArgb(255, 144, 144, 144)
    Dim pix As Color
    Dim liney = 0, linex = 0
    Dim loc, sloc, gloc As Point
    For ch As Integer = 1 To 64
        For y As Integer = liney To Bmp.Height - 1
            For x As Integer = linex To Bmp.Width - 1
                If Bmp.GetPixel(x, y) = search_color Then
                    sloc = New Point(x, y)
                    linex = x
                    liney = y
                    x = Bmp.Width - 1
                    y = Bmp.Height - 1
                End If

            Next

        Next

        Dim xloc = 0
        For x As Integer = sloc.X To Bmp.Width - 1
            If Bmp.GetPixel(x, sloc.Y) = grid_color Then
                xloc = x - 1
            End If
            If Bmp.GetPixel(x, sloc.Y) = background_color Then
                xloc = x - 1

            End If

        Next

        For y As Integer = sloc.Y To Bmp.Height - 1
            If Bmp.GetPixel(xloc, y) = grid_color Or Bmp.GetPixel(xloc, y) = background_color Then
                gloc = New Point(xloc, y - 1)
            End If

        Next


        loc = New Point((gloc.X + sloc.X) / 2, (gloc.Y + sloc.Y) / 2)
        liney = gloc.Y
        linex = gloc.X + 20
        ListBox1.Items.Add(loc.ToString)
    Next

Answer 1

试试这个：我将以下控件添加到表单中以测试代码：

pbImageToScan（PictureBox） - btnAnalyzeIMG（Button） - lbResult（ListBox）

Public Class Form1

Dim arrCenters() As Point
Dim bmpToAnalyze As Bitmap

Dim search_color As Color = Color.FromArgb(255, 64, 128, 192)
Dim background_color As Color = Color.FromArgb(255, 240, 240, 240)
Dim grid_color As Color = Color.FromArgb(255, 144, 144, 144)

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    bmpToAnalyze = New Bitmap(Application.StartupPath & "\Image.bmp")
    pbImageToScan.Image = Image.FromFile(Application.StartupPath & "\Image.bmp")
End Sub

Private Sub btnAnalyzeIMG_Click(sender As Object, e As EventArgs) Handles btnAnalyzeIMG.Click
    FindCenters()
End Sub

Private Sub FindCenters()

    bmpToAnalyze = New Bitmap(Application.StartupPath & "\Image.bmp")
    pbImageToScan.Image = Image.FromFile(Application.StartupPath & "\Image.bmp")

    'arrCenters is the array who will contains all centers data
    ReDim arrCenters(0)

    'arrCenters already starts with an element; this boolean is used to handle the first point insertion 
    Dim bFirstElementAddedToArray As Boolean

    lbResult.Items.Clear()

    Dim iIMGWidth As Integer = bmpToAnalyze.Width
    Dim iIMGHeight As Integer = bmpToAnalyze.Height

    'X, Y coordinates used for iterations
    Dim iX As Integer = 0
    Dim iY As Integer = 0

    'Bitmap limits reached
    Dim bExit As Boolean

    'Used to skip a great part of Ys, if a match has been found along the current examinated line
    Dim iDeltaYMax As Integer = 0

    'Main cycle
    Do While Not bExit

        Dim colCurrentColor As Color = bmpToAnalyze.GetPixel(iX, iY)

        If colCurrentColor = search_color Then

            Dim iXStart As Integer = iX
            Dim iYStart As Integer = iY
            Dim iXEnd As Integer
            Dim iYEnd As Integer

            'Width of the Blue square
            For iXEnd = iX + 1 To iIMGWidth - 1
                Dim colColorSearchX As Color = bmpToAnalyze.GetPixel(iXEnd, iY)
                If (colColorSearchX = background_color) Or (colColorSearchX = grid_color) Then
                    iXEnd -= 1
                    Exit For
                End If
            Next

            'Height of the Blue square
            For iYEnd = iY + 1 To iIMGHeight - 1
                Dim colColorSearchY As Color = bmpToAnalyze.GetPixel(iXEnd, iYEnd)
                If (colColorSearchY = background_color) Or (colColorSearchY = grid_color) Then
                    iYEnd -= 1
                    Exit For
                End If
            Next

            iDeltaYMax = iYEnd - iYStart

            'Blue square center coordinates
            Dim pCenter As New Point((iXStart + iXEnd) / 2, (iYStart + iYEnd) / 2)
            Dim iArrLenght As Integer = 0
            If Not bFirstElementAddedToArray Then
                bFirstElementAddedToArray = True
            Else
                iArrLenght = arrCenters.GetLength(0)
                ReDim Preserve arrCenters(iArrLenght)
            End If
            arrCenters(iArrLenght) = pCenter

            lbResult.Items.Add(pCenter.ToString)

            iX = iXEnd

            'Checks if the Width limit of the bitmap has been reached
            If iX = (iIMGWidth - 1) Then
                iX = 0
                iY += iDeltaYMax + 1
                iDeltaYMax = 0
            Else
                iX += 1
            End If

        Else

            'Checks if the Width limit of the bitmap has been reached
            If iX = (iIMGWidth - 1) Then
                iX = 0
                iY += iDeltaYMax + 1
                iDeltaYMax = 0
            Else
                iX += 1
            End If

        End If

        'Width and Height limit of the bitmap have been reached
        If (iX = iIMGWidth - 1) And (iY = iIMGHeight - 1) Then
            bExit = True
        End If

    Loop

    'Draws a Red point on every center found
    For Each P As Point In arrCenters
        bmpToAnalyze.SetPixel(P.X, P.Y, Color.Red)
    Next

    pbImageToScan.Image = bmpToAnalyze

End Sub

结束班

vb图像网格检测

1 个答案: