OCR 文字点位

最近在写一个OCR程序，下面的是文字精确定位的的VB函数代码。

Public Function Position(src As Object)
Dim col As Long
Dim srcWidth, srcHeight As Integer
Dim BlackCount, WhiteCount As Integer
Dim Ytop, Ybottom, xtop, xbottom As Integer

srcWidth = src.Width
srcHeight = src.Height

‘Ybottom
For j = 0 To srcHeight
BlackCount = 0
WhiteCount = 0
For i = 0 To srcWidth

col = GetPixel(src.hdc, i, j)

If col = vbWhite Then
WhiteCount = WhiteCount + 1
ElseIf col = vbBlack Then
BlackCount = BlackCount + 1
End If
If WhiteCount > 20 Then
Ybottom = j
j = srcHeight + 1
i = srcWidth + 1
End If
Next i
Next j

‘ytop
For j = srcHeight To 0 Step -1
BlackCount = 0
WhiteCount = 0
For i = 0 To srcWidth

col = GetPixel(src.hdc, i, j)

If col = vbWhite Then
WhiteCount = WhiteCount + 1
ElseIf col = vbBlack Then
BlackCount = BlackCount + 1
End If
If WhiteCount > 3 Then
Ytop = j
j = 0
i = srcWidth + 1
End If
Next i
Next j

‘xbottom
For i = 0 To srcWidth
BlackCount = 0
WhiteCount = 0

For j = 0 To srcHeight ‘ To 0 Step -1

col = GetPixel(src.hdc, i, j)

If col = vbWhite Then
WhiteCount = WhiteCount + 1
ElseIf col = vbBlack Then
BlackCount = BlackCount + 1
End If
If WhiteCount > 20 Then
xbottom = i
j = srcHeight + 1
i = srcWidth + 1
End If
Next j
Next i

‘xtop
For i = srcWidth To 0 Step -1
BlackCount = 0
WhiteCount = 0

For j = 0 To srcHeight ‘ To 0 Step -1

col = GetPixel(src.hdc, i, j)

If col = vbWhite Then
WhiteCount = WhiteCount + 1
ElseIf col = vbBlack Then
BlackCount = BlackCount + 1
End If
If WhiteCount > 20 Then
xtop = i
j = srcHeight + 1
i = 0
End If
Next j
Next i

src.Line (xbottom, Ybottom)-(xbottom, Ytop), vbBlue
src.Line (xbottom, Ybottom)-(xtop, Ybottom), vbBlue
src.Line (xbottom, Ytop)-(xtop, Ytop), vbBlue
src.Line (xtop, Ybottom)-(xtop, Ytop), vbBlue


WhiteCount = 0
BlackCount = 0

For i = Ybottom To Ytop
BlackCount = 0
For j = xbottom To xtop ‘图像回归
‘For y = 0 To NewHeight

col = GetPixel(src.hdc, j, i)

If col = vbWhite Then
WhiteCount = WhiteCount + 1
ElseIf col = vbBlack Then
BlackCount = BlackCount + 1

End If
Next j
src.Line (0, i)-(BlackCount / 5, i), vbYellow
src.Refresh
DoEvents
Next i

For i = xbottom To xtop
BlackCount = 0
For j = Ybottom To Ytop ‘文字定位
‘For y = 0 To NewHeight

col = GetPixel(src.hdc, i, j)

If col = vbWhite Then
‘WhiteCount = WhiteCount + 1
ElseIf col = vbBlack Then
BlackCount = BlackCount + 1

End If
Next j
col = GetPixel(src.hdc, i - 1, j)
src.Line (i, 0)-(i, BlackCount), vbYellow
If BlackCount = 0 And col <> vbBlack Then src.Line (i, 0)-(i, xtop), vbBlue

src.Refresh
DoEvents
Next i

End Function

OCR 文字点位

原文：http://www.cnblogs.com/dhaichen/p/5164526.html