frmmain.frm

a vb sourcecod writed by other

        '                    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 j
                    b = 190
                    a = a + (Me.picboxDatabaseArea.Width - 200) / 10
                    Next i
                    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
Recognise_FileClose:
                Close #1
            End If
    End If
    
    Me.Recognise.Enabled = False
    Me.pbRecognising.Visible = False
    
    If strRecognised <> "" And intMaxMatch >= 68 Then
        picboxDatabaseArea.Cls
        a = 190
        b = 190
        d = 0
        For i = 1 To 10
        For j = 1 To 10
            If Mid(arrRawData(intCounter), d + 1, 1) = vbBlack Then
                picboxDatabaseArea.PSet (a, b)
                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)
            End If
            d = d + 1
            b = b + (Me.picboxDatabaseArea.Height - 200) / 10
        Next j
        b = 190
        a = a + (Me.picboxDatabaseArea.Width - 200) / 10
        Next i
    End If
    
    If strRecognised <> "" And intMaxMatch >= 68 Then
        'The highest posible of drawn character is recognised as   'X'
        Me.ResultLabel.Caption = "识别该字符和这个字符匹配   '" & strRecognised & "'"
        Me.ResultLabel.ToolTipText = intMaxMatch & "%"
        '& " , " & intMaxMatch & "%"
        
        Me.DrawWidth = 2
    '    me
    '    Me.Circle (6120, 6120), 170, vbYellow
    '    Me.Circle (6120, 6120), 180, vbBlack
        
    '    Me.Circle (5240, 6300), 190, vbYellow
    
        Me.Circle (5180, 6300), 190, vbYellow
        Me.Circle (5180, 6300), 210, vbBlack
    
        Me.comboRecognise.Visible = True
        With Me.comboRecognise
        
        End With
        
    Else
        If MsgBox("No character has been teach OR Character not drawn properly OR User has drawn more than one character OR Run Text Recognition for the 1st. time, Please click 'Yes' to Teach or 'No' to discard drawn character.", vbExclamation + vbYesNo, "Run Text Recognition for the 1st. time?") = vbYes Then
            Call Teach_Click
        Else
            MsgBox intMaxMatch & "% Match with character '" & strRecognised & "'"
        End If
    End If
    
''''    strMatch = "a"
''''    intMatch = 0
''''
''''    Do
''''    intCounter = 0
''''    intPoint = 0
''''    Buffer = Str$(intMatch) & "data"
''''
''''        Do
''''        On Error GoTo Recognise_Anchor_LastFile
''''Recognise_Anchor_Search_UntilNoFile:
''''        Filename_Database = Buffer & intCounter & RECOG_EXT
''''        Open Filename_Database For Input As #1
''''        c = 0
''''            For i = 1 To picboxDrawArea.Width Step 50
''''            For j = 1 To picboxDrawArea.Height Step 50
''''                If EOF(1) Then
''''                    GoTo Recognise_FileClose
''''                End If
''''                Input #1, Buffer_DatabaseArea
''''                RawDatabase(c) = Buffer_DatabaseArea
'''''                Debug.Print RawData(c)
''''                c = c + 1
''''                If RawDatabase(c - 1) = vbBlack Then
''''                    picboxDatabaseArea.PSet (i, j)
''''                    If RawData(c - 1) = vbBlack Then
''''                        intPoint = intPoint + 1
''''                    End If
''''                End If
''''            Next j, i
''''
''''Recognise_FileClose:
''''        Close #1
''''
''''        If intPoint > intMaxPoint Then
''''            intMaxPoint = intPoint
''''            intMaxMatch = intMatch
''''        End If
''''
''''        intCounter = intCounter + 1
''''        GoTo Recognise_Anchor_Search_UntilNoFile
''''Recognise_Anchor_LastFile:
''''        Close #1
''''
''''        boolFindLastFile = True
''''
''''        Loop While Not boolFindLastFile
''''
''''
''''
''''    intMatch = intMatch + 1
''''
''''    If intMatch = 10 Then
''''        boolNoMoreFileLeft = True
''''    End If
''''    Loop While Not boolNoMoreFileLeft
'''''*********
''''
''''    MsgBox "intmaxpoint=" & intMaxPoint
''''    MsgBox "intmaxmatch=" & intMaxMatch

End Sub

Private Sub Teach_Click()

    Me.TeachLabelText.FontBold = False
    Me.TeachLabelText.Caption = "Enter a character to be teach"
    
    Me.Open.Visible = False
    Me.Teach.Visible = False
    Me.Recognise.Visible = False
    Me.ClearScreen.Visible = False
    Me.Exit.Visible = False
    
    Me.TeachConfirm.Visible = True
    Me.TeachCancel.Visible = True
    Me.TeachText.Visible = True

    Me.TeachText.Text = ""
    Me.TeachText.SetFocus
    Me.TeachConfirm.Enabled = False
    
End Sub

Private Sub GraspRawData()
Dim bool1stScan As Boolean
Dim ax As Integer
Dim ay As Integer
Dim bx As Integer
Dim by As Integer

bool1stScan = True
strData = ""

c = 0

Me.picboxDataArea.Cls
For i = 1 To picboxDrawArea.Width Step 100
    For j = 1 To picboxDrawArea.Height Step 100
        If picboxDrawArea.Point(i, j) = vbBlack Then
            picboxDataArea.PSet (i, j)
            If Not bool1stScan Then
                If i < ax Then
                    ax = i
                    End If
                If i > bx Then
                    bx = i
                    End If
                If j < ay Then
                    ay = j
                    End If
                If j > by Then
                    by = j
                    End If
            Else
                bool1stScan = False
                ax = i
                bx = i
                ay = j
                by = j
            End If
        End If
