求高手指教:简单的图像识别问题

Question

我的白色为背景图片里面有一个黑色的圆，用什么方法可以识别出这个圆的所在坐标呢？

Answer 1

有别的干扰吗？
如果有就要用hough变换了
看看我写的程序，里面有实现算法：www.ournba.com/softsrc/hsetup.exe

Answer 2

如果没有其他干扰就很简单了
找最左边的黑点a，最右边的黑点b，ab的距离就是直径了，ab中点的坐标就是圆心了

Answer 3

就是说你的图象不只是白底黑圆咯？
那就麻烦了，还要做滤波，边缘提取，二值化，细化，清孤立点，hough变换的处理。

Answer 4

大哥,有没有hough变换的例程呢?

Answer 5

大哥,我的代码如下,但老是识别不了,是怎么回事呢?
'----------------------------------
Sub makeLine(r As Long, T As Long)
'On Error Resume Next
    If T = 0 Then
        MsgBox "无法分析"
        Exit Sub
    End If
    Dim MaxX  As Long
    Dim MaxY As Long
    Dim x As Long
    Dim Y As Long
    
    MaxX = Pic1.ScaleWidth / Screen.TwipsPerPixelX
    MaxY = Pic1.ScaleHeight / Screen.TwipsPerPixelY
    
    For x = 0 To MaxX
        Y = Abs(r / Sin(T) - x / Tan(T))
        SetPixelV Pic1.hdc, x, Y, vbRed
    Next
    Me.Caption = "R=" & r & " T=" & T
    Pic1.Refresh
End SubPrivate Sub Command2_Click()
    Me.Caption = "正在二值化...."
    DoEvents
    Call Ezh(Pic1) '二值化
    Me.Caption = "正在分析...."
    DoEvents
    
    Dim Hough() As Long
    Dim MaxX  As Long
    Dim MaxY As Long
    Dim MaxT As Long, MaxR As Long
    Dim x As Long, Y As Long, T As Long, r As Long
    Dim dt As Long, dr As Long
    
    Dim hMax As Long
    Dim hMaxT As Long, hMaxR As Long
    
    MaxX = Pic1.ScaleWidth / Screen.TwipsPerPixelX
    MaxY = Pic1.ScaleHeight / Screen.TwipsPerPixelY
    MaxT = 400
    MaxR = 90
    ReDim Hough(MaxT, MaxR)
    '-------------填充hough表------------------
    For x = 0 To MaxX
        For Y = 0 To MaxY
            If GetPixel(Pic1.hdc, x, Y) = vbBlack Then
                For T = 0 To MaxT
                    r = (x - MaxX / 2) * Cos(T) + (Y - MaxY / 2) * Sin(T)
                    If r > 0 And r < MaxR Then
                        Hough(T, r) = Hough(T, r) + 1
                    End If
                    
                Next
            End If
        Next
    Next
    '-----------算出最大值----------------
    For T = 0 To MaxT
        For r = 0 To MaxR
            If Hough(T, r) > hMax Then '阀值
                
                For dt = T - 2 To T + 2
                    For dr = r - 2 To r + 2
                        If dr > 0 And dt > 0 And dr < MaxR And dt < MaxT Then
                            If dr < MaxR And dt < MaxT And Hough(dt, dr) > Hough(T, r) Then
                                'hMax = False
                                GoTo Toline
                            End If
                        End If
                    Next
                Next
                hMax = Hough(T, r)
                hMaxT = T
                hMaxR = r
Toline:
            End If
        Next
    Next
    makeLine hMaxR, hMaxT
End Sub

Answer 6

就是hough变换啦，一般用随机的方法作圆吧。

Answer 7

代码是你自己写的还是？
我建议用随机hough变换
你这个我没用过，计算量很大，而且误差也比较大的

Answer 8

是我自己写的,随机hough是怎么回事呢?
可以说具体一点吗?

Answer 9

大哥有没有随机hough这方面的资料呀?

Answer 10

我也想知道用HOUGH变换检测圆的方法,看了写文章,都只提到一点点内容,
检测直线的方法到是很多,可惜都是VC的,前写天自己把他转换成VB的了

Answer 11

