module1.bas

联机手写汉字识别

Attribute VB_Name = "Module1"
Public fMainForm As frmMain
Public Const PI = 3.1415926
Public Const GRID_NO = 400
Public Resemble_Extent As Single
Public Resemble_Limit As Single
Public R_Flag As Boolean
Public A(1 To GRID_NO, 1 To GRID_NO) As Integer     'pixel array
Public I, J As Integer
Public MaxId As Integer
Dim G_L_Flag As Integer
Public optMiZiGe As Boolean
Public Flag_Recog As Boolean
Public msgDebug As Boolean
Public Pic1_Width As Long, Pic1_Height As Long
Public Pic2_Width As Long, Pic2_Height As Long
Public Pic3_Width As Long, Pic3_Height As Long
Public Key_A As Integer     '笔画数 BiHuaShu
Public Key_B As Integer     '交点数 JiaoDianShu
Public Key_C As String      'HSPNT_X 特征
Public Key_D As Integer
Public Key_E As Integer
Public CharaOut As New Characters
Public Chara01 As New Characters, Chara02 As New Characters
Public Chara03 As New Characters, Chara04 As New Characters
Public Chara05 As New Characters, Chara06 As New Characters
Public Chara07 As New Characters, Chara08 As New Characters
Public Chara09 As New Characters, Chara10 As New Characters
Public Chara11 As New Characters, Chara12 As New Characters
Public Chara13 As New Characters, Chara14 As New Characters
Public Chara15 As New Characters, Chara16 As New Characters


Sub Main()
    Set fMainForm = New frmMain
    fMainForm.Show
End Sub

Sub Init_Grid()
  For I = 1 To GRID_NO
        For J = 1 To GRID_NO
            A(I, J) = 0
        Next J
    Next I
End Sub

Sub Pic2_rfsh()
   Dim U, V, S, T As Integer
    fMainForm.Picture2.Cls
    For I = 1 To GRID_NO
        For J = 1 To GRID_NO
            If A(I, J) Then
                S = I * Pic2_Width \ GRID_NO - 0.5 * Pic2_Width \ GRID_NO
                T = J * Pic2_Height \ GRID_NO - 0.5 * Pic2_Height \ GRID_NO
                'fMainForm.Picture2.FillStyle = 0
                fMainForm.Picture2.DrawWidth = 2
                fMainForm.Picture2.Circle (S, T), 0.5 * Pic2_Width \ GRID_NO
                
                'U = (I - 1) * Pic2_Width \ GRID_NO
                'V = (J - 1) * Pic2_Height \ GRID_NO
                'S = I * Pic2_Width \ GRID_NO
                'T = J * Pic2_Height \ GRID_NO
                '  frmMain.Picture2.Line (U, V)-(S, T), , BF
                ' frmMain.Label1.Caption = frmMain.Label1.Caption & "  U=" & U & "V=" & V & "S=" & S & "T=" & T
            End If
        Next J
    Next I
End Sub

Sub Hz_Recognize()
    Dim Out_Text As String
    Dim R As Single, cmdTrainMid As Single
    Dim S1_HanZi As String, S2_Key As String
    Dim Char_Elem As New CharactInfo
    Dim L As Integer
    Dim IndColOut As Long
    Dim IndColtoDel As Integer
    
    Call Pic2_rfsh
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    MaxId = 0
    Call Init_ConcaDi
    R = 0.5 * Resemble_Extent
    With fMainForm
    If .TextOut.Text <> "" Then
        .Text_Edit.Text = .Text_Edit.Text & .TextOut.Text
        .TextOut = ""
    End If
    
    Select Case Key_A
        Case 0
            R = R
        Case 1
            For Each Char_Elem In Chara01
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                    'S2_Key = Char_Elem.Key
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 2
            For Each Char_Elem In Chara02
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                    'S2_Key = Char_Elem.Key
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 3
            For Each Char_Elem In Chara03
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 4
            For Each Char_Elem In Chara04
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 5
            For Each Char_Elem In Chara05
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 6
            For Each Char_Elem In Chara06
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 7
            For Each Char_Elem In Chara07
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 8
            For Each Char_Elem In Chara08
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 9
            For Each Char_Elem In Chara09
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 10
            For Each Char_Elem In Chara10
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 11
            For Each Char_Elem In Chara11
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 12
            For Each Char_Elem In Chara12
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 13
            For Each Char_Elem In Chara13
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 14
            For Each Char_Elem In Chara14
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 15
            For Each Char_Elem In Chara15
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case 16
            For Each Char_Elem In Chara16
                If ReSemble(Key_C, Char_Elem.Key) > Resemble_Limit Then
                    Call ConcaDi(Char_Elem.HanZi, Char_Elem.Key)
                End If
                If R < ReSemble(Key_C, Char_Elem.Key) Then
                    R = ReSemble(Key_C, Char_Elem.Key)
                    S1_HanZi = Char_Elem.HanZi
                End If
            Next
            If R > Resemble_Extent Then
                Out_Text = S1_HanZi
            Else
                Key_A = 30     'To Case Else to Show Can't Recognize
            End If
        Case Else
            .TextOut.Visible = False
            .TextUnknown.Visible = True
            Exit Sub
    End Select
    If Key_A = 30 Then
            .TextOut.Visible = False
            .TextUnknown.Visible = True
    Else
            .TextOut.Text = Out_Text
    End If
            If MaxId = 1 Then
                Call Init_ConcaDi
                For IndColOut = 1 To CharaOut.Count
                    CharaOut.Remove IndColOut
                Next IndColOut
            Else
                For L = 0 To MaxId - 1
                    R = 0#
                    For IndColOut = 1 To CharaOut.Count
                        If R < ReSemble(Key_C, CharaOut(IndColOut).Key) Then
                            R = ReSemble(Key_C, CharaOut(IndColOut).Key)
                            S1_HanZi = CharaOut(IndColOut).HanZi
                            'S2_Key = CharaOut(IndColOut).Key
                            IndColtoDel = IndColOut
                            If msgDebug = True Then
                                MsgBox "相似程度:" & R & "  HanZi:" & S1_HanZi & "  在候选字集合中的Index=" & IndColtoDel
                            End If
                        End If
                    Next IndColOut
                    If msgDebug = True Then
                        MsgBox "OK!!     第" & L + 1 & "候选字是： " & S1_HanZi
                    End If
                    .Concadidate(L).Caption = S1_HanZi
                    CharaOut.Remove IndColtoDel
                Next L
                For L = 0 To MaxId - 1
                    cmdTrainMid = .cmdTrain.Left + 0.5 * .cmdTrain.Width
                    .Concadidate(0).Left = cmdTrainMid - (((MaxId - 1) / _
                                2) * (.Concadidate(0).Width + 100)) - 150
                    .Concadidate(L).Left = .Concadidate(0).Left _
                                + (.Concadidate(0).Width + 100) * L
                    .Concadidate(L).Visible = True
                Next L
            End If
    'End If
    End With
    
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'    Call Init_Grid
End Sub

Sub G_L_SUB(ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer)
Dim D As Integer
Dim X As Integer
Dim Y As Integer
Dim Flag_8 As Integer