frmmain.frm

a vb sourcecod writed by other

b = 190
d = 0

If strData <> "" Then
    For i = 1 To 10
        For j = 1 To 10
            If Mid(strData, d + 1, 1) = vbBlack Then
                picboxDataArea.PSet (a, b)
                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
End If

End Sub

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

Private Sub picboxDataArea_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'    If StatusLabel <> "DataArea" Then
        Me.StatusLabel.Caption = StatusWindow("DataArea")
'    End If
End Sub

Private Sub picboxDatabaseArea_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'    If StatusLabel <> "DatabaseArea" Then
        Me.StatusLabel.Caption = StatusWindow("DatabaseArea")
'    End If
End Sub

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

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

Private Sub TeachCancel_Click()
    
    Me.TeachLabelText.FontBold = True
    Me.TeachLabelText.Caption = strCaption
    
    Me.TeachConfirm.Visible = False
    Me.TeachCancel.Visible = False
    Me.TeachText.Visible = False
    
    Me.Open.Visible = True
    Me.Teach.Visible = True
    Me.Recognise.Visible = True
    Me.ClearScreen.Visible = True
    Me.Exit.Visible = True
    
End Sub

Private Sub ClearScreen_Click()
'    MsgBox "Clear Screen...", vbOKOnly, "Run into sub function..."

    strData = ""

    Me.ResultLabel.Caption = ""
    Me.ResultLabel.ToolTipText = ""
    Me.Refresh

    picboxDrawArea.Cls
    picboxDatabaseArea.Cls
    picboxDataArea.Cls

    Me.comboRecognise.Visible = False
    Me.comboOpen.Visible = False
    Me.Open.Caption = "打开(&O)"
    Me.Open.Enabled = True
    
    Me.Teach.Enabled = False
    Me.Recognise.Enabled = False
    Me.ClearScreen.Enabled = False
    
End Sub

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

Private Sub TeachConfirm_Click()
Dim Filename_Database As String
Dim Filename_Teach As String
Dim Buffer_DrawArea As Variant
Dim strTeachText As String
Dim intCounter As Integer
Dim strBuffer As String
'Dim TeachDialog As New frmTeach
'Dim oFile As TextStream

'    Set oFile = New TextStream
    
    FileSystem.ChDir (App.Path)
    picboxDataArea.Cls
    strTeachText = Me.TeachText.Text
    
    intCounter = 0
    
    Filename_Database = "DATA" & RECOG_EXT
    Filename_Teach = Filename_Database
  
    intCounter = intCounter + 1
    
    Call GraspRawData
    
    If strData = "" Then
        Call ClearScreen_Click
        Me.Teach.Enabled = Not Me.Teach.Enabled
        MsgBox "Detect No character was drawn in the Draw Area. Teach operation can not be proceed. ", vbExclamation, "Warning..."
        GoTo TeachConfirm_SkipTeach
    End If

    Open Filename_Teach For Binary As #1
        strBuffer = Space(5)
        Get #1, , strBuffer
    Close #1
    
    If strBuffer = "recPK" Then
' add teaching character as binary
'**
        strRECpk = ""
        strBuffer = ""
        Open Filename_Teach For Binary As #1
            strBuffer = Space(5)
            Get #1, , strBuffer
            strRECpk = strRECpk & strBuffer
            strBuffer = Space(22)
            While Not EOF(1)
                Get #1, , strBuffer
                strRECpk = strRECpk & strBuffer
            Wend
        Close #1
        strRECpk = Mid(strRECpk, 1, Len(strRECpk) - 22)
        i = 3
        strRECpk = strRECpk & strTeachText
        strRECpk = strRECpk & ","
        For j = 1 To 10
            strRECpk = strRECpk & Chr(BinToDec(Mid(strData, i - 2 + ((j - 1) * 10), 2)))
            strRECpk = strRECpk & Chr(BinToDec(Mid(strData, i + 0 + ((j - 1) * 10), 8)))
        Next j
        Open Filename_Teach For Binary As #1
            Put #1, , strRECpk
        Close #1
'**
    Else
' add teaching character as string
'**
        Open Filename_Teach For Append As #1
            Write #1, strTeachText & "," & strData
        Close #1
'**
    End If

'    ** Manually key in teach file into database **
'    MsgBox "Teaching..."

'    On Error GoTo TeachErrorHandler
'    Teach_CommonDialog.DialogTitle = "Teach"
'    Teach_CommonDialog.Filter = "Recognised Files (*.rec)|*.rec|All Files (*.*)|*.*"
'    Teach_CommonDialog.DefaultExt = ".rec"
'    Teach_CommonDialog.InitDir = App.Path
'    Teach_CommonDialog.ShowSave
    
'    If Teach_CommonDialog.FileName <> "" Then
'        Filename_Teach = Teach_CommonDialog.FileName
'        Filename_Teach = Mid(Filename_Teach, InStrRev(Filename_Teach, "\") + 1)
    

'    With oFile
'        If .OpenTextFile(Filename_Teach, ForAppending) Then
'            Call .WriteLine(Me.picboxDrawArea)
'        Else
'            MsgBox "Error opening text file"
'        End If
'
'        .CloseFile
'    End With
'
'    Set oFile = Nothing
    