根据VC中的代码该的(hough变换检测直线)
ReadPic是一个读取图象数据的函数,执行这个函数后idata中就有了图象的数据,这里就不写出来了.Const Pi = 3.14159265358979
Private Type Myline
  topx As Integer
  topy As Integer
  botx As Integer
  boty As Integer
End Type
Private Sub Command1_Click()Dim MaxLength As Long, Alpha As Integer
Dim i As Long, j As Long, m As Long, Length As Long
Dim IpMyLine() As Myline, lpDistAlpha() As Long, maxd As Long
Dim MaxdLine As Myline, secondmaxd As Myline, midvalue() As Long
Call ReadPic(Picture1.Image, iDATA)
MaxLength = CLng(Sqr(PicInfo.bmWidth * PicInfo.bmWidth + PicInfo.bmHeight * PicInfo.bmHeight) + 0.5)Alpha = 180
ReDim IpMyLine(MaxLength * Alpha) As Myline
ReDim lpDistAlpha(0 To MaxLength * Alpha) As Long
ReDim midvalue(MaxLength * Alpha) As LongFor i = 1 To MaxLength * Alpha
    IpMyLine(i).boty = 32767  '初始化最低点的y坐标为一个很大的值
NextFor i = 1 To PicInfo.bmHeight
    For j = 1 To PicInfo.bmWidth
        If iDATA(1, j, i) = 0 Then    '是个黑点
           For m = 0 To 178
               Length = CLng(Abs(j * Cos(m * Pi / 180) + i * Sin(m * Pi / 180)))   'i,j点的s值随角度变换
               lpDistAlpha(Length * Alpha + m) = lpDistAlpha(Length * Alpha + m) + 1    '乘ALPHA=90是因为每次都要加m/2
               If i > IpMyLine(Length * Alpha + m).topy Then
                  IpMyLine(Length * Alpha + m).topx = j
                  IpMyLine(Length * Alpha + m).topy = i
               End If
               If i < IpMyLine(Length * Alpha + m).boty Then
                  IpMyLine(Length * Alpha + m).botx = j
                  IpMyLine(Length * Alpha + m).boty = i
               End If
         Next
         End If
        Next
    Next
     maxd = 0
       For i = 1 To MaxLength * Alpha
           If lpDistAlpha(i) >= maxd Then
              maxd = lpDistAlpha(i)
              MaxdLine.topx = IpMyLine(i).topx
              MaxdLine.topy = IpMyLine(i).topy
              MaxdLine.botx = IpMyLine(i).botx
              MaxdLine.boty = IpMyLine(i).boty
            End If
     Next
Picture1.Line (MaxdLine.topx, MaxdLine.topy)-(MaxdLine.botx, MaxdLine.boty), vbGreen
end sub 

Answer 12

我的找直线很不成功，老是出来一小截，汗。。楼上的方法就可以了。
hough变换有很多发展算法，楼上的是经典hough变换，我用的是随机hough变换，我的方法对有解析式的图象很有效果的，比如圆，就是随机取点连立方程，解出参数信息。
抱歉我现在在学校，代码在家里和信息老师的机器里，他出去学习了，我不知道他bios密码，又不好意思给人家放电，所以只能等5.1把代码贴出来了。。-_-||

Answer 13

大哥，实在太谢谢您啦。
我把你的代码略加整理了一下，帖出来让大家分享一下。Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As LongConst Pi = 3.14159265358979
Private Type Myline
  topx As Integer
  topy As Integer
  botx As Integer
  boty As Integer
End Type
Private Sub Command1_Click()
Dim bmWidth As Long
Dim bmHeight As Long
Dim Dc As Long
Dim MaxLength As Long, Alpha As Integer
Dim i As Long, j As Long, m As Long, Length As Long
Dim IpMyLine() As Myline, lpDistAlpha() As Long, maxd As Long
Dim MaxdLine As Myline, secondmaxd As Myline, midvalue() As LongbmWidth = Picture1.Width / Screen.TwipsPerPixelX
bmHeight = Picture1.Height / Screen.TwipsPerPixelY
Dc = Picture1.hdc'Call ReadPic(Picture1.Image, iDATA)
MaxLength = CLng(Sqr(bmWidth * bmWidth + bmHeight * bmHeight) + 0.5)Alpha = 180
ReDim IpMyLine(MaxLength * Alpha) As Myline
ReDim lpDistAlpha(0 To MaxLength * Alpha) As Long
ReDim midvalue(MaxLength * Alpha) As LongFor i = 1 To MaxLength * Alpha
    IpMyLine(i).boty = 32767  '&sup3;&otilde;&Ecirc;&frac14;&raquo;&macr;×&icirc;&micro;&Iacute;&micro;&atilde;&micro;&Auml;y×&oslash;±ê&Icirc;&ordf;&Ograve;&raquo;&cedil;&ouml;&ordm;&Uuml;&acute;ó&micro;&Auml;&Ouml;&micro;
