form1.frm

是关于MATALB 神经网络与VB的混合编程,希望对大家有所帮助

'                        Next n
'                        MsgBox "第" & LTrim(Str(k)) & "个输出在第" & LTrim(Str(i)) & "次达到检验误差！", vbExclamation, "!!!"
'                        numOutput = numOutput + 1
'                        ReDim Preserve okE(numOutput)
'                        okE(numOutput) = k
'                    End If
'                    Picture1.PSet (i, E(k) / Sample_num), vbBlue
'L:
'                If numOutput = LayerNodes(LayerNum) Then
'                    Exit Do
'                End If
                     Picture1.PSet (i, E(k) / Sample_num), vbBlue
                Next k
                GetNewW
            Next j
            If i = Prac_Num Then
                MsgBox "按单个样本进行训练已达到训练次数" & LTrim(Str(Prac_Num)) & "次", vbExclamation, "!!!"
                Exit Do
            End If
        End If
        If i > Prac_Num Then
            MsgBox "训练完毕，但在检验误差范围之外！", vbExclamation, "!!!"
            Exit Do
        End If
        i = i + 1
    Loop
    Picture1.AutoRedraw = True
    Frame1.Caption = "修正权值"
    LW.Clear
    For i = 1 To LayerNum - 1
        For j = 1 To LayerNodes(i)
            For k = 1 To LayerNodes(i + 1)
                LW.AddItem "W(" & LTrim(Str(i)) & "," & LTrim(Str(j)) & "," & LTrim(Str(k)) & ")=" & WValue(i).Value(j, k)
            Next k
        Next j
    Next i
    TSample_num = 0
    TrainFlag = True
    
End Sub

Private Sub Command2_Click()

    Dim intWidth As Integer, intHeight1 As Integer, intHeight2 As Integer
    Dim i As Integer, j As Integer, k As Integer
    Label1.Visible = False
    Label2.Visible = False
    Label3.Visible = False
    Label4.Visible = False
    Picture1.Scale (0, 100)-(500, 0)
    Picture1.AutoRedraw = False
    Picture1.FillStyle = 0
    intWidth = 400 / (LayerNum + 1)
    For i = 1 To LayerNum
        intHeight1 = 100 / (LayerNodes(i) + 1)
        For j = 1 To LayerNodes(i)
            Picture1.Circle (50 + intWidth * i, intHeight1 * j), 4, vbBlue
        Next j
    Next i
    For i = 1 To LayerNum - 1
        intHeight1 = 100 / (LayerNodes(i) + 1)
        intHeight2 = 100 / (LayerNodes(i + 1) + 1)
        For j = 1 To LayerNodes(i)
            For k = 1 To LayerNodes(i + 1)
                Picture1.Line (50 + intWidth * i, intHeight1 * j)-(50 + intWidth * (i + 1), intHeight2 * k)
            Next k
        Next j
    Next i
    If LayerNum > 1 Then
        intHeight1 = 100 / (LayerNodes(1) + 1)
        For i = 1 To LayerNodes(1)
            Picture1.Line (50, intHeight1 * i)-(50 + intWidth, intHeight1 * i)
        Next i
        intHeight1 = 100 / (LayerNodes(LayerNum) + 1)
        For i = 1 To LayerNodes(LayerNum)
            Picture1.Line (50 + intWidth * LayerNum, intHeight1 * i)-(450, intHeight1 * i)
        Next i
    End If
    'Picture1.Picture = LoadPicture("F:\lchback\神经网络\Architect.bmp")
    Picture1.AutoRedraw = True
    
End Sub

Private Sub Command3_Click()

    End
    
End Sub

Private Sub Command4_Click()

End Sub

Private Sub Common_Click()

    If Sample_num < 1 Then
        MsgBox "请新建或选择样本并加以训练！！！", vbExclamation, "!!!"
        Exit Sub
    End If
    Form1.Hide
    Form5.Show
    
End Sub