Next j, i

'MsgBox ""

If bx - ax <> 0 And by - ay <> 0 Then

    a = 190
    b = 190
    
    Me.picboxDataArea.Cls
    For i = ax To bx - (bx - ax) / 10 Step (bx - ax) / 10
        For j = ay To by - (by - ay) / 10 Step (by - ay) / 10
            If picboxDrawArea.Point(i, j) = 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)
    '                    picboxDataArea.FillStyle = vbSolid
    '                    picboxDataArea.FillColor = vbBlack
    '                    picboxDataArea.fil
    '            RawData(c) = picboxDrawArea.Point(i, j)
                strData = strData & picboxDrawArea.Point(i, j)
                c = c + 1
            Else
    '            RawData(c) = 1
                strData = strData & 1
                c = c + 1
            End If
            b = b + (Me.picboxDataArea.Height - 200) / 10
        Next j
        b = 190
        a = a + (Me.picboxDataArea.Width - 200) / 10
    Next i

End If

End Sub

Private Sub TeachConfirm_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.StatusLabel.Caption = StatusWindow("TeachConfirmButton")
End Sub

Private Sub TeachText_GotFocus()
    Me.TeachText.SelStart = 0
    Me.TeachText.SelLength = Len(Me.TeachText.Text)
End Sub

Private Sub TeachText_KeyUp(KeyCode As Integer, Shift As Integer)
    If Len(Me.TeachText.Text) = 1 Then
        Me.TeachConfirm.Enabled = True
        Me.TeachConfirm.SetFocus
    ElseIf Len(Me.TeachText.Text) > 1 Then
        Me.TeachText.Text = ""
        Me.TeachConfirm.Enabled = False
    Else
        Me.TeachConfirm.Enabled = False
    End If
End Sub

Private Function StatusWindow(Optional ByVal strBuffer As String) As String
Dim Status_OpenButton As String
Dim Status_TeachButton As String
Dim Status_TeachConfirmButton As String
Dim Status_TeachCancelButton As String
Dim Status_RecogniseButton As String
Dim Status_ClearScreenButton As String
Dim Status_ExitButton As String
Dim Status_DrawArea As String
Dim Status_DatabaseArea As String
Dim Status_DataArea As String
Dim Status_Form As String
    
    Status_OpenButton = "Tips && Help : Open File - Just click the Open button to open FILE then type in your FILENAME - Try it..."
    Status_TeachButton = "Tips && Help : Teach - Just click the Teach button to TEACH then type in your teach CHARACTER - Try it..."
    Status_TeachConfirmButton = "Tips && Help : Confirm the character ENTER in the textbox is match with the drawn character in the Draw Area."
    Status_TeachCancelButton = "Tips && Help : Mispressed or Give up or Do not want to Teach."
    Status_RecogniseButton = "Tips && Help : Recognise Text - Just click the this button to recognise drawn character then the recognised character will display at the BOTTOM. Try it..."
    Status_ClearScreenButton = "Tips && Help : Clear Screen - Just click the this button to CLEAR screen then continue to draw character. Try it..."
    Status_ExitButton = "Tips && Help : Exit this software."
    Status_DrawArea = "Tips && Help : Your mouse pointer is in the Draw Area, just Click and drag to draw a character..."
    Status_DatabaseArea = "Tips && Help : This is Database Area, which it will display a recognised character from the database when you click Recognise Button."
    Status_DataArea = "Tips && Help : This Data Area act as a buffer storage of Draw Area when user draw in Draw Area or to retrieve database data when user click Open Button."
    Status_Form = "Tips && Help : Thanks for using this software. Just move the mouse to the Draw Area, then drag the mouse when you want to draw a character to be recognised. Nice Try ..."
    
    Select Case strBuffer
    Case "OpenButton": strBuffer = Status_OpenButton
    Case "TeachButton": strBuffer = Status_TeachButton
    Case "TeachConfirmButton": strBuffer = Status_TeachConfirmButton
    Case "TeachCancelButton": strBuffer = Status_TeachCancelButton
    Case "RecogniseButton": strBuffer = Status_RecogniseButton
    Case "ClearScreenButton": strBuffer = Status_ClearScreenButton
    Case "ExitButton": strBuffer = Status_ExitButton
    Case "DrawArea": strBuffer = Status_DrawArea
    Case "DatabaseArea": strBuffer = Status_DatabaseArea
    Case "DataArea": strBuffer = Status_DataArea
    Case "Form": strBuffer = Status_Form
    End Select
    
    StatusWindow = strBuffer

End Function

Private Function BinToDec(strBin As String) As Integer

i = Len(strBin)
While i > 0
    If Mid(strBin, i, 1) = "1" Then
        BinToDec = BinToDec + 2 ^ (Len(strBin) - i)
    End If
    i = i - 1
Wend

End Function

Private Function DecToBin(intDec As Integer, intDigit As Integer) As String
Dim intTemp As Integer

While intDec > 0 And intDigit > 0
    intDigit = intDigit - 1
    intTemp = intDec Mod 2
    If intTemp Then
        DecToBin = "1" & DecToBin
        intDec = (intDec - 1) / 2
    Else
        DecToBin = "0" & DecToBin
        intDec = intDec / 2
    End If
Wend

While intDigit
    intDigit = intDigit - 1
    DecToBin = "0" & DecToBin
Wend

End Function