clsgetcode.cls

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

        Next
    Next

    iy = 0
    
    For ix = 1 To UBound(pix(), 1) - 1
        If pix(ix, iy) Then
            If Not (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
    Next
    
    iy = UBound(pix(), 2)
    
    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)) Then
                pix(ix, iy) = False
            End If
        End If
    Next
    
    ix = 0
    
    For iy = 1 To UBound(pix(), 2) - 1
        If pix(ix, iy) Then
            If Not (pix(ix, iy - 1) Or pix(ix + 1, iy - 1) Or pix(ix + 1, iy) Or pix(ix, iy + 1) Or pix(ix + 1, iy + 1)) Then
                pix(ix, iy) = False
            End If
        End If
    Next
    
    ix = UBound(pix(), 1)
    
    For iy = 1 To UBound(pix(), 2) - 1
        If pix(ix, iy) Then
            If Not (pix(ix - 1, iy - 1) Or pix(ix, iy - 1) Or pix(ix - 1, iy) Or pix(ix - 1, iy + 1) Or pix(ix, iy + 1)) Then
                pix(ix, iy) = False
            End If
        End If
    Next
    
    If pix(0, 0) Then
        If Not (pix(0, 1) Or pix(1, 1) Or pix(1, 0)) Then
            pix(ix, iy) = False
        End If
    End If
    
End Sub
Private Function GetPixNum(pix() As Boolean, x, y, x1, y1) As Integer
Dim ix As Long
Dim iy As Long


'----------------------点统计---------------------------
'    For iy = y To y1
'        For ix = x To x1
'            If pix(ix, iy) Then
'                GetPixNum = GetPixNum + 1
'            End If
'        Next
'    Next

'--------------------寄偶点统计-------------------------
'    For iy = y To y1
'        For ix = x To x1
'            If iy Mod 2 = 0 Then
'                If ix Mod 2 = 0 Then
'                    If pix(ix, iy) Then
'                        GetPixNum = GetPixNum + 1
'                    End If
'                End If
'            Else
'                If (ix + 1) Mod 2 = 0 Then
'                    If pix(ix, iy) Then
'                        GetPixNum = GetPixNum + 1
'                    End If
'                End If
'            End If
'        Next
'    Next

'-------------------4坐标区点统计-------------------------
'    Dim LT As Integer
'    Dim RT As Integer
'    Dim LB As Integer
'    Dim RB As Integer

'    Dim CenterX As Long
'    Dim CenterY As Long

'    CenterX = x + (x1 - x) / 2
'    CenterY = y + (y1 - y) / 2
'
'
'    For iy = y To CenterY
'        For ix = x To CenterX - 1
'            If pix(ix, iy) Then LT = LT + 1
'        Next
'    Next
'
'    For iy = y To CenterY - 1
'        For ix = CenterX To x1
'            If pix(ix, iy) Then RT = RT + 1
'        Next
'    Next
'
'    For iy = CenterY To y1
'        For ix = x To CenterX - 1
'            If pix(ix, iy) Then LB = LB + 1
'        Next
'    Next
'
'    For iy = CenterY To y1
'        For ix = CenterX To x1
'            If pix(ix, iy) Then RB = RB + 1
'        Next
'    Next
'
'    Debug.Print "LT=" & LT, "RT=" & RT, "LB=" & LB, "RB=" & RB

'-----------------纵横点统计序列--------------------
'    Dim s As String
'    Dim n As Integer
'
'    For iy = y To y1 - 1
'        n = 0
'        For ix = x To x1 - 1
'            If pix(ix, iy) Then
'                n = n + 1
'            End If
'        Next
'        s = s & Format(n, "00")
'    Next
    
'-----------------纵横点阵序列--------------------
    Dim s As String

    
    For iy = y To y1 - 1
        For ix = x To x1 - 1
            s = s & Abs(CInt(pix(ix, iy)))
        Next
    Next
    
    Debug.Print GetPixModNum(s)
    
    ViewString = ViewString & vbCrLf & s & vbCrLf
    
'-----------------------------------------------

'    Debug.Print GetPixNum
End Function
'
'Private Function GetNum(n As Integer) As Integer
'
''    Select Case n
''
''    Case 18
''        GetNum = 1
''    Case 21
''        GetNum = 2
''    Case 22
''        GetNum = 3
''    Case 25
''        GetNum = 4
''    Case 23
''        GetNum = 5
''    Case 29
''        GetNum = 6
''    Case 19
''        GetNum = 7
''    Case 30
''        GetNum = 8
''    Case 32
''        GetNum = 9
''    Case 28
''        GetNum = 0
''    End Select
''
''1=18
''2=21
''3=22
''4=25
''5=23
''6=29
''7=19
''8=30
''9=32
''0=28
'
'End Function

