Vb.net vb图像网格检测

我在寻找一种方法来检测网格正方形的中心时，VB.net是饲料的图像

我想从一个带有蓝色正方形的网格图像开始，如下所示：

我想让程序在每个正方形的中心做一个点数组，就像这样（点在图片中不是居中的）

我不想修改图像，我只想得到点。我尝试过为x和y获取像素，但它只返回相同的点

  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

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

pbImageToScan（PictureBox）-btnAnalyzeIMG（按钮）-lbResult（列表框）

---

结束类

您需要首先获得每个区域的定义，我假设这是一个单独的图像。所以你需要得到边界的坐标，然后你需要确定该部分的中心点。

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