📄 frmhandwriting.vb
字号:
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 + -