Private Sub Exit_Click()

    If SaveFlag = True Then
        If MsgBox("检验样本没保存，保存吗？", vbYesNo, "神经网络") = vbYes Then
            Save_Click
        End If
    End If
    If TSaveFlag = True Then
        If MsgBox("检验样本没保存，保存吗？", vbYesNo, "神经网络") = vbYes Then
            Save_Click
        End If
    End If
    End
    
End Sub

Private Sub Form_Activate()

    Dim i As Integer
    Picture1.Scale (-Prac_Num / 15, 0.1)-(Prac_Num, -0.01)
    Picture1.AutoRedraw = False
    Picture1.Cls
    Picture1.Line (-Prac_Num / 15, 0)-(Prac_Num, 0)
    Picture1.Line (0, 0.1)-(0, -0.01)
    For i = 1 To 10
        Picture1.CurrentY = -0.002
        Picture1.CurrentX = Prac_Num / 10 * i
        Picture1.Print Prac_Num / 10 * i
        Picture1.Line (Prac_Num / 10 * i, 0)-(Prac_Num / 10 * i, 0.002)
    Next i
    For i = 1 To 5
        Picture1.CurrentX = -Prac_Num / 15
        Picture1.CurrentY = 0.1 / 5 * i
        Picture1.Print 0.1 / 5 * i
        Picture1.Line (0, 0.1 / 5 * i)-(Prac_Num / 100, 0.1 / 5 * i)
    Next i
'    Picture1.Line (-80, 2420)-(0, 0.1)
'    Picture1.Line (80, 2420)-(0, 2500)
'    Picture1.Line (5920, 80)-(6000, 0)
'    Picture1.Line (5920, -80)-(6000, 0)
    Picture1.AutoRedraw = True
    
End Sub

Private Sub Form_Load()

    Dim i As Integer, j As Integer, k As Integer
    p = 0.5
    L = 0.4
    Err_Up = 0.002
    Prac_Num = 8000
    StopFlag = False
    Flag = 2
    TrainFlag = False
    

End Sub



Private Sub m111_Click()

    Unload Me
    Form7.Show
    
End Sub

Private Sub m122_Click()

    If LayerNum < 1 Then
        MsgBox "请选择训练样本！", vbExclamation, "!!!"
        Exit Sub
    End If
    InitGuiYi
    Form1.Hide
    Load Form9
    Form9.Show
    
End Sub

Private Sub Open_Click()

    Dim i As Integer, j As Integer
    If SaveFlag = True Then
        If MsgBox("检验样本没保存，保存吗？", vbYesNo, "神经网络") = vbYes Then
            Save_Click
        End If
    End If
    If TSaveFlag = True Then
        If MsgBox("检验样本没保存，保存吗？", vbYesNo, "神经网络") = vbYes Then
            Save_Click
        End If
    End If
    SaveFlag = False
    TSaveFlag = False
    Form1.CommonDialog1.Filter = "all files|*.txt|"
    Form1.CommonDialog1.FileName = ""
    Form1.CommonDialog1.FilterIndex = 2
    Form1.CommonDialog1.ShowOpen
    Form1.CommonDialog1.Flags = cdlOFNFileMustExist
    If Form1.CommonDialog1.FileName <> "" Then
    
        Open Form1.CommonDialog1.FileName For Input As #1
    
        Input #1, Sample_num
        Input #1, LayerNum
        ReDim LayerNodes(LayerNum)
        For i = 1 To LayerNum
            Input #1, LayerNodes(i)
        Next i
        ReDim dbI(LayerNodes(1), Sample_num)
        ReDim dbO(LayerNodes(LayerNum), Sample_num)
        For i = 1 To Sample_num
            For j = 1 To LayerNodes(1)
                Input #1, dbI(j, i)
            Next j
            For j = 1 To LayerNodes(LayerNum)
                Input #1, dbO(j, i)
            Next j
        Next i
        ReDim TFunctionNum(LayerNodes(LayerNum))
        For i = 1 To LayerNodes(LayerNum)
            Input #1, TFunctionNum(i)
        Next i
    Else
       MsgBox "没有选择文件", , "注意"
       
    End If
    
    Close #1
    Init

End Sub

Private Sub Para_Click()

    Form4.Show
    
End Sub

