frmmain.frm

联机手写汉字识别

        T = V * Pic1_Height \ GRID_NO
        U = (U - 1) * Pic1_Width \ GRID_NO
        V = (V - 1) * Pic1_Height \ GRID_NO
        Picture1.Line (U, V)-(S, T), , BF
   End If
      
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        Flag = False
        End_X = X:        End_Y = Y
        Call HSPNT(Start_X, Start_Y, End_X, End_Y)
    End If
End Sub

Private Sub Picture3_dblClick()
    IsTrain = False
    Picture3.Visible = False
    Picture3.Cls
    cmdTrain.Caption = "训练"
    cmdCorrect.Caption = "修正"

End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "New"
'            'ToDo: Add 'New' button code.
'            MsgBox "Add 'New' button code."
        Case "Open"
'            mnuFileOpen_Click
        Case "Save"
'            mnuFileSave_Click
        Case "Print"
'            mnuFilePrint_Click
        Case "Cut"
'            mnuEditCut_Click
        Case "Copy"
'            mnuEditCopy_Click
        Case "Paste"
'            mnuEditPaste_Click
        Case "Bold"
            'ToDo: Add 'Bold' button code.
            'MsgBox "Add 'Bold' button code."
            fMainForm.Text_Edit.FontBold = Bold_Flag
            fMainForm.TextOut.FontBold = Bold_Flag
            fMainForm.TextUnknown.FontBold = Bold_Flag
            Bold_Flag = Not Bold_Flag
            
        Case "Italic"
            fMainForm.Text_Edit.FontItalic = Italic_Flag
            fMainForm.TextOut.FontItalic = Italic_Flag
            fMainForm.TextUnknown.FontItalic = Italic_Flag
            Italic_Flag = Not Italic_Flag
            'ToDo: Add 'Italic' button code.
            'MsgBox "Add 'Italic' button code."
        Case "Underline"
            'ToDo: Add 'Underline' button code.
            'MsgBox "Add 'Underline' button code."
            fMainForm.Text_Edit.FontUnderline = Underl_Flag
            fMainForm.TextOut.FontUnderline = Underl_Flag
            fMainForm.TextUnknown.FontUnderline = Underl_Flag
            Underl_Flag = Not Underl_Flag
        Case "Align Left"
            'ToDo: Add 'Align Left' button code.
            'MsgBox "Add 'Align Left' button code."
        Case "Center"
            'ToDo: Add 'Center' button code.
            'MsgBox "Add 'Center' button code."
        Case "Align Right"
            'ToDo: Add 'Align Right' button code.
            'MsgBox "Add 'Align Right' button code."
        Case "Delete"
            'ToDo: Add 'Delete' button code.
            'MsgBox "Add 'Delete' button code."
            Text_Edit.Text = Mid$(Text_Edit, 1, Len(Text_Edit) - 1)
        Case "Redo"
            'ToDo: Add 'Redo' button code.
            'MsgBox "Add 'Redo' button code."
        Case "Undo"
            'ToDo: Add 'Undo' button code.
            'MsgBox "Add 'Undo' button code."
    End Select
End Sub

Private Sub mnuHelpAbout_Click()
'    MsgBox "Version " & App.Major & "." & App.Minor & "." & App.Revision
    MsgBox "Version 4.2"
End Sub

Private Sub mnuHelpSearchForHelpOn_Click()
    Dim nRet As Integer


    'if there is no helpfile for this project display a message to the user
    'you can set the HelpFile for your application in the
    'Project Properties dialog
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub

Private Sub mnuHelpContents_Click()
    Dim nRet As Integer


    'if there is no helpfile for this project display a message to the user
    'you can set the HelpFile for your application in the
    'Project Properties dialog
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub


Private Sub mnuToolsOptions_Click()
    'ToDo: Add 'mnuToolsOptions_Click' code.
'    MsgBox "Add 'mnuToolsOptions_Click' code."
End Sub

Private Sub mnuViewWebBrowser_Click()
    'ToDo: Add 'mnuViewWebBrowser_Click' code.
    R_Flag = False
    Dialog.Caption = "候选字门限值"
    Dialog.Label1.Caption = "请输入候选字门限值：0--1"
    Dialog.Label2.Caption = "当前值为：0" & Resemble_Limit
    Dialog.Show vbModel

End Sub

Private Sub mnuViewOptions_Click()
    'ToDo: Add 'mnuViewOptions_Click' code.
    mnuViewOptions.Checked = Not mnuViewOptions.Checked
    optMiZiGe = Not optMiZiGe
End Sub

Private Sub mnuViewRefresh_Click()
    'ToDo: Add 'mnuViewRefresh_Click' code.
    R_Flag = True
    Dialog.Caption = "识别类似度"
    Dialog.Label1.Caption = "请输入识别类似度：0--1"
    Dialog.Label2.Caption = "当前值为：0" & Resemble_Extent
    Dialog.Show vbModel
