程序代码：Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Dim m_G As Byte
Dim m_R As Byte
Dim m_B As Byte
Dim HQ As Boolean
Private Sub Command1_Click()
m_G = Text2.Text
m_R = Text3.Text
m_B = Text4.Text
Call 二值化
End Sub
Public Function 二值化() As String
Dim a As Byte
Dim b As Byte
Dim G As Byte
Dim R As Byte
Dim NumS As String
Dim pix() As Boolean
ReDim pix(pic1.ScaleWidth - 1, pic1.ScaleHeight - 1) As Boolean
Dim Color1 As Long
Dim Color2 As Long
Dim iy As Long
Dim ix As Long
For iy = 3 To pic1.ScaleHeight - 1
For ix = 0 To pic1.ScaleWidth - 1
Call GetRGB(GetPixel(pic1.hdc, ix, iy), R, G, b)
If G <= m_G And R <= m_R And b <= m_B Then
pix(ix, iy) = False
Else
pix(ix, iy) = True
End If
Next
Next
Dim str As String
For iy = 3 To UBound(pix(), 2)
For ix = 0 To UBound(pix(), 1)
If pix(ix, iy) Then
str = str & "■"
Else
str = str & "□"
End If
Next
str = str & vbCrLf
Next
Text1.Text = str
str = ""
For ix = 0 To UBound(pix(), 1)
For iy = 3 To UBound(pix(), 2)
If pix(ix, iy) Then
str = str & "■"
Else
str = str & "□"
End If
Next
str = str & vbCrLf
Next
Text8 = str
End Function
Public Function GetRGB(ByVal Color As Long, ByRef R As Byte, ByRef G As Byte, ByRef b As Byte, Optional ByRef a As Byte)
a = CByte((Color And &HFF000000) / 2 ^ (8 * 3))
b = CByte((Color And &HFF0000) / 2 ^ (8 * 2))
G = CByte(((Color And &HFF00) / 2 ^ (8 * 1)) And &HFF)
R = CByte((Color And &HFF) / 2 ^ (8 * 0))
End Function
Private Sub Command2_Click()
List1.AddItem "正确"
For i = 0 To List1.ListCount - 1
If List1.List(i) = "正确" Then
z = z + 1
Else
p = p + 1
End If
Next i
Text5 = "总记录---" & List1.ListCount & "条记录---正确---" & z & "条记录---正确率---" & Format((z / List1.ListCount) * 100, "0.00") & "%"
End Sub
Private Sub Command3_Click()
Picture1.Picture = pic1.Picture
If Text6.Text = "" Then Exit Sub
With HttpSocket1
.Http_Ver = V11
.RequestUrl = Text6.Text
'.SendData = "dorequest_bc&word1=%D3%E9%C0%D6%D0%DD%CF%D0"
.AddHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/msword, */*"
.AddHeader "Accept-Language", "zh-cn"
'.AddHeader "Accept-Encoding", "gzip, deflate"
.AddHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)"
.AddHeader "Host", .RemoteHost
.AddHeader "Connection", "Close"
.SendRequest
End With
Command6_Click
End Sub
Private Sub Command4_Click()
List1.AddItem "错误"
For i = 0 To List1.ListCount - 1
If List1.List(i) = "正确" Then
z = z + 1
Else
p = p + 1
End If
Next i
Text5 = "总记录---" & List1.ListCount & "条记录---正确---" & z & "条记录---正确率---" & Format((z / List1.ListCount) * 100, "0.00") & "%"
End Sub
Private Sub Command6_Click()
'---------------------------二值
m_G = Text2.Text
m_R = Text3.Text
m_B = Text4.Text
Call 二值化
Dim str1() As String
Dim str2() As String
Dim i As Integer
Dim j As Integer
i = 0
str1() = Split(Text1.Text, vbCrLf)
str2() = Split(Text8.Text, vbCrLf)
'1-9 8-17 15-25 23-32
For i = 0 To 3
Text7(i) = ""
Next i
'----------------------------------识别2
Dim m(0 To 3) As Long, n(0 To 3) As Long
m(0) = 1: m(1) = 8: m(2) = 15: m(3) = 23
n(0) = 9: n(1) = 17: n(2) = 25: n(3) = 32
For k = 0 To 3 '------2
num = 0
If InStr(Mid(str1(9), m(k), n(k) - m(k) + 1), String(7, "□")) > 0 Or InStr(Mid(str1(10), m(k), n(k) - m(k) + 1), String(7, "□")) > 0 Then
If InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "■□□□■") = 0 Or InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "■□□□■") = 0 Then
Text7(k) = IIf(Text7(k) = "", "2", Text7(k))
End If
End If
Next k
For k = 0 To 3 '---------4
If InStr(Mid(str1(6), m(k), n(k) - m(k) + 1), String(7, "□")) > 0 Or InStr(Mid(str1(7), m(k), n(k) - m(k) + 1), String(7, "□")) > 0 Then
For i = m(k) - 1 To n(k) - 1
If InStr(str2(i), String(9, "□")) > 0 Then Text7(k) = IIf(Text7(k) = "", "4", Text7(k)): Exit For '"□■■■■□"
Next i
End If
Next k
For k = 0 To 3 '-------------3,5
num = 0
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(7, "□")) > 0 Or InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(7, "□")) > 0 Then
If InStr(Mid(str1(9), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 Or InStr(Mid(str1(10), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 Then
For i = m(k) - 1 To n(k) - 1
If InStr(str2(i), String(5, "□")) > 0 Then num = num + 1
Next i
If num >= 2 Then Text7(k) = IIf(Text7(k) = "", "5", Text7(k))
End If
Else
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(5, "□")) > 0 Or InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(5, "□")) > 0 Then
If InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "■□□□■") > 0 Or InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "■□□□■") > 0 Then
For i = m(k) - 1 To n(k) - 1
If InStr(str2(i), "□" & String(5, "■")) > 0 Then Text7(k) = IIf(Text7(k) = "", "3", Text7(k)): Exit For
Next i
End If
End If
End If
Next k
For k = 0 To 3 '-------------------8
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 And InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 And InStr(Mid(str1(9), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 Then
Text7(k) = IIf(Text7(k) = "", "8", Text7(k))
End If
If InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 And InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 And InStr(Mid(str1(10), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 Then
Text7(k) = IIf(Text7(k) = "", "8", Text7(k))
End If
Next k
For k = 0 To 3 '-------------------7
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(8, "□")) > 0 Or InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(8, "□")) > 0 Then
Text7(k) = IIf(Text7(k) = "", "7", Text7(k))
End If
Next k
For k = 0 To 3 '-------------------6
If InStr(Mid(str1(3), m(k), n(k) - m(k) + 1), "□■■■□■") > 0 Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□■■■□■") > 0 Or InStr(Mid(str1(3), m(k), n(k) - m(k) + 1), "□■■■■■") > 0 Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□■■■■■") > 0 Or InStr(Mid(str1(3), m(k), n(k) - m(k) + 1), "■■□■■") > 0 Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "■■□■■") > 0 Then
Text7(k) = IIf(Text7(k) = "", "6", Text7(k)) '
End If
Next k
For k = 0 To 3 '-------------------9
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 And InStr(Mid(str1(9), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 Then
If InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□□■■□□") > 0 Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□■□") Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□■■□") Then
Text7(k) = IIf(Text7(k) = "", "9", Text7(k))
End If
End If
If InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 And InStr(Mid(str1(10), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 Then
If InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "□□■■□□") > 0 Or InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "□■□") Or InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "□■■□") Then
Text7(k) = IIf(Text7(k) = "", "9", Text7(k))
End If
End If
Next k
End Sub
Private Sub Form_Load()
If Text6.Text = "" Then Exit Sub
With HttpSocket1
.Http_Ver = V11
.RequestUrl = Text6.Text
'.SendData = "dorequest_bc&word1=%D3%E9%C0%D6%D0%DD%CF%D0"
.AddHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/msword, */*"
.AddHeader "Accept-Language", "zh-cn"
'.AddHeader "Accept-Encoding", "gzip, deflate"
.AddHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)"
.AddHeader "Host", .RemoteHost
.AddHeader "Connection", "Close"
.SendRequest
End With
End Sub
Private Sub HttpSocket1_OnRecvOver()
On Error Resume Next
Dim fn As Integer
Dim buff() As Byte
Dim Temp() As Byte
Debug.Print HttpSocket1.ResponseHeader
buff() = HttpSocket1.ResponseBody
Dim savefile As String
savefile = App.Path & "\temp.jpg"
'Debug.Print savefile
If Dir(savefile) <> "" Then Kill (savefile)
fn = FreeFile
'Open a binary file and load data into it!
Open savefile For Binary Access Write As #fn
Put #fn, , buff()
DoEvents
'Close the open file
Close #fn
pic1.Picture = LoadPicture(savefile)
End Sub
当然这里只是我发的算法部分。Dim m_G As Byte
Dim m_R As Byte
Dim m_B As Byte
Dim HQ As Boolean
Private Sub Command1_Click()
m_G = Text2.Text
m_R = Text3.Text
m_B = Text4.Text
Call 二值化
End Sub
Public Function 二值化() As String
Dim a As Byte
Dim b As Byte
Dim G As Byte
Dim R As Byte
Dim NumS As String
Dim pix() As Boolean
ReDim pix(pic1.ScaleWidth - 1, pic1.ScaleHeight - 1) As Boolean
Dim Color1 As Long
Dim Color2 As Long
Dim iy As Long
Dim ix As Long
For iy = 3 To pic1.ScaleHeight - 1
For ix = 0 To pic1.ScaleWidth - 1
Call GetRGB(GetPixel(pic1.hdc, ix, iy), R, G, b)
If G <= m_G And R <= m_R And b <= m_B Then
pix(ix, iy) = False
Else
pix(ix, iy) = True
End If
Next
Next
Dim str As String
For iy = 3 To UBound(pix(), 2)
For ix = 0 To UBound(pix(), 1)
If pix(ix, iy) Then
str = str & "■"
Else
str = str & "□"
End If
Next
str = str & vbCrLf
Next
Text1.Text = str
str = ""
For ix = 0 To UBound(pix(), 1)
For iy = 3 To UBound(pix(), 2)
If pix(ix, iy) Then
str = str & "■"
Else
str = str & "□"
End If
Next
str = str & vbCrLf
Next
Text8 = str
End Function
Public Function GetRGB(ByVal Color As Long, ByRef R As Byte, ByRef G As Byte, ByRef b As Byte, Optional ByRef a As Byte)
a = CByte((Color And &HFF000000) / 2 ^ (8 * 3))
b = CByte((Color And &HFF0000) / 2 ^ (8 * 2))
G = CByte(((Color And &HFF00) / 2 ^ (8 * 1)) And &HFF)
R = CByte((Color And &HFF) / 2 ^ (8 * 0))
End Function
Private Sub Command2_Click()
List1.AddItem "正确"
For i = 0 To List1.ListCount - 1
If List1.List(i) = "正确" Then
z = z + 1
Else
p = p + 1
End If
Next i
Text5 = "总记录---" & List1.ListCount & "条记录---正确---" & z & "条记录---正确率---" & Format((z / List1.ListCount) * 100, "0.00") & "%"
End Sub
Private Sub Command3_Click()
Picture1.Picture = pic1.Picture
If Text6.Text = "" Then Exit Sub
With HttpSocket1
.Http_Ver = V11
.RequestUrl = Text6.Text
'.SendData = "dorequest_bc&word1=%D3%E9%C0%D6%D0%DD%CF%D0"
.AddHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/msword, */*"
.AddHeader "Accept-Language", "zh-cn"
'.AddHeader "Accept-Encoding", "gzip, deflate"
.AddHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)"
.AddHeader "Host", .RemoteHost
.AddHeader "Connection", "Close"
.SendRequest
End With
Command6_Click
End Sub
Private Sub Command4_Click()
List1.AddItem "错误"
For i = 0 To List1.ListCount - 1
If List1.List(i) = "正确" Then
z = z + 1
Else
p = p + 1
End If
Next i
Text5 = "总记录---" & List1.ListCount & "条记录---正确---" & z & "条记录---正确率---" & Format((z / List1.ListCount) * 100, "0.00") & "%"
End Sub
Private Sub Command6_Click()
'---------------------------二值
m_G = Text2.Text
m_R = Text3.Text
m_B = Text4.Text
Call 二值化
Dim str1() As String
Dim str2() As String
Dim i As Integer
Dim j As Integer
i = 0
str1() = Split(Text1.Text, vbCrLf)
str2() = Split(Text8.Text, vbCrLf)
'1-9 8-17 15-25 23-32
For i = 0 To 3
Text7(i) = ""
Next i
'----------------------------------识别2
Dim m(0 To 3) As Long, n(0 To 3) As Long
m(0) = 1: m(1) = 8: m(2) = 15: m(3) = 23
n(0) = 9: n(1) = 17: n(2) = 25: n(3) = 32
For k = 0 To 3 '------2
num = 0
If InStr(Mid(str1(9), m(k), n(k) - m(k) + 1), String(7, "□")) > 0 Or InStr(Mid(str1(10), m(k), n(k) - m(k) + 1), String(7, "□")) > 0 Then
If InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "■□□□■") = 0 Or InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "■□□□■") = 0 Then
Text7(k) = IIf(Text7(k) = "", "2", Text7(k))
End If
End If
Next k
For k = 0 To 3 '---------4
If InStr(Mid(str1(6), m(k), n(k) - m(k) + 1), String(7, "□")) > 0 Or InStr(Mid(str1(7), m(k), n(k) - m(k) + 1), String(7, "□")) > 0 Then
For i = m(k) - 1 To n(k) - 1
If InStr(str2(i), String(9, "□")) > 0 Then Text7(k) = IIf(Text7(k) = "", "4", Text7(k)): Exit For '"□■■■■□"
Next i
End If
Next k
For k = 0 To 3 '-------------3,5
num = 0
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(7, "□")) > 0 Or InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(7, "□")) > 0 Then
If InStr(Mid(str1(9), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 Or InStr(Mid(str1(10), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 Then
For i = m(k) - 1 To n(k) - 1
If InStr(str2(i), String(5, "□")) > 0 Then num = num + 1
Next i
If num >= 2 Then Text7(k) = IIf(Text7(k) = "", "5", Text7(k))
End If
Else
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(5, "□")) > 0 Or InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(5, "□")) > 0 Then
If InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "■□□□■") > 0 Or InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "■□□□■") > 0 Then
For i = m(k) - 1 To n(k) - 1
If InStr(str2(i), "□" & String(5, "■")) > 0 Then Text7(k) = IIf(Text7(k) = "", "3", Text7(k)): Exit For
Next i
End If
End If
End If
Next k
For k = 0 To 3 '-------------------8
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 And InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 And InStr(Mid(str1(9), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 Then
Text7(k) = IIf(Text7(k) = "", "8", Text7(k))
End If
If InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 And InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 And InStr(Mid(str1(10), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 Then
Text7(k) = IIf(Text7(k) = "", "8", Text7(k))
End If
Next k
For k = 0 To 3 '-------------------7
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(8, "□")) > 0 Or InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(8, "□")) > 0 Then
Text7(k) = IIf(Text7(k) = "", "7", Text7(k))
End If
Next k
For k = 0 To 3 '-------------------6
If InStr(Mid(str1(3), m(k), n(k) - m(k) + 1), "□■■■□■") > 0 Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□■■■□■") > 0 Or InStr(Mid(str1(3), m(k), n(k) - m(k) + 1), "□■■■■■") > 0 Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□■■■■■") > 0 Or InStr(Mid(str1(3), m(k), n(k) - m(k) + 1), "■■□■■") > 0 Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "■■□■■") > 0 Then
Text7(k) = IIf(Text7(k) = "", "6", Text7(k)) '
End If
Next k
For k = 0 To 3 '-------------------9
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 And InStr(Mid(str1(9), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 Then
If InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□□■■□□") > 0 Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□■□") Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□■■□") Then
Text7(k) = IIf(Text7(k) = "", "9", Text7(k))
End If
End If
If InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 And InStr(Mid(str1(10), m(k), n(k) - m(k) + 1), String(4, "□")) > 0 Then
If InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "□□■■□□") > 0 Or InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "□■□") Or InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "□■■□") Then
Text7(k) = IIf(Text7(k) = "", "9", Text7(k))
End If
End If
Next k
End Sub
Private Sub Form_Load()
If Text6.Text = "" Then Exit Sub
With HttpSocket1
.Http_Ver = V11
.RequestUrl = Text6.Text
'.SendData = "dorequest_bc&word1=%D3%E9%C0%D6%D0%DD%CF%D0"
.AddHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/msword, */*"
.AddHeader "Accept-Language", "zh-cn"
'.AddHeader "Accept-Encoding", "gzip, deflate"
.AddHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)"
.AddHeader "Host", .RemoteHost
.AddHeader "Connection", "Close"
.SendRequest
End With
End Sub
Private Sub HttpSocket1_OnRecvOver()
On Error Resume Next
Dim fn As Integer
Dim buff() As Byte
Dim Temp() As Byte
Debug.Print HttpSocket1.ResponseHeader
buff() = HttpSocket1.ResponseBody
Dim savefile As String
savefile = App.Path & "\temp.jpg"
'Debug.Print savefile
If Dir(savefile) <> "" Then Kill (savefile)
fn = FreeFile
'Open a binary file and load data into it!
Open savefile For Binary Access Write As #fn
Put #fn, , buff()
DoEvents
'Close the open file
Close #fn
pic1.Picture = LoadPicture(savefile)
End Sub
我说一些我的算法。也就是图片二值化。因为图片大小一定。但是字的间隔什么都不确定
所以不能用平均分割的办法。
然后就是判断字的特点。因为都是数字所以还好判断些
我二值化之后是个11*32的一个数组。
那比如str1（11） str2（32） 这样两个数组交叉对比
比如7特征很明显。也就是str1（0）或者str（1）他的顶部含有7个1
但是相同的还有5.如何区分呢。5多了竖行也就str（2） 5个1相连的
当然分区我用的不是平均分区
'1-9 8-17 15-25 23-32这是分区 这样分别判断在那几个区就可以判断4位数字所占的位置了。
我们有固定取模块。当然。如果数字都是标准的哪取模块就相对简单一些。比如百姓网的电话图片
只是发点心得。