NextFor i = 1 To bmHeight
    For j = 1 To bmWidth
        'If iDATA(1, j, i) = 0 Then    '&Ecirc;&Ccedil;&cedil;&ouml;&ordm;&Uacute;&micro;&atilde;
        If GetPixel(Dc, j, i) = vbBlack Then
           For m = 0 To 178
               Length = CLng(Abs(j * Cos(m * Pi / 180) + i * Sin(m * Pi / 180)))   'i,j&micro;&atilde;&micro;&Auml;s&Ouml;&micro;&Euml;&aelig;&frac12;&Ccedil;&para;&Egrave;±&auml;&raquo;&raquo;
               lpDistAlpha(Length * Alpha + m) = lpDistAlpha(Length * Alpha + m) + 1    '&sup3;&Euml;ALPHA=90&Ecirc;&Ccedil;&Ograve;ò&Icirc;&ordf;&Atilde;&iquest;&acute;&Icirc;&para;&frac14;&Ograve;&ordf;&frac14;&Oacute;m/2
               If i > IpMyLine(Length * Alpha + m).topy Then
                  IpMyLine(Length * Alpha + m).topx = j
                  IpMyLine(Length * Alpha + m).topy = i
               End If
               If i < IpMyLine(Length * Alpha + m).boty Then
                  IpMyLine(Length * Alpha + m).botx = j
                  IpMyLine(Length * Alpha + m).boty = i
               End If
         Next
         End If
        Next
    Next
     maxd = 0
       For i = 1 To MaxLength * Alpha
           If lpDistAlpha(i) >= maxd Then
              maxd = lpDistAlpha(i)
              MaxdLine.topx = IpMyLine(i).topx
              MaxdLine.topy = IpMyLine(i).topy
              MaxdLine.botx = IpMyLine(i).botx
              MaxdLine.boty = IpMyLine(i).boty
            End If
     Next
Picture1.Line (MaxdLine.topx * Screen.TwipsPerPixelX, MaxdLine.topy * Screen.TwipsPerPixelY)-(MaxdLine.botx * Screen.TwipsPerPixelX, MaxdLine.boty * Screen.TwipsPerPixelY), vbRed
End Sub

Answer 14

大哥，实在太谢谢您啦。  
我把你的代码略加整理了一下，帖出来让大家分享一下。
------------------------------------------------
'上一个帖子没有搞好，出乱码了，请斑竹删掉。
Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As LongConst Pi = 3.14159265358979
Private Type Myline
  topx As Integer
  topy As Integer
  botx As Integer
  boty As Integer
End Type
Private Sub Command1_Click()
Dim bmWidth As Long
Dim bmHeight As Long
Dim Dc As Long
Dim MaxLength As Long, Alpha As Integer
Dim i As Long, j As Long, m As Long, Length As Long
Dim IpMyLine() As Myline, lpDistAlpha() As Long, maxd As Long
Dim MaxdLine As Myline, secondmaxd As Myline, midvalue() As LongbmWidth = Picture1.Width / Screen.TwipsPerPixelX
bmHeight = Picture1.Height / Screen.TwipsPerPixelY
Dc = Picture1.hdc'Call ReadPic(Picture1.Image, iDATA)
MaxLength = CLng(Sqr(bmWidth * bmWidth + bmHeight * bmHeight) + 0.5)Alpha = 180
ReDim IpMyLine(MaxLength * Alpha) As Myline
ReDim lpDistAlpha(0 To MaxLength * Alpha) As Long
ReDim midvalue(MaxLength * Alpha) As LongFor i = 1 To MaxLength * Alpha
    IpMyLine(i).boty = 32767  '初始化最低点的y坐标为一个很大的值