Private Sub Recall_Click()

    Dim i As Integer, j As Integer
    If Sample_num < 1 Then
        MsgBox "请新建或选择样本并加以训练！！！", vbExclamation, "!!!"
        Exit Sub
    End If
    Form3.Show
    Form1.Visible = False
    With Form3.Grid1
        .Clear
        'Form3.Grid1.Width = 7100
        'Form3.Grid1.Height = 2500
        .Cols = 1 + LayerNodes(1) + LayerNodes(LayerNum) * 4
        .Rows = Sample_num + 1
        .ColWidth(0) = 700
        
        For i = 1 To .Cols - 1
            .ColWidth(i) = 2000
        Next i
        
        For i = 0 To .Rows - 1
            .RowHeight(i) = 300
        Next i
        
        .TextMatrix(0, 0) = "序号\项"
        
        For i = 1 To LayerNodes(1)
            .TextMatrix(0, i) = "输入---样本X" & LTrim(Str(i))
        Next i
        For i = 1 To LayerNodes(LayerNum)
            .TextMatrix(0, LayerNodes(1) + 1 + (i - 1) * 4) = "期望输出---样本Y" & LTrim(Str(i))
            .TextMatrix(0, LayerNodes(1) + 2 + (i - 1) * 4) = "神经网络实际输出 Y" & LTrim(Str(i)) & "*"
            .TextMatrix(0, LayerNodes(1) + 3 + (i - 1) * 4) = "实际误差(Y" & LTrim(Str(i)) & "*-Y" & LTrim(Str(i)) & ")"
            .TextMatrix(0, LayerNodes(1) + 4 + (i - 1) * 4) = "误差百分比((Y" & LTrim(Str(i)) & "*-Y" & LTrim(Str(i)) & ")/Y" & LTrim(Str(i)) & ")(%)"
        Next i
        For i = 1 To Sample_num
            Get_OutPut (i)
            .TextMatrix(i, 0) = i
            For j = 1 To LayerNodes(1)
                .TextMatrix(i, j) = dbI(j, i)
            Next j
            For j = 1 To LayerNodes(LayerNum)
                .TextMatrix(i, LayerNodes(1) + 1 + (j - 1) * 4) = dbO(j, i)
                .TextMatrix(i, LayerNodes(1) + 2 + (j - 1) * 4) = ReverseGuiYi(Layers(LayerNum).cNerve(j).v, j)
                .TextMatrix(i, LayerNodes(1) + 3 + (j - 1) * 4) = ReverseGuiYi(Layers(LayerNum).cNerve(j).v, j) - dbO(j, i)
                .TextMatrix(i, LayerNodes(1) + 4 + (j - 1) * 4) = (ReverseGuiYi(Layers(LayerNum).cNerve(j).v, j) - dbO(j, i)) / dbO(j, i) * 100
            Next j
        Next i
    End With
End Sub

Private Sub Save_Click()

    Dim i As Integer, j As Integer
    Form1.CommonDialog1.Filter = "all files|*.txt|"
    Form1.CommonDialog1.FileName = ""
    Form1.CommonDialog1.FilterIndex = 2
    Form1.CommonDialog1.ShowSave
    Form1.CommonDialog1.Flags = cdlOFNFileMustExist
    If Form1.CommonDialog1.FileName <> "" Then
        Open Form1.CommonDialog1.FileName For Output As #4
        Write #4, Sample_num
        Write #4, LayerNum
        For i = 1 To LayerNum
            Write #4, LayerNodes(i)
        Next i
        For i = 1 To Sample_num
            For j = 1 To LayerNodes(1)
                Write #4, dbI(j, i)
            Next j
            For j = 1 To LayerNodes(LayerNum)
                Write #4, dbO(j, i)
            Next j
        Next i
        For i = 1 To LayerNodes(LayerNum)
            Write #4, TFunctionNum(i)
        Next i
    Else
       MsgBox ("没有输入文件名")
    End If
    Close #4
    SaveFlag = False
    
End Sub

Private Sub Start_Click()

    Command1_Click
    
End Sub

Private Sub Stop_Click()

    StopFlag = False

End Sub