'TeachErrorHandler:
'    Exit Sub
    
TeachConfirm_SkipTeach:
    
    Me.TeachLabelText.FontBold = True
    Me.TeachLabelText.Caption = strCaption
    
    Me.TeachConfirm.Visible = False
    Me.TeachCancel.Visible = False
    Me.TeachText.Visible = False
    
    Me.Teach.Enabled = False

    Me.Open.Visible = True
    Me.Teach.Visible = True
    Me.Recognise.Visible = True
    Me.ClearScreen.Visible = True
    Me.Exit.Visible = True

End Sub

Private Sub picboxDrawArea_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    DrawNow = True
    
    picboxDrawArea.DrawWidth = 17
    picboxDrawArea.PSet (X, Y)

    If Not Me.Teach.Enabled Then
        Me.comboRecognise.Visible = False
        Me.comboOpen.Visible = False
        Me.Open.Enabled = True
        Me.Open.Caption = "打开(&O)"
        
        Me.Teach.Enabled = True
        Me.Recognise.Enabled = True
        Me.ClearScreen.Enabled = True
    End If
    
    If Not Me.Recognise.Enabled Then
        Me.Recognise.Enabled = True
        Me.comboRecognise.Visible = False
    End If

End Sub

Private Sub picboxDrawArea_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'    picboxDrawArea.DrawStyle = vbSolid
    Me.StatusLabel.Caption = StatusWindow("DrawArea")
    picboxDrawArea.DrawWidth = 17
    If DrawNow Then
        picboxDrawArea.PSet (X, Y)
        
        If Not fMainForm.Teach.Enabled Then
            Me.Teach.Enabled = True
            Me.Recognise.Enabled = True
            Me.ClearScreen.Enabled = True
        End If
    End If
End Sub

Private Sub picboxDrawArea_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DrawNow = False
    
    Call GraspRawData
End Sub

Private Sub Exit_Click()

'    MsgBox "Are you sure want to Exit?", vbYesNo, "Confirmation"
'    If vbYes Then
'      Unload Me
'    End If

'        frmConfirmation.Left = (frmMain.Width / 2) - (frmConfirmation.Width / 2)
'        frmConfirmation.Top = (frmMain.ScaleHeight / 2) - (frmConfirmation.Height)

        frmConfirmation.Show vbModal
        If frmConfirmation.YES Then
            Unload Me
        End If
End Sub

Private Sub Form_Load()
    Me.Top = 2
    Me.Left = 2
    Me.Width = 8820
    Me.Height = 6945
    RECOG_EXT = ".rec"
    
    strCaption = "如对本程序有疑问，请访问 'http://come.to/albert.com/' 或者发送邮件至 [e-mail]"
    Me.TeachLabelText.FontBold = True
    Me.TeachLabelText.Caption = strCaption
    
    Me.picboxDataArea.DrawWidth = 2
    Me.picboxDatabaseArea.DrawWidth = 2
    
    Me.Teach.Enabled = False
    Me.Recognise.Enabled = False
    Me.ClearScreen.Enabled = False
    
    Me.TeachText.Visible = False
    Me.TeachConfirm.Visible = False
    Me.TeachCancel.Visible = False
    
    Me.pbRecognising.Visible = False
    Me.pbRecognising.Top = 3840
    Me.pbRecognising.Left = 3120
    Me.comboRecognise.Visible = False
    Me.comboOpen.Visible = False
    
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then
        Me.PopupMenu mnuPopUp
    End If
End Sub

Private Sub Label1_Click()
'Dim WebBrowser As New frmBrowser
'    WebBrowser.Show vbModal

    Me.Label1.FontItalic = Not Me.Label1.FontItalic
    Me.Label1.FontBold = Not Me.Label1.FontBold
    
    If Me.Label1.FontItalic Then
        Me.Label1.Caption = "[e-mail]"
    Else
        Me.Label1.Caption = "作者： Albert Archwamety"
    End If
    
End Sub

Private Sub mnuPopUp_About_Click()
Dim AboutDialog As New frmAbout
    AboutDialog.Show vbModal
End Sub

Private Sub mnuPopUp_Close_Click()
    Call Exit_Click
End Sub

Private Sub Open_Click()
Dim Filename_Open As String
Dim Buffer_DataArea As Variant
Dim boolDeleteItemDetect As Boolean
Dim strBuffer As String

If Me.Open.Caption = "删除(&D)" Then
    If MsgBox("Are you sure want to Delete current pattern?", vbYesNo + vbQuestion, "Confirmation...") = vbYes Then
        Open Me.Open_CommonDialog.FileName For Output As #1
        i = 0
        While arrTagData(i) <> ""
            If Me.comboOpen.ListIndex = i Or boolDeleteItemDetect Then
                If Me.comboOpen.ListIndex = i Then
                    boolDeleteItemDetect = True
                    Me.comboOpen.RemoveItem (i)
                    If arrTagData(i + 1) <> "" Then
                        Me.comboOpen.ListIndex = i
                    End If
                End If
                arrTagData(i) = arrTagData(i + 1)
                arrRawData(i) = arrRawData(i + 1)