clsgetcode.cls

图灵识别这个代码是作为学习之用

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsGetCode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'////////////////////////////////////////////////////////////////////////////////////////////////////////////
'
'    此识别模块通过点阵扫描后对字符点阵数量的统计来进行识别，比较初级。只能识别字符比较规则的验证码图片
'
'    编写人:杨小卫(天地孤星)
'    QQ:    66091282
'    E-Mail:[e-mail]
'
'    http://www.btqq.cn
'
'    识别思路:  二值化图像---->杂点过滤---->字符位置搜索----->字符点阵数量统计----->于字符点阵模版匹配
'
'////////////////////////////////////////////////////////////////////////////////////////////////////////////

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Public ViewString As String
Private m_G As Byte

Public Function GetCode(pic1 As PictureBox) 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 = 0 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 Then
           pix(ix, iy) = False
        Else
           pix(ix, iy) = True
        End If
    Next
Next


'Fillter pix

Dim str As String
For iy = 0 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


ViewString = str


Dim x As Long
Dim y As Long
Dim x1 As Long
Dim y1 As Long

'--------------------------------------------------1
x = GetFontStartX(pix(), 0)
y = GetFontStartY(pix(), 0)

'Debug.Print "X=" & x & ",Y=" & y
x1 = x
y1 = y

x = GetFontEndX(pix(), x)
y = GetFontEndY(pix(), y)

'Debug.Print "X=" & x & ",Y=" & y
'Debug.Print GetPixNum(pix(), x1, y1, x, y)
'GetCode = GetCode & GetNum(GetPixNum(pix(), x1, y1, x, y - (y - y1) / 2))
GetCode = GetCode & GetNum(pix(), x1, y1, x, y)
'--------------------------------------------------2
x = GetFontStartX(pix(), x)
y = GetFontStartY(pix(), 0)

'Debug.Print "X=" & x & ",Y=" & y
x1 = x
y1 = y

x = GetFontEndX(pix(), x)
y = GetFontEndY(pix(), y)

'Debug.Print "X=" & x & ",Y=" & y
'Debug.Print GetPixNum(pix(), x1, y1, x, y)
'GetCode = GetCode & GetNum(GetPixNum(pix(), x1, y1, x, y - (y - y1) / 2))
GetCode = GetCode & GetNum(pix(), x1, y1, x, y)
'--------------------------------------------------3
x = GetFontStartX(pix(), x)
y = GetFontStartY(pix(), 0)

'Debug.Print "X=" & x & ",Y=" & y
x1 = x
y1 = y

x = GetFontEndX(pix(), x)
y = GetFontEndY(pix(), y)

'Debug.Print "X=" & x & ",Y=" & y
'Debug.Print GetPixNum(pix(), x1, y1, x, y)
'GetCode = GetCode & GetNum(GetPixNum(pix(), x1, y1, x, y - (y - y1) / 2))
GetCode = GetCode & GetNum(pix(), x1, y1, x, y)
'--------------------------------------------------4
x = GetFontStartX(pix(), x)
y = GetFontStartY(pix(), 0)

'Debug.Print "X=" & x & ",Y=" & y
x1 = x
y1 = y

x = GetFontEndX(pix(), x)
y = GetFontEndY(pix(), y)

'Debug.Print "X=" & x & ",Y=" & y
'Debug.Print GetPixNum(pix(), x1, y1, x, y)
'GetCode = GetCode & GetNum(GetPixNum(pix(), x1, y1, x, y - (y - y1) / 2))
GetCode = GetCode & GetNum(pix(), x1, y1, x, y)
'--------------------------------------------------5
x = GetFontStartX(pix(), x)
y = GetFontStartY(pix(), 0)

'Debug.Print "X=" & x & ",Y=" & y
x1 = x
y1 = y

x = GetFontEndX(pix(), x)
y = GetFontEndY(pix(), y)

'Debug.Print "X=" & x & ",Y=" & y
'Debug.Print GetPixNum(pix(), x1, y1, x, y)
'GetCode = GetCode & GetNum(GetPixNum(pix(), x1, y1, x, y - (y - y1) / 2))
GetCode = GetCode & GetNum(pix(), x1, y1, x, y)
'--------------------------------------------------6
x = GetFontStartX(pix(), x)
y = GetFontStartY(pix(), 0)