End Sub

Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    sbStatusBar.Visible = mnuViewStatusBar.Checked
End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    tbToolBar.Visible = mnuViewToolbar.Checked
End Sub

Private Sub mnuEditPasteSpecial_Click()
    'ToDo: Add 'mnuEditPasteSpecial_Click' code.
'    MsgBox "Add 'mnuEditPasteSpecial_Click' code."
End Sub

Private Sub mnuEditPaste_Click()
    'ToDo: Add 'mnuEditPaste_Click' code.
'    MsgBox "Add 'mnuEditPaste_Click' code."
End Sub

Private Sub mnuEditCopy_Click()
    'ToDo: Add 'mnuEditCopy_Click' code.
'    MsgBox "Add 'mnuEditCopy_Click' code."
End Sub

Private Sub mnuEditCut_Click()
    'ToDo: Add 'mnuEditCut_Click' code.
'    MsgBox "Add 'mnuEditCut_Click' code."
End Sub

Private Sub mnuEditUndo_Click()
    'ToDo: Add 'mnuEditUndo_Click' code.
'    MsgBox "Add 'mnuEditUndo_Click' code."
End Sub

Private Sub mnuFileExit_Click()
    'unload the form
    Unload Me

End Sub

Private Sub mnuFileSend_Click()
    'ToDo: Add 'mnuFileSend_Click' code.
'    MsgBox "Add 'mnuFileSend_Click' code."
End Sub


Private Sub mnuFilePrintPreview_Click()
    'ToDo: Add 'mnuFilePrintPreview_Click' code.
 '   MsgBox "Add 'mnuFilePrintPreview_Click' code."
End Sub

Private Sub mnuFilePageSetup_Click()
    On Error Resume Next
    With dlgCommonDialog
        .DialogTitle = "Page Setup"
        .CancelError = True
        .ShowPrinter
    End With

End Sub

Private Sub mnuFileProperties_Click()
    'ToDo: Add 'mnuFileProperties_Click' code.
'    MsgBox "Add 'mnuFileProperties_Click' code."
End Sub

Private Sub mnuFileSaveAll_Click()
    'ToDo: Add 'mnuFileSaveAll_Click' code.
'    MsgBox "Add 'mnuFileSaveAll_Click' code."
End Sub

Private Sub mnuFileSaveAs_Click()
    'ToDo: Add 'mnuFileSaveAs_Click' code.
'    MsgBox "Add 'mnuFileSaveAs_Click' code."
End Sub

Private Sub mnuFileSave_Click()
    'ToDo: Add 'mnuFileSave_Click' code.
'    MsgBox "Add 'mnuFileSave_Click' code."
End Sub

Private Sub mnuFileClose_Click()
    'ToDo: Add 'mnuFileClose_Click' code.
'    MsgBox "Add 'mnuFileClose_Click' code."
End Sub

Private Sub mnuFileOpen_Click()
    Dim sFile As String


    With dlgCommonDialog
        .DialogTitle = "Open"
        .CancelError = False
        'ToDo: set the flags and attributes of the common dialog control
        .Filter = "All Files (*.*)|*.*"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
    'ToDo: add code to process the opened file

End Sub

Private Sub mnuFileNew_Click()
    'ToDo: Add 'mnuFileNew_Click' code.
    MsgBox "Add 'mnuFileNew_Click' code."
    
End Sub


Private Sub TextOut_Change()
    If IsTrain And TextOut.Text <> "" Then
        Picture3.Cls
        Picture3.Print Left(TextOut.Text, 1)
''''    抽取特征暂时没用上，屏蔽如下
'        For I = 1 To GRID_NO
'            For J = 1 To GRID_NO
'                K = Picture3.Point(Pic3_Width * I / GRID_NO, Pic3_Height * J / GRID_NO)
'                If K = 0 Then
'                    A(I, J) = 1
'                Else
'                    A(I, J) = 0
'                End If
'            Next J
'        Next I
'        TextOut.Text = ""
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'        'Call 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
'            J = J + 2
'        Next J
'        I = I + 2
'    Next I
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'        ' Call ExCharact
    End If
End Sub

Private Sub TextOut_KeyPress(KeyAscii As Integer)
    If IsTrain Then
        If KeyAscii = 13 Then
            TextOut.Text = ""
            KeyAscii = 0
        End If
    Else
        If KeyAscii = 13 Then
            If TextOut.Text <> "" Then
                Text_Edit.Text = Text_Edit.Text & TextOut.Text
                TextOut.Text = ""
                Call Init_ConcaDi
            End If
            Me.Text_Edit.SetFocus
            Text_Edit.SelStart = Len(Text_Edit.Text)
            Text_Edit.SelLength = 0
            KeyAscii = 0
        End If
    End If
End Sub