NextFor i = 1 To bmHeight
    For j = 1 To bmWidth
        'If iDATA(1, j, i) = 0 Then    '是个黑点
        If GetPixel(Dc, j, i) = vbBlack Then
           For m = 0 To 178
               Length = CLng(Abs(j * Cos(m * Pi / 180) + i * Sin(m * Pi / 180)))   'i,j点的s值随角度变换
               lpDistAlpha(Length * Alpha + m) = lpDistAlpha(Length * Alpha + m) + 1    '乘ALPHA=90是因为每次都要加m/2
               If i > IpMyLine(Length * Alpha + m).topy Then
                  IpMyLine(Length * Alpha + m).topx = j
                  IpMyLine(Length * Alpha + m).topy = i
               End If
               If i < IpMyLine(Length * Alpha + m).boty Then
                  IpMyLine(Length * Alpha + m).botx = j
                  IpMyLine(Length * Alpha + m).boty = i
               End If
         Next
         End If
        Next
    Next
     maxd = 0
       For i = 1 To MaxLength * Alpha
           If lpDistAlpha(i) >= maxd Then
              maxd = lpDistAlpha(i)
              MaxdLine.topx = IpMyLine(i).topx
              MaxdLine.topy = IpMyLine(i).topy
              MaxdLine.botx = IpMyLine(i).botx
              MaxdLine.boty = IpMyLine(i).boty
            End If
     Next
Picture1.Line (MaxdLine.topx * Screen.TwipsPerPixelX, MaxdLine.topy * Screen.TwipsPerPixelY)-(MaxdLine.botx * Screen.TwipsPerPixelX, MaxdLine.boty * Screen.TwipsPerPixelY), vbRed
End Sub

Answer 15

GetPixel 效率太低了
用Public Declare Function GetDIBits Lib "gdi32" Alias "GetDIBits" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long

Answer 16

汗。。
这个找直线的效果比我的好。。
另外，请教 laviewpbt(人一定要靠自己)大哥，GetDIBits这个api怎么用？我现在一直在学这个，setpixel,getpixel太慢了。

Answer 17

又学到东西了.
期待MmMVP(杜霖:main(){MmMVP!=MsMVP;while(1) {kiss MM;}}) 的代码

Answer 18

发现一个Bug 当直线水平的时候就找不出来了．

Answer 19

小弟在查看Microsoft的资料时无意中发现了这个好东东.
可以识别汉字和字符的.识别率和效率都不错,现在拿出来,大伙一起研究研究. 
代码如下:Option Explicit
'注:要引用MIcrosoft Office Document Imageing 11.0 type
'这个组件是安了office 2003 以后才有
Private Sub Command1_Click()
TestOCR
End SubSub TestOCR()  Dim miDoc As MODI.Document
  
  Set miDoc = New MODI.Document
  Dim OutText As MODI.Layout
  
  miDoc.Create "C:\1.tif" '打开文档
  
  Screen.MousePointer = vbHourglass
  miDoc.OCR miLANG_CHINESE_SIMPLIFIED '语言为简体中文
  'miDoc.OCR
  Set OutText = miDoc.Images(0).Layout '识别第一页的数据
  msgbox "识别出为是字符如下:" & vbcrlf &  OutText.Text
  Screen.MousePointer = vbDefault
  miDoc.Close False
  Set OutText = Nothing
  Set miDoc = NothingEnd Sub

Answer 20

改下中间的两段： If i > IpMyLine(Length * Alpha + m).topy Or j > IpMyLine(Length * Alpha + m).topx Then
                 IpMyLine(Length * Alpha + m).topx = j
                 IpMyLine(Length * Alpha + m).topy = i
 End If
 If i < IpMyLine(Length * Alpha + m).boty Or j < IpMyLine(Length * Alpha + m).topx Then
                 IpMyLine(Length * Alpha + m).botx = j
                 IpMyLine(Length * Alpha + m).boty = i
 End If就能找水平线了

Answer 21

MmMVP(杜霖:main(){MmMVP!=MsMVP;while(1) {kiss MM;}}) 
还没有回来吗?