'Debug.Print "X=" & x & ",Y=" & y
x1 = x
y1 = y

x = GetFontEndX(pix(), x)
y = GetFontEndY(pix(), y)

'Debug.Print "X=" & x & ",Y=" & y
'Debug.Print GetPixNum(pix(), x1, y1, x, y)
'GetCode = GetCode & GetNum(GetPixNum(pix(), x1, y1, x, y - (y - y1) / 2))

GetCode = GetCode & GetNum(pix(), x1, y1, x, y)

'Debug.Print "--------------------------------------------------End"
'--------------------------------------------------End
End Function


Private Sub 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 Sub


Private Function ColorCompared(ByVal Color1 As Long, ByVal Color2 As Long, ByVal Diff As Byte) As Boolean
Dim a(1) As Byte
Dim b(1) As Byte
Dim G(1) As Byte
Dim R(1) As Byte
Dim bl(3) As Byte

GetRGB Color1, R(0), G(0), b(0)
GetRGB Color2, R(1), G(1), b(1)

If R(0) > R(1) Then bl(0) = R(0) - R(1) Else bl(0) = R(1) - R(0)
If G(0) > G(1) Then bl(1) = G(0) - G(1) Else bl(1) = G(1) - G(0)
If b(0) > b(1) Then bl(2) = b(0) - b(1) Else bl(2) = b(1) - b(0)
If a(0) > a(1) Then bl(3) = a(0) - a(1) Else bl(3) = a(1) - a(0)

If bl(0) >= Diff Or bl(1) >= Diff Or bl(2) >= Diff Or bl(3) >= Diff Then
    ColorCompared = False
Else
    ColorCompared = True
End If

End Function


Private Function GetFontStartY(ByRef pix() As Boolean, ByRef sY As Long) As Long
Dim ix As Long
Dim iy As Long
    For iy = sY To UBound(pix(), 2)
        For ix = 0 To UBound(pix(), 1)
            If pix(ix, iy) Then
                GetFontStartY = iy
                Exit Function
            End If
        Next
    Next
End Function

Private Function GetFontStartX(ByRef pix() As Boolean, ByRef sX As Long) As Long
Dim ix As Long
Dim iy As Long
    For ix = sX To UBound(pix(), 1)
        For iy = 0 To UBound(pix(), 2)
            If pix(ix, iy) Then
                GetFontStartX = ix
                Exit Function
            End If
        Next
    Next
End Function


Private Function GetFontEndY(ByRef pix() As Boolean, ByRef sY As Long) As Long
Dim ix As Long
Dim iy As Long
Dim flag As Boolean
    
    For iy = sY To UBound(pix(), 2)
        flag = True
        For ix = 0 To UBound(pix(), 1)
            If pix(ix, iy) Then
                flag = False
                Exit For
            End If
        Next
        If flag = True Then
            GetFontEndY = iy
            Exit Function
        End If
    Next
    
End Function

Private Function GetFontEndX(ByRef pix() As Boolean, ByRef sX As Long) As Long
Dim ix As Long
Dim iy As Long
Dim flag As Boolean

    For ix = sX To UBound(pix(), 1)
        flag = True
        For iy = 0 To UBound(pix(), 2)
            If pix(ix, iy) Then
                flag = False
                Exit For
            End If
        Next
        If flag = True Then
            GetFontEndX = ix
            Exit Function
        End If
    Next
End Function

Private Sub Fillter(ByRef pix() As Boolean)
Dim ix As Long
Dim iy As Long
Dim NullCount As Integer

    For iy = 1 To UBound(pix(), 2) - 1
        For ix = 1 To UBound(pix(), 1) - 1
            If pix(ix, iy) Then
                If Not (pix(ix - 1, iy - 1) Or pix(ix, iy - 1) Or pix(ix + 1, iy - 1) Or pix(ix - 1, iy) Or pix(ix + 1, iy) Or pix(ix - 1, iy + 1) Or pix(ix, iy + 1) Or pix(ix + 1, iy + 1)) Then
                    pix(ix, iy) = False
                End If
            End If