Imports System Imports System.Text Imports System.Data Imports System.Data.OleDb Imports System.Drawing Imports System.Drawing.Graphics Public Class CrackImage Private ConnStr As String = "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=Learn.mdb" Private resultNumber As String Private rsultStudy As Boolean = False '识别 Public Sub New(ByVal SrcImage As Bitmap) GetImageNumber = GetIamgeResultNumber(GetNewIamge(SrcImage)) End Sub '学习 Public Sub New(ByVal SrcImagePath As String,ByVal StudyNumber As String) rsultStudy = StudyCode(SrcImagePath,StudyNumber) End Sub Public Property GetImageNumber() As String Get Return resultNumber End Get Set(ByVal Value As String) resultNumber = Value End Set End Property Public Property GetStudyImageResult() As Boolean Get Return rsultStudy End Get Set(ByVal Value As Boolean) rsultStudy = Value End Set End Property '处理新图片 Private Function GetNewIamge(ByVal srcBitBmpImage As Bitmap) As Bitmap '建立临时表 Dim myDataTable As New DataTable Dim myCol2 As New DataColumn myCol2.DataType = System.Type.GetType("System.Int32") myCol2.ColumnName = "RgbValue" myDataTable.Columns.Add(myCol2) Dim myCol3 As New DataColumn myCol3.DataType = System.Type.GetType("System.Int32") myCol3.ColumnName = "RgbCount" myDataTable.Columns.Add(myCol3) '载入图片 Dim img As Bitmap = srcBitBmpImage Dim x,y As Integer '去除杂点 '遍历所有点，存储每点的颜色代码，并对各种颜色进行统计 （这些代码可以不要，直接将图转化成黑白只剩下噪点和感染线条） For x = 0 To img.Width - 1 For y = 0 To img.Height - 1 Dim Found As Boolean = False If myDataTable.Rows.Count > 0 Then For k As Integer = 0 To myDataTable.Rows.Count - 1 If myDataTable.Rows(k).Item("RgbValue") = img.GetPixel(x,y).ToArgb Then myDataTable.Rows(k).Item("RgbCount") += 1 Found = True Exit For End If Next End If If Found = False Then Dim myRow As DataRow myRow = myDataTable.NewRow() myRow.Item("RgbValue") = img.GetPixel(x,y).ToArgb myRow.Item("RgbCount") = 1 myDataTable.Rows.Add(myRow) End If Next Next '获取背景色码 '象素点出现最多的就视为背景色 Dim intMaxRgbValue As Integer = 0 If myDataTable.Rows.Count > 0 Then myDataTable.DefaultView.Sort = "RgbCount DESC" intMaxRgbValue = myDataTable.DefaultView.Item(0).Item("RgbValue") End If '勾画数字轮廓 For x = 0 To img.Width - 1 For y = 0 To img.Height - 1 Dim x1,y1 As Integer 'x1和y1记录的是相对当前象素的上一个象素的坐标 If x = 0 Then x1 = x Else x1 = x - 1 End If If y = 0 Then y1 = y Else y1 = y - 1 End If Dim x2,y2 As Integer 'x2和y2记录的是相对当前象素下一个象素的坐标 If x = img.Width - 1 Then x2 = img.Width - 1 Else x2 = x + 1 End If If y = img.Height - 1 Then y2 = img.Height - 1 Else y2 = y + 1 End If '都是普通的去噪手法，去噪成黑白色，这里是去噪成黑黄 色 If img.GetPixel(x2,y).ToArgb = intMaxRgbValue Or img.GetPixel(x1,y).ToArgb = intMaxRgbValue Then img.SetPixel(x,y,Color.Black) ElseIf img.GetPixel(x,y).ToArgb <> intMaxRgbValue Then img.SetPixel(x,Color.Yellow) Else img.SetPixel(x,Color.Black) End If Next Next Return img End Function '获取处理后的数字 Private Function GetIamgeResultNumber(ByVal srcNewImg As Bitmap) As String Dim RawData As New StringBuilder '设置分割大小 Dim imgNewWidth As Integer = 16 Dim imgNewHeight As Integer = 13 Dim imgNew As New Bitmap(srcNewImg) Dim x,y As Integer Dim result As String = "" Dim ImageSplitWidth As Integer = imgNew.Width - imgNewWidth For m As Integer = 0 To ImageSplitWidth Step imgNewWidth Dim Rc As New Rectangle(m,imgNewWidth,imgNewHeight) Dim B As Bitmap B = imgNew.Clone(Rc,imgNew.PixelFormat) '对比分割的颜色，黑色取1，其他取0，就此生成特征码 For x = 0 To imgNewWidth - 1 For y = 0 To imgNewHeight - 1 If B.GetPixel(x,y).ToArgb <> Color.Black.ToArgb Then RawData.Append("1") Else RawData.Append("0") End If Next Next result += GetIamgeRawToNumber(RawData.ToString) RawData.Replace("0","").Replace("1","") Next Return result End Function '学习新图片 Private Function StudyCode(ByVal srcImage As String,ByVal objNumber As String) As Boolean If objNumber = "" Or objNumber.Length < 4 Then Exit Function Dim RawData As New StringBuilder Dim imgNewWidth As Integer = 16 Dim imgNewHeight As Integer = 13 Dim p As Integer = 0 Dim x,y As Integer Dim srcBitbmp As New Bitmap(srcImage) Dim imgNew As Bitmap = GetNewIamge(srcBitbmp) '分割图片并保存学习代码 Dim ImageSplitWidth As Integer = imgNew.Width - imgNewWidth For m As Integer = 0 To ImageSplitWidth Step imgNewWidth Dim CurNumber As String CurNumber = objNumber.Substring(p,1) If CurNumber <> "." Then Dim Rc As New Rectangle(m,imgNew.PixelFormat) For x = 0 To imgNewWidth - 1 For y = 0 To imgNewHeight - 1 If B.GetPixel(x,y).ToArgb <> Color.Black.ToArgb Then RawData.Append("1") Else RawData.Append("0") End If Next Next SaveImageRaw(objNumber.Substring(p,1),RawData.ToString) RawData.Replace("0","") End If p += 1 Next Return True End Function '获取图片Raw数据 Private Function GetIamgeRawToNumber(ByVal strRaw As String) As String Dim conn As New OleDbConnection(ConnStr) Dim comm As New OleDbCommand Dim reader As OleDbDataReader Dim myDataTable As New DataTable Dim myCol1 As New DataColumn myCol1.DataType = System.Type.GetType("System.Int32") myCol1.ColumnName = "MatchNumber" myDataTable.Columns.Add(myCol1) Dim myCol2 As New DataColumn myCol2.DataType = System.Type.GetType("System.Int32") myCol2.ColumnName = "MatchCount" myDataTable.Columns.Add(myCol2) comm.CommandText = "select LearnCharacter,Eigenvalue from tbLearn" conn.Open() comm.Connection = conn reader = comm.ExecuteReader If reader.HasRows Then While reader.Read Dim myRow As DataRow myRow = myDataTable.NewRow() myRow.Item("MatchNumber") = reader.Item(0) myRow.Item("MatchCount") = CompareRaw(reader.Item(1),strRaw) myDataTable.Rows.Add(myRow) End While End If conn.Close() Dim reuslt As String = "" If myDataTable.Rows.Count > 0 Then myDataTable.DefaultView.Sort = "MatchCount DESC" reuslt = myDataTable.DefaultView.Item(0).Item("MatchNumber") End If Return reuslt End Function '比较图片Raw数据 Private Function CompareRaw(ByVal strDataBaseRaw As String,ByVal strObjRaw As String) As Integer Dim intRawLen As Integer = strDataBaseRaw.Length Dim MatchCount As Integer = 0 For i As Integer = 0 To intRawLen - 1 If strDataBaseRaw.Substring(i,1) = strObjRaw.Substring(i,1) Then MatchCount += 1 End If Next Return MatchCount End Function '保存图片Raw数据 Private Sub SaveImageRaw(ByVal strNumber As String,ByVal strRaw As String) Dim conn As New OleDbConnection(ConnStr) Dim comm As New OleDbCommand comm.CommandText = "insert into tbLearn(LearnCharacter,Eigenvalue) values ('" + strNumber + "','" + strRaw + "')" conn.Open() comm.Connection = conn comm.ExecuteNonQuery() conn.Close() End Sub End Class