frmmain.frm

a vb sourcecod writed by other

            End If
            
            If arrTagData(i) <> "" Then
                Write #1, arrTagData(i) & "," & arrRawData(i)
            End If
            
            i = i + 1
            
        Wend
        Close #1
    Else
    End If
Else

'Dim oFile As TextStream
Dim strValue As String

'    Set oFile = New TextStream

'    MsgBox "Opening..."

'    On Error GoTo OpenErrorHandler
    Open_CommonDialog.FileName = ""
    Open_CommonDialog.DialogTitle = "打开"
    Open_CommonDialog.Filter = "识别文件 (*.rec)|*.rec|全部文件 (*.*)|*.*"
    Open_CommonDialog.DefaultExt = ".rec"
    Open_CommonDialog.InitDir = App.Path
    Open_CommonDialog.ShowOpen

'    If Open_CommonDialog.ShowOpen = vbCancel Then
'        GoTo OpenCancelClicked
'    End If

    If Open_CommonDialog.FileName <> "" Then

        Filename_Open = Open_CommonDialog.FileName
        Filename_Open = Mid(Filename_Open, InStrRev(Filename_Open, "\") + 1)
            
        picboxDataArea.Cls
        
        Open Filename_Open For Binary As #1
            i = 0
            strBuffer = Space(5)
                Get #1, , strBuffer
                arrRawData(i) = strBuffer
                i = i + 1
            strBuffer = Space(22)
            While Not EOF(1)
                Get #1, , strBuffer
                arrRawData(i) = strBuffer
                i = i + 1
            Wend
            arrRawData(i - 1) = ""
            Close #1
            
            i = 0
            strBuffer = ""
            If arrRawData(0) = "recPK" Then
                i = i + 1
                While arrRawData(i) <> ""
                
                    arrTagData(i - 1) = Mid(arrRawData(i), 1, 1)
'                    strBuffer = strBuffer & Mid(strData(i), 1, 1) & vbCrLf
'                    strBuffer = strBuffer & Mid(strData(0), i, 1) & ","
'                    Me.ListBox_List.AddItem i & ". <" & Mid(strData(i), 1, 1) & ">"
                    
                    arrRawData(i - 1) = ""
                    
                    For j = 1 To 10
'                        strBuffer = strBuffer & DecToBin(Asc(Mid(strData(i), 3 + ((j - 1) * 2), 1)), 2)
'                        strBuffer = strBuffer & DecToBin(Asc(Mid(strData(i), 4 + ((j - 1) * 2), 1)), 8)
                        arrRawData(i - 1) = arrRawData(i - 1) & _
                                            DecToBin(Asc(Mid(arrRawData(i), 3 + ((j - 1) * 2), 1)), 2) & _
                                            DecToBin(Asc(Mid(arrRawData(i), 4 + ((j - 1) * 2), 1)), 8)
'                        strBuffer = strBuffer
                    Next j
                    
'                    strBuffer = strBuffer & vbCrLf
                    i = i + 1
                    
                Wend
'                Me.RichTextBox_Text.Text = strBuffer
        '        Me.TextBox_Text.ScrollBars
                
                arrTagData(i - 1) = ""
                arrRawData(i - 1) = ""
   
            Else
            
                Filename_Open = Open_CommonDialog.FileName
                Filename_Open = Mid(Filename_Open, InStrRev(Filename_Open, "\") + 1)
            
                picboxDataArea.Cls
                
                c = 0
                
                Open Filename_Open For Input As #1
                While Not EOF(1)
Open_SkipLine:
                a = 190
                b = 190
                d = 0
                Me.picboxDataArea.Cls
                    If EOF(1) Then
                        GoTo Open_FileClose
                    End If
                    Input #1, arrRawData(c)
                    If Len(arrRawData(c)) < 102 Then
                        GoTo Open_SkipLine
                    End If
                    arrTagData(c) = Mid(arrRawData(c), 1, 1)
                    arrRawData(c) = Mid(arrRawData(c), 3)
        '            Debug.Print arrRawData(c)
                    c = c + 1
                    
        '''                For i = 1 To 10
        '''                For j = 1 To 10
        '''                    If Mid(arrRawData(c - 1), d + 1, 1) = vbBlack Then
        '''                        picboxDataArea.PSet (a, b)
        '''    '                    picboxDataArea.Circle (a, b), 110
        '''    '''                    picboxDataArea.Line (a - 110, b - 110)-(a + 110, b - 110)
        '''    '''                    picboxDataArea.Line (a + 110, b - 110)-(a + 110, b + 110)
        '''    '''                    picboxDataArea.Line (a + 110, b + 110)-(a - 110, b + 110)
        '''    '''                    picboxDataArea.Line (a - 110, b + 110)-(a - 110, b - 110)
        '''                    End If
        '''                    d = d + 1
        '''                    b = b + (Me.picboxDataArea.Height - 200) / 10
        '''                Next j
        '''                b = 190
        '''                a = a + (Me.picboxDataArea.Width - 200) / 10
        '''                Next i
                Wend
Open_FileClose:
                Close #1
            
                arrTagData(c) = ""
                arrRawData(c) = ""
                
            End If
    
    End If
    
'   With oFile
'      .FileName = Filename_Open
'      ' Check For File Too Big - 32K limit on text boxes
'      If .FileTooBig Then
'         Beep
'         MsgBox "File Too Big To Read", , "File Open Error"
'      Else
'         If .OpenTextFile(Filename_Open, ForReading) Then
'            Do Until .AtEndOfStream
'               strValue = strValue & .ReadLine & vbCrLf
'            Loop
'            .CloseFile
'            MsgBox strValue
'         End If
'      End If
'   End With
'   Set oFile = Nothing

'OpenCancelClicked:
'OpenErrorHandler:
'    Exit Sub

    If Open_CommonDialog.FileName <> "" Then
        Me.Open.Enabled = False
        Me.Teach.Enabled = False
        Me.Recognise.Enabled = False
        Me.ClearScreen.Enabled = True
        Me.comboOpen.Visible = True
        Me.comboOpen.Text = "选择要打开的字符集 ..."
        
        i = 0
        While Me.comboOpen.List(i) <> ""
            Me.comboOpen.RemoveItem (i)
        Wend
        i = 0
        While arrTagData(i) <> ""
            Me.comboOpen.AddItem i + 1 & ". - <" & arrTagData(i) & ">"
            i = i + 1
        Wend
        
        Dim lngRet As Long
            lngRet = SendMessage(Me.comboOpen.hwnd, _
                                CB_SHOWDROPDOWN, _
                                1, _
                                0&)
            
    End If
    
End If
    
End Sub

Private Sub Recognise_Click()
Dim Filename_Database As String
Dim strRecognised As String
Dim intMatch As Integer
Dim intMaxMatch As Integer
Dim intCounter As Integer
Dim boolFindLastFile As Boolean
Dim boolNoMoreFileLeft As Boolean
Dim buffer As String
Dim Buffer_DatabaseArea As Variant

Dim strBuffer As String

'    MsgBox "Recognising...", vbOKOnly, "Run into sub function..."

'    Call GraspRawData
    
    FileSystem.ChDir (App.Path)
    
    Me.pbRecognising.Visible = True
    
    strRecognised = ""
    intMaxMatch = 0
    intCounter = 0
    c = 0
    
    On Error GoTo Recognise_FileClose
    Filename_Database = "DATA" & RECOG_EXT
    
    If Filename_Database <> "" Then
        Me.picboxDatabaseArea.Cls
        Open Filename_Database For Binary As #1
            i = 0
            strBuffer = Space(5)
                Get #1, , strBuffer
                arrRawData(i) = strBuffer
                i = i + 1
            strBuffer = Space(22)
            While Not EOF(1)
                Get #1, , strBuffer
                arrRawData(i) = strBuffer
                i = i + 1
            Wend
            arrRawData(i - 1) = ""
            Close #1
            
            i = 0
            strBuffer = ""
            If arrRawData(0) = "recPK" Then
                i = i + 1
                
                strRecognised = ""
                intMaxMatch = 0
                intCounter = 0
                c = 0
                
                While arrRawData(i) <> ""
                
                    a = 190
                    b = 190
                    d = 0
                    intMatch = 0
                    Me.picboxDatabaseArea.Cls
                
                    arrTagData(i - 1) = Mid(arrRawData(i), 1, 1)
'                    strBuffer = strBuffer & Mid(strData(i), 1, 1) & vbCrLf
'                    strBuffer = strBuffer & Mid(strData(0), i, 1) & ","
'                    Me.ListBox_List.AddItem i & ". <" & Mid(strData(i), 1, 1) & ">"
                    
                    arrRawData(i - 1) = ""
                    
                    For j = 1 To 10
'                        strBuffer = strBuffer & DecToBin(Asc(Mid(strData(i), 3 + ((j - 1) * 2), 1)), 2)
'                        strBuffer = strBuffer & DecToBin(Asc(Mid(strData(i), 4 + ((j - 1) * 2), 1)), 8)
                        arrRawData(i - 1) = arrRawData(i - 1) & _
                                            DecToBin(Asc(Mid(arrRawData(i), 3 + ((j - 1) * 2), 1)), 2) & _
                                            DecToBin(Asc(Mid(arrRawData(i), 4 + ((j - 1) * 2), 1)), 8)
'                        strBuffer = strBuffer
                    Next j
                    
'                    strBuffer = strBuffer & vbCrLf
                    i = i + 1

                    For ii = 1 To 10
                    For jj = 1 To 10
                        If Mid(arrRawData(c), d + 1, 1) = vbBlack Then
        '                    picboxDataArea.PSet (i, j)
' j2 - mask - finalise
'                            picboxDatabaseArea.PSet (a, b)

        '                    picboxDataArea.Circle (a, b), 110
        '                    picboxDatabaseArea.Line (a - 110, b - 110)-(a + 110, b - 110)
        '                    picboxDatabaseArea.Line (a + 110, b - 110)-(a + 110, b + 110)
        '                    picboxDatabaseArea.Line (a + 110, b + 110)-(a - 110, b + 110)
        '                    picboxDatabaseArea.Line (a - 110, b + 110)-(a - 110, b - 110)
        '                    Debug.Print ""
                            If Mid(strData, d + 1, 1) = vbBlack Then
                                intMatch = intMatch + 1
                            Else
                                intMatch = intMatch - 1
                            End If
                        Else
                            If Mid(strData, d + 1, 1) <> vbBlack Then
                                intMatch = intMatch + 1
                            Else
                                intMatch = intMatch - 1
                            End If
                        End If
                        d = d + 1
                        b = b + (Me.picboxDatabaseArea.Height - 200) / 10
                    Next jj
                    b = 190
                    a = a + (Me.picboxDatabaseArea.Width - 200) / 10
                    Next ii
                    If intMaxMatch < intMatch Then
                        intMaxMatch = intMatch
                        strRecognised = arrTagData(c)
                        intCounter = c
                        Me.pbRecognising.Value = intMaxMatch
                        If intMaxMatch > 90 Then
                            GoTo Recognise_FileClose
                        End If
                    End If
                    c = c + 1
                
                Wend
'                Me.RichTextBox_Text.Text = strBuffer
        '        Me.TextBox_Text.ScrollBars
                
                arrTagData(i - 1) = ""
                arrRawData(i - 1) = ""
   
            Else
            
                strRecognised = ""
                intMaxMatch = 0
                intCounter = 0
                c = 0
                
                Open Filename_Database For Input As #1
                While Not EOF(1)
Recognise_SkipLine:
                a = 190
                b = 190
                d = 0
                intMatch = 0
                Me.picboxDatabaseArea.Cls
                    If EOF(1) Then
                        GoTo Recognise_FileClose
                    End If
                    Input #1, arrRawData(c)
                    If Len(arrRawData(c)) < 102 Then
                        GoTo Recognise_SkipLine
                    End If
                    arrTagData(c) = Mid(arrRawData(c), 1, 1)
                    arrRawData(c) = Mid(arrRawData(c), 3)
        '            Debug.Print arrRawData(c)
                    
                    For i = 1 To 10
                    For j = 1 To 10
                        If Mid(arrRawData(c), d + 1, 1) = vbBlack Then
        '                    picboxDataArea.PSet (i, j)
                            picboxDatabaseArea.PSet (a, b)