Private Function GetNum(pix() As Boolean, x, y, x1, y1) As String
    Dim s As String

    
    For iy = y To y1 - 1
        For ix = x To x1 - 1
            s = s & Abs(CInt(pix(ix, iy)))
        Next
    Next
    
    GetNum = GetPixModNum(s)
End Function


Public Property Get G() As Byte
    G = m_G
End Property

Public Property Let G(ByVal vNewValue As Byte)
    m_G = vNewValue
End Property

Private Sub Class_Initialize()
    m_G = 100
End Sub

'根据获得的字母的点阵数据，来进行匹配
Private Function GetPixModNum(str As String) As String
Dim C_char(35) As String

C_char(0) = ""
C_char(1) = "0011011111111011001100110011001100110011"
C_char(2) = "011110110011000011000011000110001110011100011000111000111111"
C_char(3) = "011110110011000011000111001110000111000011000011110111011110"
C_char(4) = "000110001110001110001110010110010110100110111111000110000110"
C_char(5) = "011111011000111000111110110011000011000011000011110111011110"
C_char(6) = "011110011011110000110000111110110011110011110011111011011110"
C_char(7) = "111111000111000110000110001100001100011100011000011000011000"
C_char(8) = "011110110011110011110011011110110011110011110011110011011110"
C_char(9) = "011110110111110011110011110011011111000011000011110110011100"

C_char(10) = "000111000000111000001111100001101100001101100011000110011000110011111110111000111110000011"
C_char(11) = "1111110110001111000111100011111111011001111100011110001111000111111110"
C_char(12) = "00111110011001111100000011000000110000001100000011000000110000000110011100111110"
C_char(13) = "1111100110011011000111100011110001111000111100011110001111001101111100"
C_char(14) = "111111110000110000110000111111110000110000110000110000111111"
C_char(15) = "111111110000110000110000110000111111110000110000110000110000"
C_char(16) = "00111110011001111100000011000000110000001100111111000011110000110110011100111111"
C_char(17) = "1100011110001111000111100011111111111000111100011110001111000111100011"
C_char(18) = "11111111111111111111"
C_char(19) = "000011000011000011000011000011000011000011110011110011011110"
C_char(20) = "1100011110011011011101111100111110011111101100110110011011000111100011"
C_char(21) = "110000110000110000110000110000110000110000110000110000111111"
C_char(22) = "111000111111000111111101111111101111111101111110101011110111011110111011110111011110111011"
C_char(23) = "1100011111001111110111111011111111111011111101111110011111001111100011"
C_char(24) = ""
C_char(25) = "1111110110011111000111100011110011111111101100000110000011000001100000"
C_char(26) = "0011110001100110110000111100001111000011110000111100001111001011011011100011111000000001"
C_char(27) = "11111100110001101100011011000110110011101111110011001100110011101100011011000111"
C_char(28) = "0111110110001111000001110000011110000111100000111000001111000110111110"
C_char(29) = "11111111000110000001100000011000000110000001100000011000000110000001100000011000"
C_char(30) = "1100011110001111000111100011110001111000111100011110001111101110111110"
C_char(31) = ""
C_char(32) = "1100011100011110001110001111101111101110110111110110011011011011001101101101100111110111110001110001111000111000111000011100011100"
C_char(33) = "1100011111011101101100111110001110000111000111110011011011101111100011"
C_char(34) = "11000011111001110110011000111100001111000001100000011000000110000001100000011000"
C_char(35) = "1111111000011100001100001110000110000110000111000011000011100001111111"

Dim i As Integer

For i = 0 To UBound(C_char)
    If C_char(i) <> "" Then
        If bj(str, C_char(i)) Then
            If i <= 9 Then  '阀值，表示不匹配的点小于9
                GetPixModNum = Chr(i + 48)
            Else
                GetPixModNum = Chr(i + 65 - 10)
            End If
            Exit Function
        End If
    End If
Next

End Function

'字符比较函数
Private Function bj(str As String, modstr As String, Optional rc As Integer = 5) As Boolean
    Dim i As Integer
    Dim n As Integer
    
    For i = 1 To Len(modstr)
        If Mid(str, i, 1) <> Mid(modstr, i, 1) Then n = n + 1
    Next
    
    If n > rc Then
        bj = False
    Else
        bj = True
    End If
    
End Function