⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmhandwriting.vb

📁 neural networks applications
💻 VB
📖 第 1 页 / 共 2 页
字号:

    End Sub

    Private Sub picMain_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles picMain.MouseDown
        If e.Button = MouseButtons.Left Then ifMoving = True
    End Sub
    Private Sub picMain_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles picMain.MouseUp
        ifMoving = False
    End Sub

    Private Sub picMain_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles picMain.MouseMove
        If ifMoving Then
            Try
                bmap.SetPixel(e.X, e.Y, Color.Red)
                bmap.SetPixel(e.X - 1, e.Y - 1, Color.Red)
                bmap.SetPixel(e.X - 1, e.Y, Color.Red)
                bmap.SetPixel(e.X, e.Y - 1, Color.Red)
                bmap.SetPixel(e.X + 1, e.Y + 1, Color.Red)
                bmap.SetPixel(e.X + 1, e.Y, Color.Red)
                bmap.SetPixel(e.X, e.Y + 1, Color.Red)


                picMain.Invalidate()
            Catch
            End Try
        End If
    End Sub

    Private Sub picMain_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles picMain.Paint
        e.Graphics.DrawImage(CType(bmap, Image), 0, 0)

    End Sub

    Private Sub btnTrain_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTrain.Click
        Dim times As Long
        Dim sbuf As String

        'Check whether our input textbox has a valid character

        Dim inputChar As String = Trim(txtTrain.Text)


        If inputChar.Length <> 1 Then
            MsgBox("Enter a valid character in the text box")
            Exit Sub
        End If

        inputChar.ToUpper()

        If Asc(inputChar) < Asc("A") Or Asc(inputChar) > Asc("G") Then
            MsgBox("Enter a valid character between A and G in the text box")
            Exit Sub
        End If

        Dim newBmap As New Bitmap(bmap, 10, 10)


        'Just print the pattern to a textbox for us to view it
        sbuf = ""

        Dim i, j As Integer

        For i = 0 To 10 - 1
            For j = 0 To 10 - 1

                If newBmap.GetPixel(i, j).R = 255 Then
                    sbuf = sbuf & "1"

                Else
                    sbuf = sbuf & "0"

                End If
            Next
            sbuf = sbuf & vbCrLf

        Next

        Me.txtPattern.Text = sbuf

        newBmap.Dispose()

        'Start the training
        For times = 0 To 1000
            Train()
        Next
        Utility.Report(Me.lvReport, myBnn)


    End Sub



    Sub Run()
        Dim i As Integer, j As Integer
        Dim inputs As New ArrayList()


        Dim newBmap As New Bitmap(bmap, 10, 10)

        For i = 0 To 10 - 1
            For j = 0 To 10 - 1
                If newBmap.GetPixel(i, j).R = 255 Then
                    inputs.Add(1)
                Else
                    inputs.Add(0)
                End If
            Next
        Next

        newBmap.Dispose()

        myBnn.RunNetwork(inputs)
        Utility.Report(Me.lvReport, myBnn)





    End Sub


    Sub Train()

        Dim td As New TrainingData()

        Dim newBmap As New Bitmap(bmap, 10, 10)

        Dim i As Integer, j As Integer


        For i = 0 To 10 - 1
            For j = 0 To 10 - 1

                If newBmap.GetPixel(i, j).R = 255 Then
                    td.Inputs.Add(1)
                Else
                    td.Inputs.Add(0)
                End If
            Next
        Next


        Dim bin As String
        Dim inputChar As String = Trim(txtTrain.Text)



        bin = BinaryFromNumber(Asc(inputChar))


        For i = 0 To bin.Length - 1
            If bin.Chars(bin.Length - 1 - i) = "1" Then
                td.Outputs.Add(1)
            Else
                td.Outputs.Add(0)
            End If
        Next


        myBnn.TrainNetwork(td)

        newBmap.Dispose()







    End Sub


    Function BinaryFromNumber(ByVal bt As Byte) As String

        Dim binStr As String = ""

        Dim i
        For i = 0 To 7
            If ((2 ^ i) And bt) = (2 ^ i) Then
                binStr = "1" & binStr
            Else
                binStr = "0" & binStr
            End If

        Next

        Return binStr

    End Function

    Function NumberFromBinary(ByVal bin As String) As Integer

        Dim number As Integer = 0

        Dim i, bit
        For i = 0 To bin.Length - 1
            If bin.Chars(bin.Length - 1 - i) = "1" Then
                bit = 1
            Else
                bit = 0
            End If

            number = number + ((2 ^ i) * bit)

        Next

        Return number

    End Function

    Private Sub gbMain_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles gbMain.Enter

    End Sub

    Private Sub cmdClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdClear.Click
        Me.bmap = New System.Drawing.Bitmap(100, 100)
        picMain.Invalidate()

    End Sub

    Private Sub cmdDetect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdDetect.Click

        'Just print the pattern to a textbox for us to view it
        Dim sbuf As String = ""

        Dim i, j As Integer

        Dim newBmap As New Bitmap(bmap, 10, 10)
        For i = 0 To 10 - 1
            For j = 0 To 10 - 1

                Try
                    If newBmap.GetPixel(i, j).R = 255 Then
                        sbuf = sbuf & "1"
                    Else
                        sbuf = sbuf & "0"
                    End If
                Catch
                End Try
            Next

            sbuf = sbuf & vbCrLf

        Next

        Me.txtPattern.Text = sbuf

        newBmap.Dispose()


        Run()
        Dim output As ArrayList
        output = myBnn.GetOutput()
        Dim str As String = ""
        Dim val As Double

        For Each val In output
            str = str & Math.Round(val)
        Next


        Me.txtOutput.Text = NumberFromBinary(str)


    End Sub


    Private Sub cmdClose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdClose.Click
        Me.Close()

    End Sub

    Private Sub tbMain_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tbMain.SelectedIndexChanged

    End Sub

    Private Sub lblTrain_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lblTrain.Click

    End Sub
End Class

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -